I was wondering if any one knew how to get the address and title of any sites that the web browser is on?
Printable View
I was wondering if any one knew how to get the address and title of any sites that the web browser is on?
Well, I can give the answer that works right now for all versions of IE, that I am aware of, but this might not work forever. You see, with IE4, you could use the GetObjects command to get the InternetExplorer.Application object. However, with IE 5+, this feature was closed for security reasons. Whether that is good or bad, it is a serious pain if you do a lot of scripting through the Windows Scripting Host. However, because IE is an Application, you can shell it through the Shell.Application object. This function, I am told by the Microsoft Documentation, is made available through the Shell32.dll. Now I don't know if this is something that will be closed in future releases of IE, but for now, I say use it. Here is how it works:
If anyone knows of another way, I would love to hear it.Code:
Private Sub Command1_Click()
Dim objShell As Object
Dim objShellWindows
Dim objIEApp
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows
'Here we place all open sessions of IE into a collection.
'So the first instance of IE would be item(0), the
'second item(1), the third Item(2) and so on. You can
'the Window count by using objShellWindows.Count
Set objWindow = objShellWindows.Item(0)
'Set the on Error, just in case an instance of IE does
'not exist.
On Error Resume Next
'Once set, you can do anything with IE that you could
'do with the Webbrowser control. You have total control
'of the available features.
Set objIEApp = objWindow.Application 'get the application object
If Err<>0 then
Exit sub
end if
MsgBox objIEApp.Document.Title & "---URL " & objIEApp.Document.location.href
Set objIEApp=Nothing
Set objWindow=Nothing
Set objShellWindows=Nothing
Set objShell=Nothing
End Sub
(Using VB6, SP4)
thanks, but i was looking for the way of detecting it, without my program having to shell it!
ok I threw this example together its probably not the best soloution, but it works for internet explorer, its not commented as most of it is pretty straight forward is just involves enuming the windows to find the internet explorers, and then enum the child windows of the internet explorers, etc.
and hey presto list2 should hold the values of the internet explorer address, as long as it has the address bar, I don't know if it will work for windows where the address bar is hidden, as I don't know if the hidden address bar holds the address or it is held in a string for those cases.Code:'you will need to add two listboxes and a command button
'to a form, list1 is a hidden control so set its visible
'property to false.
'ok in a module:
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Boolean
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Public Const WM_GETTEXT = &HD
Public Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim WinText As String, Ret As Long
Ret = GetWindowTextLength(hwnd)
WinText = Space(Ret)
GetWindowText hwnd, WinText, Ret + 1
If InStr(1, LCase(WinText), "- microsoft internet explorer") <> 0 Then
Form1.List1.AddItem hwnd
End If
EnumWindowsProc = True
End Function
Public Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim WinText As String, Ret As Long
WinText = Space(300)
Ret = SendMessage(hwnd, WM_GETTEXT, 300, WinText)
'Now I use the sendmessage api ^^^ there instead of
'the getwindowtext api because, the getwindow text
'api won't get the text out of combo box's textboxes
'etc on other windows something to do with tryinh to
'block password sniffers but the sendmessage api
'works a charm.
WinText = Left(WinText, Ret)
Dim CName As String, Ret2 As Long
CName = Space(200)
Ret2 = GetClassName(hwnd, CName, 200)
CName = Left(CName, Ret2)
If CName = "ComboBoxEx32" Then
Form1.List2.AddItem WinText
End If
EnumChildProc = 1
End Function
'Now in the command button put this code:
Private Sub Command1_Click()
EnumWindows AddressOf EnumWindowsProc, ByVal 0&
Dim i As Long
For i = 0 To List1.ListCount - 1
EnumChildWindows List1.List(i), AddressOf EnumChildProc, ByVal 0&
Next i
End Sub
anyway its probably not the best soloution but it was the only way I could think of and actually do, I couldn't do one for netscape as I don't have it and know its address bar's class name.
This is an example gwdash gave, works great.
Code: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
da_silvy:
When you use the Shell.Application parameters, you are not technically shelling anything. Rather, you are accessing the Windows Shell, and looking for a version of the Shell that has an Application extention. Explorer.exe does not have this extension, so that leaves just iexplorer.exe. You can use the code I gave you, and then just check to see if the item collection is empty or not. If it is, then a IE isn't open, if it isn't, then there is a version of IE open.
thank you guys all the same, but i could not get either example to work !@ L @ NJKL