I finally found my old codes from last year:
Code:Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) _
As Long
Private Const CB_FINDSTRING As Long = &H14C
Dim mbDontNavigateNow As Boolean
Private Minimized As FormWindowStateConstants
Public Sub ComboAutoComplete(ByRef SourceCtl As VB.ComboBox, _
ByRef KeyAscii As Integer, ByRef LeftOffPos As Long)
Dim iStart As Long
Dim sSearchKey As String
With SourceCtl
'If text entered so far matches item(s) in the list, use autocomplete
Select Case Chr$(KeyAscii)
Case vbBack
'Let backspace characters process as usual; otherwise try to match text
Case Else
If Chr$(KeyAscii) <> vbBack Then
.SelText = Chr$(KeyAscii)
iStart = .SelStart
If LeftOffPos <> 0 Then
.SelStart = LeftOffPos
iStart = LeftOffPos
End If
sSearchKey = CStr(Left$(.Text, iStart))
.ListIndex = SendMessage(.hWnd, CB_FINDSTRING, -1, _
ByVal CStr(Left$(.Text, iStart)))
If .ListIndex = -1 Then
LeftOffPos = Len(sSearchKey)
End If
.SelStart = iStart
.SelLength = Len(.Text)
LeftOffPos = 0
KeyAscii = 0
End If
End Select
End With
End Sub
Private Sub brwWebBrowser_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
URL = cboAddress.Text
If cboAddress.Text = "www.myspace.com" Or cboAddress.Text = "http://www.myspace.com" Or cboAddress.Text = "http://myspace.com" Or cboAddress.Text = "myspace.com" Then
MsgBox "Access Denied! " & URL & " is blocked for bad stuff.", vbCritical
Cancel = True
Me.Caption = "Access Denied!" & " - App Name"
ElseIf cboAddress.Text = "www.philywily.com" Or cboAddress.Text = "http://philywily.com" Or cboAddress.Text = "http://www.philywily.com" Or cboAddress.Text = "philywily.com" Then
MsgBox "Access Denied! " & URL & " is blocked for going through websites.", vbCritical
Cancel = True
Me.Caption = "Access Denied!" & " - App Name"
End If
End Sub
Private Sub brwWebBrowser_DownloadComplete()
On Error Resume Next
Me.Caption = brwWebBrowser.LocationName & " - App Name"
End Sub
Private Sub brwWebBrowser_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
Dim i As Integer
Dim bFound As Boolean
Me.Caption = brwWebBrowser.LocationName & " - App Name"
For i = 0 To cboAddress.ListCount - 1
If cboAddress.List(i) = brwWebBrowser.LocationURL Then
bFound = True
Exit For
End If
Next i
mbDontNavigateNow = True
cboAddress.AddItem brwWebBrowser.LocationURL, 0
cboAddress.ListIndex = 0
mbDontNavigateNow = False
stbStatus.Panels(1).Text = "Waiting for " & cboAddress.Text & " ..."
End Sub
Private Function IsPopupWindow() As Boolean
On Error Resume Next
If brwWebBrowser.Document.activeElement.tagName = "BODY" Or brwWebBrowser.Document.activeElement.tagName = "IFRAME" Then
IsPopupWindow = True
Else
IsPopupWindow = False
End If
End Function
Private Sub brwWebBrowser_NewWindow2(ppDisp As Object, Cancel As Boolean)
On Error Resume Next
Dim frmNW As frmApp
Cancel = IsPopupWindow
Set frmNW = New frmApp
frmNW.brwWebBrowser.RegisterAsBrowser = True
Set ppDisp = frmNW.brwWebBrowser.object
frmNW.Show
Popups.Visible = True And False
End Sub
Private Function Popups() As frmApp
Dim frmAds As frmApp
Dim ppDisp As Object
Dim Cancel As Boolean
If Cancel = False Then
Set frmAds = New frmApp
Set ppDisp = frmAds.brwWebBrowser.object
frmAds.Visible = True And False
Unload frmAds
End If
End Function
Private Sub brwWebBrowser_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
On Error Resume Next
If Progress = -1 Then
prgInternet.Value = 100
Else
prgInternet.Value = 0
stbStatus.Panels(1).Text = "Done"
End If
If Progress > 0 Or ProgressMax > 0 Then
prgInternet.Value = Progress * 100 / ProgressMax
End If
End Sub
Private Sub cboAddress_KeyPress(KeyAscii As Integer)
On Error Resume Next
If KeyAscii = vbKeyReturn Then
brwWebBrowser.Navigate (cboAddress.Text)
End If
Static iLeftOff As Long
ComboAutoComplete cboAddress, KeyAscii, iLeftOff
End Sub
Private Sub Form_Load()
lblTime.Caption = Time
timTimer.Interval = 1000
lblDate.Caption = Date
lblDate.Alignment = 2
brwWebBrowser.Silent = True
brwWebBrowser.GoHome
End Sub
Private Sub Form_Resize()
Dim laststate As String
laststate = Me.WindowState
If Me.WindowState <> vbMinimized Then
brwWebBrowser.Height = Me.Height - 3550
brwWebBrowser.Width = Me.Width - 100
End If
End Sub
Private Sub cmdGo_Click()
brwWebBrowser.Navigate (cboAddress.Text)
End Sub
Private Sub mnuAbout_Click()
frmAbout.Visible = True
End Sub
Private Sub mnuExit_Click()
Me.Visible = False
Unload Me
End Sub
Private Sub mnuFind_Click()
brwWebBrowser.ExecWB OLECMDID_FIND, OLECMDEXECOPT_DODEFAULT, Null, Null
End Sub
Private Sub mnuSamllest_Click()
brwWebBrowser.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DODEFAULT, CLng(4 - 4), Null
End Sub
Private Sub mnuOpen_Click()
On Error Resume Next
brwWebBrowser.ExecWB OLECMDID_OPEN, OLECMDEXECOPT_PROMPTUSER, Null, Null
With cmnInternet
.DialogTitle = "Open File(s) onto Web Browser"
.Filter = "Web page (*.htm;*.html) | *.htm;*.html|" & "All Supported Picture formats|*.gif;*.tif;*.pcd;*.jpg;*.wmf;" & "*.tga;*.jpeg;*.ras;*.png;*.eps;*.bmp;*.pcx|" & "Text formats (*.txt;*.doc)|*.txt;*.doc|" & "All files (*.*)|*.*|"
.ShowOpen
.Flags = 5
End With
brwWebBrowser.Navigate2 cmnInternet.FileName
End Sub
Private Sub mnuSave_Click()
brwWebBrowser.ExecWB OLECMDID_SAVE, OLECMDEXECOPT_PROMPTUSER, Null, Null
With cmnInternet
.DialogTitle = "Save Files from Website"
.Filter = "Web page (*.htm;*.html) | *.htm;*.html|" & "All Supported Picture formats|*.gif;*.tif;*.pcd;*.jpg;*.wmf;" & "*.tga;*.jpeg;*.ras;*.png;*.eps;*.bmp;*.pcx|" & "Text formats (*.txt;*.doc)|*.txt;*.doc|" & "All files (*.*)|*.*|"
.ShowSave
.Flags = 5
End With
End Sub
Private Sub mnuSaveAs_Click()
brwWebBrowser.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_PROMPTUSER, Null, Null
End Sub
Private Sub mnuSmaller_Click()
brwWebBrowser.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DODEFAULT, CLng(4 - 3), Null
End Sub
Private Sub mnuMedium_Click()
brwWebBrowser.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DODEFAULT, CLng(4 - 2), Null
End Sub
Private Sub mnuLarger_Click()
brwWebBrowser.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DODEFAULT, CLng(4 - 1), Null
End Sub
Private Sub mnuLargest_Click()
brwWebBrowser.ExecWB OLECMDID_ZOOM, OLECMDEXECOPT_DODEFAULT, CLng(4 - 0), Null
End Sub
Private Sub tbsNavigate_Click()
Select Case tbsNavigate.SelectedItem.Key
Case "Home"
brwWebBrowser.GoHome
Case "New"
brwWebBrowser.Navigate (Scriptlet1.URL)
Case "New 2"
brwWebBrowser.Navigate (Scriptlet1.URL)
End Select
End Sub
Private Sub mnuInternetOptions_Click()
Dim lRet As Long
Dim ShowInetProperties As Boolean
lRet = Shell("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl,,0", vbNormalFocus)
ShowInetProperties = lRet > 0
End Sub
Private Sub mnuPrintPreview_Click()
brwWebBrowser.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_PROMPTUSER, Null, Null
End Sub
Private Sub mnuPageSetup_Click()
brwWebBrowser.ExecWB OLECMDID_PAGESETUP, OLECMDEXECOPT_PROMPTUSER, Null, Null
End Sub
Private Sub mnuPrint_Click()
brwWebBrowser.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER, Null, Null
End Sub
Private Sub timTimer_Timer()
lblTime.Caption = Time
timTimer.Interval = 1000
End Sub
Private Sub tlbNavigate_ButtonClick(ByVal Button As ComctlLib.Button)
Select Case Button.Key
Case "Back"
brwWebBrowser.GoBack
Case "Forward"
brwWebBrowser.GoForward
Case "Stop"
brwWebBrowser.Stop
Case "Refresh"
brwWebBrowser.Refresh
Case "Search"
brwWebBrowser.GoSearch
Case "Home"
brwWebBrowser.GoHome
Case "Print"
brwWebBrowser.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, Null, Null
End Select
End Sub
