Fetching the url of an external Internet Explorer

[bnashenas1984]

I'v been looking around to find a way to fetch the current URL in an external IE.

I finaly found a way to do it but for some reason it doesn't work. It might be because of my IE version. I tested the program on IE6 and IE7 but none of them work

The program uses :
findWindow
getClassName
sendMessage

[QVeen72]

Hi,

Can you post the code..?

[vb5prgrmr]

After FindWindow to find the parent window (i.e. IE), you need to use EnumChildWindows to look for the combo box. Once you have the handle to the combo box, you can use the SendMessage API with the WM_GETTEXT const...

Also: Spy++ would be of great help here...



Good Luck

[bnashenas1984]

Hi and thanks for replying my post.
Actually I solved the issue by checking the title of the window every 10 ms.
IE changes it's title to the url it's opening before loading the page.

But anyways finding a logical way to solve this problem would be great.

Heres my code

Module

Option Explicit
 
Public Type ProcData
    AppHwnd As Long
    title As String
    Placement As String
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
 
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName 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_GETTEXTLENGTH = &HE
 
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Const GW_HWNDFIRST = 0
 
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
 
Public g_Contains As String
 
 
' If this window is of the Edit class, return
' its contents. Otherwise search its children
' for an Edit object.
Public Function EditInfo(window_hwnd As Long) As String
Dim txt As String
Dim buf As String
Dim buflen As Long
Dim child_hwnd As Long
Dim children() As Long
Dim num_children As Integer
Dim i As Integer
 
    ' Get the class name.
    buflen = 256
    buf = Space$(buflen - 1)
    buflen = GetClassName(window_hwnd, buf, buflen)
    buf = Left$(buf, buflen)
 
    ' See if we found an Edit object.
    If buf = "Edit" Then
        EditInfo = WindowText(window_hwnd)
        Exit Function
    End If
 
    ' It's not an Edit object. Search the children.
    ' Make a list of the child windows.
    num_children = 0
    child_hwnd = GetWindow(window_hwnd, GW_CHILD)
    Do While child_hwnd <> 0
        num_children = num_children + 1
        ReDim Preserve children(1 To num_children)
        children(num_children) = child_hwnd
 
        child_hwnd = GetWindow(child_hwnd, GW_HWNDNEXT)
    Loop
 
    ' Get information on the child windows.
    For i = 1 To num_children
        txt = EditInfo(children(i))
        If txt <> "" Then Exit For
    Next i
 
    EditInfo = txt
End Function
' ************************************************
' Return the text associated with the window.
' ************************************************
Public Function WindowText(window_hwnd As Long) As String
Dim txtlen As Long
Dim txt As String
 
    WindowText = ""
    If window_hwnd = 0 Then Exit Function
 
    txtlen = SendMessage(window_hwnd, WM_GETTEXTLENGTH, 0, 0)
    If txtlen = 0 Then Exit Function
 
    txtlen = txtlen + 1
    txt = Space$(txtlen)
    txtlen = SendMessage(window_hwnd, WM_GETTEXT, txtlen, ByVal txt)
    WindowText = Left$(txt, txtlen)
End Function
 
 
Public Function EnumProc(ByVal app_hwnd As Long, ByVal lParam As Long) As Boolean
Dim buf As String * 1024
Dim title As String
Dim length As Long
Dim txt As String
 
    ' Get the window's title.
    length = GetWindowText(app_hwnd, buf, Len(buf))
    title = Left$(buf, length)
 
    ' See if the title contains the target text.
    If InStr(title, g_Contains) > 0 Then
        ' This is the target. Search for the desired path.
        If FollowChildPath(txt, app_hwnd, LCase$("IEFrame/WorkerA/ReBarWindow32/ComboBoxEx32/ComboBox/Edit/")) Then
            frmWindowList.txtAddress.Text = txt
        Else
            frmWindowList.txtAddress.Text = "<not found>"
        End If
 
        ' Stop searching.
        EnumProc = 0
    Else
        ' Continue searching until we find it.
        EnumProc = 1
    End If
End Function
 
' Search this window's children for the specified path.
' If we find the path, return the final window's text
' through parameter window_text and return True.
Public Function FollowChildPath(ByRef window_text As String, ByVal window_hwnd As Long, ByVal target_path As String, Optional ByVal current_path As String = "") As Boolean
Dim txt As String
Dim buf As String
Dim buflen As Long
Dim child_hwnd As Long
Dim children() As Long
Dim num_children As Integer
Dim i As Integer
 
    ' Assume we will not find the target path.
    FollowChildPath = False
 
    ' Get the class name.
    buflen = 256
    buf = Space$(buflen - 1)
    buflen = GetClassName(window_hwnd, buf, buflen)
    buf = Left$(buf, buflen)
 
    ' Add the class name to the current path.
    current_path = current_path & LCase$(buf) & "/"
 
    ' See if we're on the right track.
    If Left$(target_path, Len(current_path)) <> current_path Then
        ' We are off the path. Don't search it.
    ElseIf target_path = current_path Then
        ' We are on the path and have reached the end.
        ' Set the window's text and stop searching.
        If buf = "Edit" Then
            window_text = WindowText(window_hwnd)
        Else
            window_text = "<not an Edit window>"
        End If
 
        FollowChildPath = True
    Else
        ' We are on the path but have not reached the end.
        ' Make a list of the child windows.
        num_children = 0
        child_hwnd = GetWindow(window_hwnd, GW_CHILD)
        Do While child_hwnd <> 0
            num_children = num_children + 1
            ReDim Preserve children(1 To num_children)
            children(num_children) = child_hwnd
 
            child_hwnd = GetWindow(child_hwnd, GW_HWNDNEXT)
        Loop
 
        ' Search the child windows.
        For i = 1 To num_children
            If FollowChildPath(window_text, children(i), target_path, current_path) Then
                ' We found the result. Stop searching.
                FollowChildPath = True
                Exit For
            End If
        Next i
    End If
End Function
 
 

Form load :

Option Explicit
 
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Any, ByVal lParam As Long) As Long
' Start the enumeration.
Private Sub cmdFindAddress_Click()
    g_Contains = " - Microsoft Internet Explorer"
    EnumWindows AddressOf EnumProc, 0
End Sub
 
Private Sub Form_Resize()
    txtAddress.Width = ScaleWidth
End Sub
 

[vb5prgrmr]

>>After FindWindow to find the parent window (i.e. IE), you need to use EnumChildWindows to look for the combo box...

[bnashenas1984]

Hi again
Thank you vb5prgrmr for the reply.
I found another program which grabs all the child windows of selected window (by hWnd)

BUT the problem is that it doesn't contain the url of IE.

Here is my code :


Module :

Private Declare Function EnumChildWindows Lib "user32" ( _
   ByVal hWndParent As Long, ByVal lpEnumFunc As Long, _
   ByVal lParam As Long) As Long
 
Private WndList() As Long
Private NumWnd As Long
 
' Get a list of windows within a specific window
Public Function ListWindows( _
   ByVal inWnd As Long) As Long() 'HWND[]
   NumWnd = 0
   Erase WndList
   Call EnumChildWindows(inWnd, AddressOf EnumChildProc, 0&)
 
   ListWindows = WndList
End Function
 
' Mange the call-back's from the API
Private Function EnumChildProc( _
   ByVal hWnd As Long, ByVal lParam As Long) As Long
   ReDim Preserve WndList(NumWnd) As Long
   WndList(NumWnd) = hWnd
   NumWnd = NumWnd + 1
   EnumChildProc = 1
End Function
 
 

Form_load :

Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias _
   "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) 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 Sub Form_Load()
   Dim Windows() As Long
   Dim NumWnds As Long, LoopWnds As Long
   Dim WndName As String, ClassName As String
 
   Const ClassLength As Long = 1024
 
   ' Get a list of windows within the current window
   Windows() = ListWindows(GetForegroundWindow)
 
   On Error Resume Next ' How many were returned?
   NumWnds = UBound(Windows()) + 1
   On Error GoTo 0
 
   If (NumWnds > 0) Then ' Loop through each
       For LoopWnds = 0 To NumWnds - 1
           ' Get window name and class strings
           ClassName = Space$(ClassLength)
           WndName = Space$(GetWindowTextLength( _
               Windows(LoopWnds)) + 1)
           Call GetWindowText(Windows(LoopWnds), _
               WndName, Len(WndName))
           Call GetClassName(Windows(LoopWnds), _
               ClassName, ClassLength)
 
           ' Display returned results
           Debug.Print "0x" & _
               Hex(Windows(LoopWnds)) & " - """ & _
               TrimNull(WndName) & """ (" & _
               TrimNull(ClassName) & ")"
       Next LoopWnds
   End If
End Sub
 
Private Function TrimNull(ByVal inString As String) As String
   Dim NullPos As Long
 
   ' Trim a null-terminated string
   NullPos = InStr(1, inString, vbNullChar)
   If (NullPos) Then _
       TrimNull = Left$(inString, NullPos - 1) Else _
       TrimNull = inString
End Function
 
 

Please help
I'v been searching whole day

Thanks

[QVeen72]

Hi,

How about this :

Add a Command Button and a ListBox Control on the form, and write this in Command_Click event:

Private Sub Command1_Click()
    Dim oWin As Object, oShApp As Object
    List1.Clear
    Set oShApp = CreateObject("Shell.Application")
    For Each oWin In oShApp.Windows
        If TypeName(oWin.document) = "HTMLDocument" Then
           List1.AddItem oWin.document.URL
        End If
    Next
    Set oShApp = Nothing
End Sub
 

Regards
Veena

[bnashenas1984]

@QVeen72
Oh my god
You are a life saver.

How can I thank you?
I was going to hang my self when I tested this script

Thanks again :)

[QVeen72]

Hi,

You are Welcome :)

Regards
Veena

[bnashenas1984]

@QVeen72
Hi again
I'm using your script in a timer (interval=10) to grab and list a history of all websites the user has visited.

It's working fine now but there is one problem.

Sometimes when I open and close a browser I get this error :

Runtime error '-2147467259 (80004005)':
Automation error
Unspecified error

Do you know why this happens?

[QVeen72]

Hi,

Not sure.. may be, when the VB Script is running, the user is closing the window or something...

Just Write "On Error Resume Next" in the Vb code..

Regards
Veena