Diberdayakan oleh Blogger.

What's Awesome

About Me

Explore The Archive

JS

Tutorial Membuat WebBrowser Full VB6

D-EFR

on Sabtu, 20 Oktober 2012 | 19.21.00

TUtorial Membuat WebBrowser Full :D

Klik "Project" pada menu diatas pilih "Components" atau bisa juga dengan menekan CTRL+T Pada keyboard PC kalian :hmm dan pilih :

- Microsoft html object library
- Microsoft internet controls
- Microsoft Windows common Controls 5.0


Object tersebut akan muncul disebelah kiri dari program visual basic kalian
disana ada objek yang bernama "WebBrowser1" Tambahkan ke form ( perogram yang kita buat tersebut) dan tambahkan juga "Progress bar"

Notes : "Progress bar tersebut di gunakan untuk alamat tujuan kita . untuk contoh You are not allowed to view links. Register or Login to view." mengerti bukan ?

Tambahkan "6" Command Button dan isikan nama berikut :

"Back","Forward","Stop","Refresh","Home" and "GO"

Notes : Isikan nama pada "Caption" bukan "Name"

Isi code berikut pada command button " GO " :

Code:
WebBrowser1.Navigate Combo1

Back :

Code:
On Error Resume Next
WebBrowser1.GoBack

Forward :

Code:
On Error Resume Next
WebBrowser1.GoForward

Stop :

Code:
On Error Resume Next
WebBrowser1.Stop

Refresh :

Code:
WebBrowser1.Refresh

Home :

Code:
WebBrowser1.GoHome

SEKARANG ANDA BISA MENCOBA MENGGUNAKAN BROWSER WEB BARU ANDA. TAPI MASIH " SEDERHANA/SIMPLE"

Tambahkan code tersebut dimana saja dikode aplikasi/program anda :

* Ditambahkan di ProgressBarr :

Code:
'Ini bekerja untuk pesan setatus dan gambar reggae-cyber.tk.
    Private Sub WebBrowser1_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
    On Error Resume Next
        If Progress = -1 Then ProgressBar1.Value = 100 'the name of the progress bar is "ProgressBar1".
            Label1.Caption = "Done"
            ProgressBar1.Visible = False 'This makes the progress bar disappear after the page is loaded.
            Image1.Visible = True
        If Progress > 0 And ProgressMax > 0 Then
            ProgressBar1.Visible = True
            Image1.Visible = False
            ProgressBar1.Value = Progress * 100 / ProgressMax
            Label1.Caption = Int(Progress * 100 / ProgressMax) & "%"
        End If
        Exit Sub
    End Sub

Tapi di sini Anda perlu menambahkan label yang disebut "Label1" dan juga gambar kecil seperti senyum atau apapun yang Anda inginkan dan nama adalah "image1"

Buka di form baru :

Code:
'Buka form baru " ingat form baru" reggae-cyber.tk
    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

Ini untuk membuka New Tab dengan browser Anda.

* history dan situs yang dikunjungi saat ini.

Code:
'Hal ini membuat sejarah/History situs dikunjungi dan juga mengubah judul browser sebagai judul halaman. Reggae-cyber.tk
    Private Sub WebBrowser1_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
        On Error Resume Next
        Dim i As Integer
        Dim bFound As Boolean
        Me.Caption = WebBrowser1.LocationName
        For i = 0 To Combo1.ListCount - 1
            If Combo1.List(i) = WebBrowser1.LocationURL Then
                bFound = True
                Exit For
            End If
        Next i
        mbDontNavigateNow = True
        If bFound Then
            Combo1.RemoveItem i
        End If
        Combo1.AddItem WebBrowser1.LocationURL, 0
        Combo1.ListIndex = 0
        mbDontNavigateNow = False
    End Sub

Anda dapat menambahkan tombol apapun asalkan untuk kepentingan program anda :

Code:
'This to tell you if a word is in the page, Here we call the WebPageContains function.
    Private Sub Command7_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
    'This is the finding function.
    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

Code:
WebBrowser1.ExecWB OLECMDID_PROPERTIES, OLECMDEXECOPT_DODEFAULT

* Page properties :

Code:
WebBrowser1.ExecWB OLECMDID_PROPERTIES, OLECMDEXECOPT_DODEFAULT

*Ini akan menjalankan page properties.

Code:
WebBrowser1.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT

Save a page :

Code:
WebBrowser1.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT

*Hapus cookies dari komputer kalian

Code:
'This code is used to empty the cookies from the user's computer / We call function from here.
    Private Declare Function GetUserName _
    Lib "advapi32.dll" Alias "GetUserNameW" ( _
    ByVal lpBuffer As Long, _
    ByRef nSize As Long) As Long
    Private Declare Function SHGetSpecialFolderPath _
    Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" ( _
    ByVal hwnd As Long, _
    ByVal pszPath As String, _
    ByVal csidl As Long, _
    ByVal fCreate As Long) As Long
    Private Const CSIDL_COOKIES As Long = &H21
    'This calls the function that deletes the cookies.
    Public Sub Command1_Click()
    Dim sPath As String
    sPath = Space(260)
    Call SHGetSpecialFolderPath(0, sPath, CSIDL_COOKIES, False)
    sPath = Left$(sPath, InStr(sPath, vbNullChar) - 1) & "\*.txt*"
    On Error Resume Next
    Kill sPath
    End Sub

*Membuka HTML webpage :

Code:
Private Sub Form_Load()
    Text1.Text = Form1.browser.Document.documentElement.innerHTML
    End Sub

*Popup Blocker :

Code:
Private Function IsPopupWindow() As Boolean
    On Error Resume Next
    If WebBrowser1.Document.activeElement.tagName = "BODY" Or WebBrowser1.Document.activeElement.tagName = "IFRAME" Then
    IsPopupWindow = True
    Else
    IsPopupWindow = False
    End If
    End Function
    Private Sub webbrowser1_NewWindow2(ppDisp As Object, Cancel As Boolean)
    Dim frm As Form1
    Cancel = IsPopupWindow
    If Cancel = False Then
    Set frm = New Form1
    Set ppDisp = frm.WebBrowser1.object
    frm.Show
    End If
    End Sub

Ini akan memblokir semua pop-up, tapi di saat yang sama akan membuka link new tab seperti biasa.

* JavaScripts handeling

Code:
WebBrowser1.Silent = True

* Ukuran browser dan kode scrollbars :

Code:
Private Sub Form_Resize()
    On Error Resume Next
    WebBrowser1.Width = Me.ScaleWidth
    WebBrowser1.Height = Me.ScaleHeight - 1680
    End Sub

Selesai anda cuma perlu Icon dan gambar , kreasikan sebisa kalian :mohon


[Image: attachment.php?s=80dfc0b51cd0d98d567ee5e...1150487281]

NB : Hargailah Postingan Saya Dengan Menekan Tombol REP and kalo mau copy paste sertakan penulisnya cape nih :capek

/[ 0 komentar Untuk Artikel Tutorial Membuat WebBrowser Full VB6]\

Posting Komentar