Web Browser didalam Visual Basic 6 berperan untuk berselancar ke dunia maya. Dengan menggunakan Web Browser kita bisa membuat sendiri sebuah browser yang cukup powerfull. Web Browser adalah basic control yang memakai engine Internet Explorer. Engine Internet Explorer banyak dipakai oleeh browser - browser terkemuka seperti Chrome, Opera maupun Safari.
Taukah anda, bahwa banyak sekali penggunaan script yang masih tersembunyi yang dimiliki oleh control Web Browser. Script ini bisa membuat Web Browser yang kita buat makin powerfull dan tentunya terlihat keren dan profesional.
Untuk bisa menggunakan control Web Browser sobat harus menambahkan terlebih dahulu Componen Microsoft Internet Conrols. Berikut ini adalah script yang umum digunakan pada control Web Browser
Menuju Ke URL Target
WebBrowser1.Navigate "http://dot-blogspot76.blogspot.com"
Membuka Popup Windows Baru
Private Sub WebBrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
Dim frm As Form1
Set frm = New Form1
Set ppDisp = frm.WebBrowser1.Object
frm.Show
End Sub
Dim frm As Form1
Set frm = New Form1
Set ppDisp = frm.WebBrowser1.Object
frm.Show
End Sub
Mencari Kata Dalam Suatu Halaman
Private Sub Command1_Click()
Dim strfindword As String
strfindword = InputBox("What are you looking for?", "Find", "") ' what word to find?
If WebPageContains(strfindword) = True Then 'check if the word is in page
MsgBox "The webpage contains the text" 'string is in page
Else
MsgBox "The webpage doesn't contains the text" 'string is not in page
End If
End Sub
Private Function WebPageContains(ByVal s As String) As Boolean
Dim i As Long, EHTML
For i = 1 To WebBrowser1.Document.All.length
Set EHTML = _
WebBrowser1.Document.All.Item(i)
If Not (EHTML Is Nothing) Then
If InStr(1, EHTML.innerHTML, _
s, vbTextCompare) > 0 Then
WebPageContains = True
Exit Function
End If
End If
Next i
End Function
Private Sub Form_Load()
WebBrowser1.Navigate2 "http://dot-blogspot76.blogspot.com"
End Sub
Dim strfindword As String
strfindword = InputBox("What are you looking for?", "Find", "") ' what word to find?
If WebPageContains(strfindword) = True Then 'check if the word is in page
MsgBox "The webpage contains the text" 'string is in page
Else
MsgBox "The webpage doesn't contains the text" 'string is not in page
End If
End Sub
Private Function WebPageContains(ByVal s As String) As Boolean
Dim i As Long, EHTML
For i = 1 To WebBrowser1.Document.All.length
Set EHTML = _
WebBrowser1.Document.All.Item(i)
If Not (EHTML Is Nothing) Then
If InStr(1, EHTML.innerHTML, _
s, vbTextCompare) > 0 Then
WebPageContains = True
Exit Function
End If
End If
Next i
End Function
Private Sub Form_Load()
WebBrowser1.Navigate2 "http://dot-blogspot76.blogspot.com"
End Sub
Fungsi Dasar Web Browser
Private Sub Command1_Click(Index As Integer)
On Error Resume Next
Select Case Index
Case 0 'Go Back Button
WebBrowser1.GoBack 'Fungsi untuk kembali ke halaman sebelumnya
Case 1 'Go Forward Button
WebBrowser1.GoForward 'Fungsi untuk maju ke halaman selanjutnya
Case 2 'Stop Button
WebBrowser1.Stop 'Berhenti browsing
Case 3 'Refresh Button
WebBrowser1.Refresh 'Refresh halaman
Case 4 'Go Home Button
WebBrowser1.GoHome 'Fungsi ke halaman awal
Case 5 'Search Button
WebBrowser1.GoSearch 'Fungsi pencarian
End Select
End Sub
On Error Resume Next
Select Case Index
Case 0 'Go Back Button
WebBrowser1.GoBack 'Fungsi untuk kembali ke halaman sebelumnya
Case 1 'Go Forward Button
WebBrowser1.GoForward 'Fungsi untuk maju ke halaman selanjutnya
Case 2 'Stop Button
WebBrowser1.Stop 'Berhenti browsing
Case 3 'Refresh Button
WebBrowser1.Refresh 'Refresh halaman
Case 4 'Go Home Button
WebBrowser1.GoHome 'Fungsi ke halaman awal
Case 5 'Search Button
WebBrowser1.GoSearch 'Fungsi pencarian
End Select
End Sub
Fungsi Lanjutan Web Browser
Private Sub Command1_Click() 'Tombol Print
WebBrowser1.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT 'Menampilkan Print Window
End Sub
Private Sub Command2_Click() 'Tombol Print Preview
WebBrowser1.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT 'Menampilkan Print Preview Window
End Sub
Private Sub Command3_Click() 'Tombol Page Setup
WebBrowser1.ExecWB OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT 'Menampilkan Page Setup Window
End Sub
Private Sub Command4_Click() 'Tombol Page Properties
WebBrowser1.ExecWB OLECMDID_PROPERTIES, OLECMDEXECOPT_DODEFAULT 'Menampilkan Page Properties Window
End Sub
WebBrowser1.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT 'Menampilkan Print Window
End Sub
Private Sub Command2_Click() 'Tombol Print Preview
WebBrowser1.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT 'Menampilkan Print Preview Window
End Sub
Private Sub Command3_Click() 'Tombol Page Setup
WebBrowser1.ExecWB OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT 'Menampilkan Page Setup Window
End Sub
Private Sub Command4_Click() 'Tombol Page Properties
WebBrowser1.ExecWB OLECMDID_PROPERTIES, OLECMDEXECOPT_DODEFAULT 'Menampilkan Page Properties Window
End Sub
Mengganti Ukuran Font
Private Sub Command1_Click() 'Tombol terkecil
On Error Resume Next
WebBrowser1.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(0), vbNull
End Sub
Private Sub Command2_Click() 'Tombol kecil
On Error Resume Next
WebBrowser1.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(1), vbNull
End Sub
Private Sub Command3_Click() 'Tombol sedang
On Error Resume Next
WebBrowser1.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(2), vbNull
End Sub
Private Sub Command4_Click() 'Tombol besar
On Error Resume Next
WebBrowser1.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(3), vbNull
End Sub
Private Sub Command5_Click() 'Tombol terbesar
On Error Resume Next
WebBrowser1.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(4), vbNull
End Sub
On Error Resume Next
WebBrowser1.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(0), vbNull
End Sub
Private Sub Command2_Click() 'Tombol kecil
On Error Resume Next
WebBrowser1.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(1), vbNull
End Sub
Private Sub Command3_Click() 'Tombol sedang
On Error Resume Next
WebBrowser1.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(2), vbNull
End Sub
Private Sub Command4_Click() 'Tombol besar
On Error Resume Next
WebBrowser1.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(3), vbNull
End Sub
Private Sub Command5_Click() 'Tombol terbesar
On Error Resume Next
WebBrowser1.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DONTPROMPTUSER, CLng(4), vbNull
End Sub
Disable Klik Kanan Pada Web Browser
Option Explicit
Dim CustomWB As WBCustomizer 'Deceler the CustomWB
Private Sub Form_Load()
Set CustomWB = New WBCustomizer
With CustomWB
.EnableContextMenus = False 'Disable The Menu
.EnableAllAccelerators = True
Set .WebBrowser = WebBrowser1
End With
WebBrowser1.Navigate "http://3hsoftcom.blogspot.com"
CustomWB.EnableContextMenus = False
End Sub
Dim CustomWB As WBCustomizer 'Deceler the CustomWB
Private Sub Form_Load()
Set CustomWB = New WBCustomizer
With CustomWB
.EnableContextMenus = False 'Disable The Menu
.EnableAllAccelerators = True
Set .WebBrowser = WebBrowser1
End With
WebBrowser1.Navigate "http://3hsoftcom.blogspot.com"
CustomWB.EnableContextMenus = False
End Sub
Mengambil Semua Link Di Halaman
Option Explicit
Private Sub Form_Load()
WebBrowser1.Navigate "http://dot-blogspot76.blogspot.com"
End Sub
Private Sub WebBrowser1_DownloadComplete()
'tambahkan reference "Microsoft HTML Object Library"
Dim HTMLdoc As HTMLDocument
Dim HTMLlinks As HTMLAnchorElement
Dim STRtxt As String
' Daftar link.
On Error Resume Next
Set HTMLdoc = WebBrowser1.Document
For Each HTMLlinks In HTMLdoc.links
STRtxt = STRtxt & HTMLlinks.href & vbCrLf
Next HTMLlinks
Text1.Text = STRtxt
End Sub
Private Sub Form_Load()
WebBrowser1.Navigate "http://dot-blogspot76.blogspot.com"
End Sub
Private Sub WebBrowser1_DownloadComplete()
'tambahkan reference "Microsoft HTML Object Library"
Dim HTMLdoc As HTMLDocument
Dim HTMLlinks As HTMLAnchorElement
Dim STRtxt As String
' Daftar link.
On Error Resume Next
Set HTMLdoc = WebBrowser1.Document
For Each HTMLlinks In HTMLdoc.links
STRtxt = STRtxt & HTMLlinks.href & vbCrLf
Next HTMLlinks
Text1.Text = STRtxt
End Sub
Menyimpan Halaman
Option Explicit
Private Sub Command1_Click()
WebBrowser1.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT
End Sub
Private Sub Form_Load()
WebBrowser1.Navigate "http://dot-blogspot76.blogspot.com"
End Sub
Private Sub Command1_Click()
WebBrowser1.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT
End Sub
Private Sub Form_Load()
WebBrowser1.Navigate "http://dot-blogspot76.blogspot.com"
End Sub
Membuka Halaman
Private Sub Command2_Click()
WebBrowser1.ExecWB OLECMDID_OPEN, OLECMDEXECOPT_PROMPTUSER
End Sub
WebBrowser1.ExecWB OLECMDID_OPEN, OLECMDEXECOPT_PROMPTUSER
End Sub
jika menggunakan Common Dialog
Option Explicit
Private Sub Command1_Click()
On Error Resume Next
With CommonDialog1
.DialogTitle = "Buka File"
.Filter = "Web page (*.htm;*.html) | *.htm;*.html|" & _
"Gambar yang disupport formats|*.gif;*.tif;*.pcd;*.jpg;*.wmf;" & _
"*.tga;*.jpeg;*.ras;*.png;*.eps;*.bmp;*.pcx|" & _
"Text formats (*.txt;*.doc)|*.txt;*.doc|" & _
"All files (*.*)|*.*|"
.ShowOpen
.Flags = 5
WebBrowser1.Navigate2 .FileName
End With
End Sub
Private Sub Form_Load()
WebBrowser1.Navigate "http://3hsoftcom.blogspot.com"
End Sub
Private Sub Command1_Click()
On Error Resume Next
With CommonDialog1
.DialogTitle = "Buka File"
.Filter = "Web page (*.htm;*.html) | *.htm;*.html|" & _
"Gambar yang disupport formats|*.gif;*.tif;*.pcd;*.jpg;*.wmf;" & _
"*.tga;*.jpeg;*.ras;*.png;*.eps;*.bmp;*.pcx|" & _
"Text formats (*.txt;*.doc)|*.txt;*.doc|" & _
"All files (*.*)|*.*|"
.ShowOpen
.Flags = 5
WebBrowser1.Navigate2 .FileName
End With
End Sub
Private Sub Form_Load()
WebBrowser1.Navigate "http://3hsoftcom.blogspot.com"
End Sub
Auto Submit
Private Sub Command1_Click()
Dim strwebsite As String
Dim stremail As String
strwebsite = "http://3hsoftcom.blogspot.com"
stremail = "myemail@host.com"
WebBrowser1.Document.addurl.URL.Value = strwebsite
WebBrowser1.Document.addurl.Email.Value = stremail
WebBrowser1.Document.addurl.Submit
End Sub
Private Sub Form_Load()
WebBrowser1.Navigate "http://www.scrubtheweb.com/addurl.html"
End Sub
Dim strwebsite As String
Dim stremail As String
strwebsite = "http://3hsoftcom.blogspot.com"
stremail = "myemail@host.com"
WebBrowser1.Document.addurl.URL.Value = strwebsite
WebBrowser1.Document.addurl.Email.Value = stremail
WebBrowser1.Document.addurl.Submit
End Sub
Private Sub Form_Load()
WebBrowser1.Navigate "http://www.scrubtheweb.com/addurl.html"
End Sub
Penggunaan Progress Bar Dalam Web Browser
Private Sub Form_Load()
WebBrowser1.Navigate "http://dot-blogspot76.blogspot.com"
ProgressBar1.Appearance = ccFlat
ProgressBar1.Scrolling = ccScrollingSmooth
End Sub
Private Sub WebBrowser1_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
On Error Resume Next
If Progress = -1 Then ProgressBar1.Value = 100
Me.Caption = "100%"
If Progress > 0 And ProgressMax > 0 Then
ProgressBar1.Value = Progress * 100 / ProgressMax
Me.Caption = Int(Progress * 100 / ProgressMax) & "%"
End If
Exit Sub
End Sub
WebBrowser1.Navigate "http://dot-blogspot76.blogspot.com"
ProgressBar1.Appearance = ccFlat
ProgressBar1.Scrolling = ccScrollingSmooth
End Sub
Private Sub WebBrowser1_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
On Error Resume Next
If Progress = -1 Then ProgressBar1.Value = 100
Me.Caption = "100%"
If Progress > 0 And ProgressMax > 0 Then
ProgressBar1.Value = Progress * 100 / ProgressMax
Me.Caption = Int(Progress * 100 / ProgressMax) & "%"
End If
Exit Sub
End Sub
Mengontrol Checkbox Dalam Halaman Lain
Private Sub Form_Load()
WebBrowser1.Navigate "https://www.google.com/accounts/ManageAccount"
End Sub
Private Sub Check1_Click()
If Check1.Value = 0 Then
WebBrowser1.Document.All.PersistentCookie.Checked = False 'unchecked
Else
WebBrowser1.Document.All.PersistentCookie.Checked = True 'checked
End If
End Sub
WebBrowser1.Navigate "https://www.google.com/accounts/ManageAccount"
End Sub
Private Sub Check1_Click()
If Check1.Value = 0 Then
WebBrowser1.Document.All.PersistentCookie.Checked = False 'unchecked
Else
WebBrowser1.Document.All.PersistentCookie.Checked = True 'checked
End If
End Sub
Mendapatkan Sourcecode Halaman
Dim pageSource As String
pageSource = webBrowser.document.body.parentElement.innerHTML
pageSource = webBrowser.document.body.parentElement.innerHTML
Mengambil Link Gambar
Dim pageImageLinks As Collection
Dim pageLinks As Object
pageLinks = webBrowser.document.getElementsByTagName("a")
Dim link As Object
Dim linkChildren As Object
For Each link In pageLinks
linkChildren = link.getElementsByTagName("img")
If (linkChildren.Count) _
pageImageLinks.Add(link)
Next
Dim pageLinks As Object
pageLinks = webBrowser.document.getElementsByTagName("a")
Dim link As Object
Dim linkChildren As Object
For Each link In pageLinks
linkChildren = link.getElementsByTagName("img")
If (linkChildren.Count) _
pageImageLinks.Add(link)
Next
Mengecek Attribut
Dim favicon As String
Dim description As String
Dim links As HTMLElementCollection
Dim metas As HTMLElementCollection
Set links = wbrBrowser.Document.GetElementsByTagName("link")
Set metas = wbrBrowser.Document.GetElementsByTagName("meta")
Dim link As HTMLLinkElement
For Each link In links
If (InStr(link.GetAttribute("rel"), "icon") Then
favicon = link.GetAttribute("href")
Exit For
End If
Next
Dim meta As HTMLMetaElement
For Each meta In metas
If (meta.HasAttribute("description")) Then
description = meta.GetAttribute("content")
Exit For
End If
Next
Dim description As String
Dim links As HTMLElementCollection
Dim metas As HTMLElementCollection
Set links = wbrBrowser.Document.GetElementsByTagName("link")
Set metas = wbrBrowser.Document.GetElementsByTagName("meta")
Dim link As HTMLLinkElement
For Each link In links
If (InStr(link.GetAttribute("rel"), "icon") Then
favicon = link.GetAttribute("href")
Exit For
End If
Next
Dim meta As HTMLMetaElement
For Each meta In metas
If (meta.HasAttribute("description")) Then
description = meta.GetAttribute("content")
Exit For
End If
Next
Nah...banyak sekali..kan fungsi - fungsi yang bisa sobat praktekkan. Semoga dengan tutorial ini sobat mampu membuat sendiri Browser yang powerfull. Silakan dicoba
mANTAPPPPPPPPPPPPPPP
BalasHapus