Страницы

среда, 25 января 2012 г.

Меняем домашнюю страницу огнелиса "насовсем".

Случилось мне мастерить приладу для учета использования огнелиса. Ничего особенного: по событию запуска браузера отобразить окно ввода имени пользователя, по событию завершения работы браузера записать строку в лог. Задача решалась "за спасибо", поэтому в коде установки прилады я реализовал изменение домашней страницы. Всего сто строчек и по крайней мере моральное удовлетворение обеспечено :).
После отработки приведенного ниже кода именить настройки FireFox используя интерфейс приложения вряд ли получится. Кто дочитает код до конца - поймет причину :).
Option Explicit

Dim fso, objShellApp
Dim ffProfPath 'путь к файлу profiles.ini
Dim strProfFolder 'путь к каталогу профиля
Dim ffPrefsPath 'путь к файлу prefs.js
Dim ffPrefsArr() 'массив строк из файла prefs.js
Dim bIsStartPage 'успех поиска стартовой страницы
Dim s, i

Const ffFolder = "Mozilla\Firefox\"
Const ffProfName = "profiles.ini"
Const ffPrefsName = "prefs.js"

Set fso = CreateObject("Scripting.FileSystemObject")
Set objShellApp = CreateObject("Shell.Application")

'получаем путь к файлу profiles.ini
ffProfPath = fso.BuildPath(objShellApp.NameSpace(&H1a).Self.Path, ffFolder & ffProfName)

'проверяем наличие файла profiles.ini
If Not fso.FileExists(ffProfPath) Then
 MsgBox "Не найден файл " & ffProfPath
 WScript.Quit
End If

'читаем путь к каталогу профиля
With fso.OpenTextFile(ffProfPath) 'открываем файл   
 Do Until .AtEndOfStream 'читаем
  s = .ReadLine
  If InStr(s,"Path=") = 1 Then   
   strProfFolder = Mid(s,InStr(s,"=")+1)
   Exit Do
  End If  
 Loop
 .Close
End With

'проверяем успех чтения пути к каталогу профиля
If IsEmpty(strProfFolder) Then
 MsgBox "Не удалось прочитать путь к каталогу профиля"
 WScript.Quit
End If

'получаем путь к файлу prefs.js
ffPrefsPath = fso.BuildPath(objShellApp.NameSpace(&H1a).Self.Path, ffFolder & strProfFolder & "\" & ffPrefsName)

Set objShellApp = Nothing

'проверяем наличие файла prefs.js
If Not fso.FileExists(ffPrefsPath) Then
 MsgBox "Не найден файл " & ffPrefsPath
 WScript.Quit
End If

'открываем файл prefs.js
With fso.OpenTextFile(ffPrefsPath)
 i = 0
 Do Until .AtEndOfStream 'читаем все в массив
  Redim Preserve ffPrefsArr(i)
  ffPrefsArr(i) = .ReadLine
  i = i + 1  
 Loop
 .Close
End With

'ищем стартовую страницу в массиве
For i = 0 To UBound(ffPrefsArr)
 If InStr(ffPrefsArr(i),Chr(34) & "browser.startup.homepage" & Chr(34)) Then
  'нашли - меняем
  ffPrefsArr(i) = "user_pref(""browser.startup.homepage"", " & Chr(34) & _
    "http://da440dil.narod.ru/about.html" & Chr(34) & ");"
  bIsStartPage = True
  Exit For
 End If
Next

'проверяем успех поиска стартовой страницы
If Not bIsStartPage Then
 MsgBox "Не удалось найти строку настройки стартовой страницы"
 WScript.Quit
End If

'удаляем файл prefs.js
fso.DeleteFile ffPrefsPath, True 

'создаем новый
With fso.CreateTextFile(ffPrefsPath, True)
 'пишем в файл строки из массива
 For i = 0 To UBound(ffPrefsArr)
  .WriteLine ffPrefsArr(i)
 Next 
 .Close 
End With

'добавляем атрибут "только для чтения"
With fso.GetFile(ffPrefsPath)
 .Attributes = .Attributes OR 1
End With

Set fso = Nothing