VB6 - Visual basic 6 : get document of internet explorer window by domain

get html document from internet explorer window by domain

'Referencnces : Microsoft HTML Object Libray
Option Explicit
    Type UUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type
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 ObjectFromLresult Lib "oleacc.dll" (ByVal lResult As Long, riid As UUID, ByVal wParam As Long, ppvObject As Object) As Long
Private Declare Function RegisterWindowMessage Lib "user32.dll" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpszProgID As Long, pCLSID As UUID) As Long
Private Function WindowDOM(ByVal hwnd As Long) As IHTMLDocument2
Dim typUUID As UUID, lngRes As Long, lngMsg As Long, clid As String
lngMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
If lngMsg <> 0 Then
    lngRes = SendMessage(hwnd, lngMsg, 0&, 0&)
    If lngRes <> 0 Then
        clid = "{626fc520-a41e-11cf-a731-00a0c9082637}"
        Call CLSIDFromString(StrPtr(clid), typUUID)
        Call ObjectFromLresult(lngRes, typUUID, 0, WindowDOM)
    End If
End If
End Function
Private Function getDomainName(doc As IHTMLDocument2) As String
On Error GoTo err
getDomainName = doc.domain
Exit Function
err:
getDomainName = ""
End Function

Public Function getIEdoc_byDomain(domain As String, Optional ByVal hwndParent As Long = 0) As IHTMLDocument2
Dim hwndAfter As Long, retval As Long
Dim lpClassName As String
hwndAfter = FindWindowEx(hwndParent, 0, vbNullString, vbNullString)
Do While hwndAfter <> 0
    lpClassName = Space(256)
    retval = GetClassName(hwndAfter, lpClassName, 256)
    If Left$(lpClassName, retval) = "Internet Explorer_Server" Then
        Set getIEdoc_byDomain = WindowDOM(hwndAfter)
        If getDomainName(getIEdoc_byDomain) = domain Then
            Exit Function
        End If
    End If
    Set getIEdoc_byDomain = getIEdoc_byDomain(domain, hwndAfter)
    If Not getIEdoc_byDomain Is Nothing Then
        Exit Function
    End If
    hwndAfter = FindWindowEx(hwndParent, hwndAfter, vbNullString, vbNullString)
Loop
End Function

'usage:
Sub main()
Dim doc As IHTMLDocument2
Set doc = getIEdoc_byDomain("www.google.com")
End Sub

'if not found -- return nothing