Getting the addresses of web sites

[da_silvy]

I was wondering if any one knew how to get the address and title of any sites that the web browser is on?

[reeset]

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:

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

If anyone knows of another way, I would love to hear it.

(Using VB6, SP4)

[da_silvy]

thanks, but i was looking for the way of detecting it, without my program having to shell it!

[Crypt]

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.

'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

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.

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.

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

[reeset]

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.

[da_silvy]

thank you guys all the same, but i could not get either example to work !@ L @ NJKL