Mendefaultkan home site IE (Internet Explorer) atau Mozilla Firefox secara pemrograman mungkin kita sudah mengetahuinya, tapi bagaimana dengan Google Chrome yang tergolong relatif masih muda untuk saat ini (2011).
Masalah mendefaultkan Google Chrome home page, hanyalah masalah merubah 1 baris kode yang terdapat pada file
preferences yang terdapat pada folder:
.... \Local Settings\Application Data\Google\Chrome\User Data\Default.Atau tepatnya merubah 1 baris kode yang terdapat pada gambar di bawah ini:
Gambar 1 Kode yang dirubah pada file preferences
Di bawah ini merupakan kode untuk mendefaultkan home page Google Chrome. Letakan kode ini pada module.
'----------------------------------------------------------------------------------
'From: http://khoiriyyah.blogspot.com
'By: Asep Hibban
'----------------------------------------------------------------------------------
Option Explicit
Public Sub SetChromeHomepage(URL As String)
Dim strPath As String, strProfile As String
Dim strContent As String, strReplace As String
Dim regex As RegExp, strSystemDrive As String
strPath = Environ("SystemDrive") & Environ("HOMEPATH")
strPath = strPath & "\Local Settings\Application Data\Google\Chrome\User Data\Default"
strProfile = Dir(strPath, vbDirectory)
Debug.Print strPath
If Len(strPath) Then
strPath = strPath & "\Preferences"
strReplace = Chr(34) & "homepage" & Chr(34) & ": " & Chr(34) & URL & Chr(34) & ","
strContent = fGetFileContents(strPath)
Set regex = New RegExp
If InStr(1, strContent, Chr(34) & "homepage" & Chr(34)) = 0 Then
strContent = strContent & vbCrLf & Chr(34) & "homepage" & Chr(34) & ": " & Chr(34) & URL & Chr(34) & ","
sPutStringToFile strContent, strPath
Exit Sub
ElseIf InStr(1, strContent, strReplace) Then
Exit Sub
End If
'tidak bisa direplace menggunakan replace biasa
'maka kita gunakan regular expressions untuk keperluan ini
regex.Pattern = Chr(34) & "homepage" & Chr(34) & ": .*)"
strContent = regex.Replace(strContent, strReplace)
strContent = Replace(strContent, Chr(34) & "homepage_is_newtabpage" & Chr(34) & ": true,", vbCrLf & Chr(34) & "homepage_is_newtabpage" & Chr(34) & ": false,")
sPutStringToFile strContent, strPath
End If
End Sub
Public Function fGetFileContents(strPath As String) As String
Dim hFile As Integer
Dim strFileContent As String
If Len(Dir(strPath)) = 0 Then Exit Function
On Error GoTo ErrGetFile
hFile = FreeFile
Open strPath For Binary As #hFile
strFileContent = Space(LOF(hFile))
Get #hFile, , strFileContent
Close #hFile
fGetFileContents = strFileContent
Exit Function
ErrGetFile:
Close
MsgBox Err.Description, vbCritical, "GetFileContents"
End Function
Public Sub sPutStringToFile(strContent As String, strPath As String)
Dim hFile As Integer
'If file exists delete it.
On Error Resume Next
Kill strPath
On Error GoTo ErrPutString
'Write file
hFile = FreeFile
Open strPath For Binary As #hFile
Put #hFile, , strContent
Close #hFile
Exit Sub
ErrPutString:
Close #hFile
MsgBox Err.Description, vbCritical, "PutStringToFile"
End Sub
Contoh pemanggilan prosedure di atas:
Private Sub Command1_Click()
SetChromeHomepage "http://khoiriyyah.blogspot.com"
End Sub
