bob323
Sep 19th, 2000, 11:46 AM
Any idea how to read in the current url (or better yet the text/html of a url) on an explorer window into a variable?
Here you go:
Option Explicit
Private NewURL As String
Private WindowTitle As String
Private DefaultBrowser
Private ValidBrowser As Boolean
Private Enum imDefaultBrowser
imDefaultIE
imDefaultNetscape
imDefaultUnknown
End Enum
Private Declare Function FindExecutable Lib "shell32.dll" _
Alias "FindExecutableA" _
(ByVal lpFile As String, _
ByVal lpDirectory As String, _
ByVal sResult As String) As Long
Private Declare Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" _
(ByVal nSize As Long, _
ByVal lpBuffer As String) As Long
Private Const MAX_PATH As Long = 260
Private Const ERROR_FILE_NO_ASSOCIATION As Long = 31
Private Const ERROR_FILE_NOT_FOUND As Long = 2
Private Const ERROR_PATH_NOT_FOUND As Long = 3
Private Const ERROR_FILE_SUCCESS As Long = 32 'my constant
Private Const ERROR_BAD_FORMAT As Long = 11
Private Sub GetIEURL()
On Error GoTo IEError
If DetermineDefaultBrowser = "Other" Then
MsgBox "No Valid Browser Avalible" & vbNewLine & vbNewLine & _
"Please get Internet Explorer, Netscape, or AOL", _
vbExclamation + vbOKOnly, _
"Internet URL Monitor"
Unload Me
End If
Debug.Print DetermineDefaultBrowser
txtURL.LinkTopic = DetermineDefaultBrowser & "|www_GetWindowInfo"
txtURL.LinkItem = "0xFFFFFFFF"
txtURL.LinkMode = 2
txtURL.LinkRequest
DecodeURL
Exit Sub
IEError:
If Err.Number = 282 Then
txtIEURL.Text = "Web Browser not open"
End If
End Sub
Private Sub DecodeURL()
Dim OldURL As String
Dim pos As Integer
OldURL = txtURL.Text 'set old url
pos = InStr(1, OldURL, ",") 'find url/window title seporator (",")
NewURL = Mid(OldURL, 2, pos - 3) 'extract URL
WindowTitle = Mid(OldURL, pos + 2, (Len(OldURL) - (Len(NewURL) + 3)) - 2)
End Sub
Private Function GetBrowserName(dwFlagReturned As Long) As String
Dim hFile As Long
Dim sResult As String
Dim sTempFolder As String
'get the user's temp folder
sTempFolder = GetTempDir()
'create a dummy html file in the temp dir
hFile = FreeFile
Open sTempFolder & "dummy.html" For Output As #hFile
Close #hFile
'get the file path & name associated with the file
sResult = Space$(MAX_PATH)
dwFlagReturned = FindExecutable("dummy.html", sTempFolder, sResult)
'clean up
Kill sTempFolder & "dummy.html"
'return result
GetBrowserName = TrimNull(sResult)
End Function
Private Function TrimNull(item As String)
Dim pos As Integer
pos = InStr(item, Chr$(0))
If pos Then
TrimNull = Left$(item, pos - 1)
Else: TrimNull = item
End If
End Function
Public Function GetTempDir() As String
Dim nSize As Long
Dim tmp As String
tmp = Space$(256)
nSize = Len(tmp)
Call GetTempPath(nSize, tmp)
GetTempDir = TrimNull(tmp)
End Function
'--end block--'
Private Function DetermineDefaultBrowser() As String
Dim BrowserPath
Dim Success As Long
BrowserPath = GetBrowserName(Success)
If InStr(1, BrowserPath, "iexplore") Then
DetermineDefaultBrowser = "IExplore"
ElseIf InStr(1, BrowserPath, "netscape") Then
DetermineDefaultBrowser = "Netscape"
Else
DetermineDefaultBrowser = "Other"
End If
End Function