|
-
Jun 20th, 2001, 10:33 PM
#1
Thread Starter
Addicted Member
Test IE For URL
If I wanted to test Internet Explorer (not the control) to check if it's currently at a website or better yet, test to see what URL was entered when the user navigates to a site, how could I do so, I would like to sub in another HTML document if they go to a certain website. I have this code, but it's extremely unreliable and un-efficent for what I need, any better ideas?:
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
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 WM_GETTEXT = &HD
Private Const WM_SETTEXT = &HC
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private aHwnds() As Long
Private lHwnds As Long
Public Sub CheckURLs()
Dim lIndex As Long
Dim lHwnd As Long
Dim sURL As String
Dim strBadUrl As String
Dim strRedirectUrl As String
Dim intCounter As Integer
Dim tdDate As String
Dim tdTime As String
Dim blnBlocked As Boolean
Dim blnRan As Boolean
tdDate = Format(Date, "mm/dd/yy")
tdTime = Format(Time, "hh:mm")
' The URL to redirect the "BAD" URLs too, i.e. a Notice saying "This is restricted" or whatever.
strRedirectUrl = App.Path & "\" & "Restricted.html"
' Reset the Browser count
lHwnds = 0
' Enumerate all Top Level windows, looking for IE Browsers, returning a list in the aHwnds() array.
Call EnumWindows(AddressOf EnumWindowsProc, 0)
' If Browsers were found, check each one.
If lHwnds Then
For lIndex = 0 To lHwnds - 1
' Next, Find the Navigation (Address) Box in the Browser
lHwnd = FindIEEditbox(aHwnds(lIndex))
If lHwnd Then
' If it was found, extract the current URL
sURL = Space(255)
sURL = Left(sURL, SendMessage(lHwnd, WM_GETTEXT, 255, ByVal sURL))
' If the URL matches one that's been restricted, redirect the page.
For intCounter = 0 To (frmSettings.cboBanSites.ListCount - 1)
If Left(Replace(LCase(sURL), "http://", ""), Len(frmSettings.cboBanSites.List(intCounter))) = LCase(frmSettings.cboBanSites.List(intCounter)) Then
'Restrict Access to this URL
Call SendMessage(lHwnd, WM_SETTEXT, Len(strRedirectUrl), ByVal strRedirectUrl)
Call SendMessage(lHwnd, WM_KEYDOWN, vbKeyReturn, ByVal 0&)
Call SendMessage(lHwnd, WM_KEYUP, vbKeyReturn, ByVal 0&)
frmMain.lblInfo.Caption = "Last Blocked: " & sURL
blnBlocked = True
Call WriteWebLog(blnBlocked, sURL)
Exit Sub
Else
blnBlocked = False
End If
Next intCounter
End If
Next
End If
End Sub
Private Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim sClass As String
' Check the Class of each Window Enumerated looking for IE Browser Windows (IEFrame)
sClass = Space(255)
sClass = Left(sClass, GetClassName(hwnd, ByVal sClass, 255))
If LCase(sClass) = "ieframe" Then
' When one is found add it to an array
ReDim Preserve aHwnds(lHwnds)
aHwnds(lHwnds) = hwnd
lHwnds = lHwnds + 1
End If
EnumWindowsProc = hwnd
End Function
Function FindIEEditbox(ByVal hwnd As Long) As Long
Dim lHwnd As Long
' Drill down the specified browsers controls until we find the Editbox (Address Entry)
lHwnd = FindWindowEx(hwnd, 0, "WorkerA", vbNullString)
If lHwnd Then
lHwnd = FindWindowEx(lHwnd, 0, "ReBarWindow32", vbNullString)
If lHwnd Then
lHwnd = FindWindowEx(lHwnd, 0, "ComboBoxEx32", vbNullString)
If lHwnd Then
lHwnd = FindWindowEx(lHwnd, 0, "ComboBox", vbNullString)
If lHwnd Then
lHwnd = FindWindowEx(lHwnd, 0, "Edit", vbNullString)
End If
End If
End If
End If
FindIEEditbox = lHwnd
End Function
-
Jun 20th, 2001, 10:42 PM
#2
Thread Starter
Addicted Member
Also...
Is there any event for when a website is navigated to? Is there any API for this?
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|