Visual Basic

<br />
Option Explicit<br />
'A demonstration on how to get the Yahoo Chat or PM HTML or Text<br />
'Based on Get YM! Chat Text & HTML from "Internet Explorer_Server" object By: James Johnston<br />
'I cleaned up his method for ease of use, and also reduced the amount of code by 1/10th<br />
'I added the last line and got rid of the extra scroll bar in the HTML version<br />
'Now, I can go back to makin chat bots >:)<br />
'c0ldfyr3 www.EliteProdigy.com<br />
<br />
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long<br />
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<br />
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long<br />
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long<br />
Private Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long<br />
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, lParam As Any, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long<br />
Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As Long, riid As UUID, ByVal wParam As Long, ppvObject As Any) As Long<br />
Private Const SMTO_ABORTIFHUNG      As Long = &H2<br />
Private Const GW_HWNDFIRST          As Long = 0<br />
Private Const GW_HWNDNEXT           As Long = 2<br />
Private Const GW_CHILD              As Long = 5<br />
Private Type UUID<br />
   Data1                            As Long<br />
   Data2                            As Integer<br />
   Data3                            As Integer<br />
   Data4(0 To 7)                    As Byte<br />
End Type<br />
Private Type typWindows<br />
    ClassName                       As String<br />
    hWnd                            As Long<br />
End Type<br />
Private Type typWinFinal<br />
    ChildWindows()                  As typWindows<br />
    Count                           As Integer<br />
End Type<br />
Public Type YIMType<br />
    Text                            As String<br />
    HTML                            As String<br />
End Type<br />
Public Const c_ChatStyle            As String = "<style>" & vbCrLf & _<br />
                                                ".sendername { font-size:10pt;font-family:Arial;font-weight:bold;color:#000000;text-decoration:none };" & vbCrLf & _<br />
                                                ".recvername { font-size:10pt;font-family:Arial;font-weight:bold;color:#0000FF;text-decoration:none };" & vbCrLf & _<br />
                                                ".ymsgrname { font-size:10pt;font-family:Arial;font-weight:bold;color:#FF0000;text-decoration:none };" & vbCrLf & _<br />
                                                ".chatusername { font-size:10pt;font-family:Arial;color:#FF0000;text-decoration:none };" & vbCrLf & _<br />
                                                ".usertext { font-size:10pt;font-family:Arial; };" & vbCrLf & _<br />
                                                ".redstatus { font-size:10pt;font-family:Arial;font-weight:bold;color:#FF0000;text-decoration:none };" & vbCrLf & _<br />
                                                ".greenstatus { font-size:10pt;font-family:Arial;font-weight:bold;color:#008800;text-decoration:none };" & vbCrLf & _<br />
                                                ".graystatus { font-size:10pt;font-family:Arial;font-weight:bold;color:#888888;text-decoration:none };" & vbCrLf & _<br />
                                                ".chatrecver { font-size:10pt;font-family:Arial;font-weight:bold;color:#880000;text-decoration:none };" & vbCrLf & _<br />
                                                ".chatsender { font-size:10pt;font-family:Arial;font-weight:bold;color:#0000FF;text-decoration:none };" & vbCrLf & _<br />
                                                ".chataction { font-size:10pt;font-family;Arial;color:#880088;text-decoration:none };" & vbCrLf & _<br />
                                                "a { color:#0000FF; };" & vbCrLf & _<br />
                                                "p { text-indent:-7;margin-left:10;margin-top:0;margin-bottom:0 };" & vbCrLf & _<br />
                                                "</style>"<br />
Public Const c_PMStyle              As String = "<style>" & vbCrLf & _<br />
                                                ".sendername { font-size:10pt;font-family:Arial;font-weight:bold;color:#000000; }" & vbCrLf & _<br />
                                                ".recvername { font-size:10pt;font-family:Arial;font-weight:bold;color:#0000FF; }" & vbCrLf & _<br />
                                                ".ymsgrname { font-size:10pt;font-family:Arial;font-weight:bold;color:#FF0000; }" & vbCrLf & _<br />
                                                ".usertext { font-size:10pt;font-family:Arial; }" & vbCrLf & _<br />
                                                ".redstatus { font-size:10pt;font-family:Arial;font-weight:bold;color:#FF0000; }" & vbCrLf & _<br />
                                                ".greenstatus { font-size:10pt;font-family:Arial;font-weight:bold;color:#008800; }" & vbCrLf & _<br />
                                                ".graystatus { font-size:10pt;font-family:Arial;font-weight:bold;color:#888888; }" & vbCrLf & _<br />
                                                ".imvnotify { font-size:10pt;font-family:Arial;font-weight:bold;color:#000088; }" & vbCrLf & _<br />
                                                "a { color:#0000FF; }" & vbCrLf & _<br />
                                                "p { text-indent:-7;margin-left:10;margin-top:0;margin-bottom:0 }" & vbCrLf & _<br />
                                                "</style>"<br />
<br />
Public Function GetClassN(ByVal hWnd As Long) As String<br />
    Dim ParentClassName             As String<br />
    Dim Z                           As Long<br />
    ParentClassName = String(100, Chr(0))<br />
    Z = GetClassName(hWnd, ParentClassName, 100)<br />
    GetClassN = Left(ParentClassName, Z)<br />
End Function<br />
Private Function GetChildWindows(hWnd As Long) As typWinFinal<br />
    Dim ChildP                      As Long<br />
    Dim LastChild                   As String<br />
    Dim MainP                       As Long<br />
    Dim WinDetails                  As String<br />
    Dim First                       As Boolean<br />
    Dim AdWin                       As Long<br />
    <br />
    GetChildWindows.Count = -1<br />
    MainP = GetWindow(hWnd, GW_CHILD)<br />
    ChildP = GetWindow(MainP, GW_HWNDFIRST)<br />
    Do While ChildP <> 0<br />
        ChildP = GetWindow(ChildP, GW_HWNDNEXT)<br />
        If ChildP = 0 Then Exit Do<br />
        WinDetails = GetClassN(ChildP)<br />
        <br />
        GetChildWindows.Count = GetChildWindows.Count + 1<br />
        ReDim Preserve GetChildWindows.ChildWindows(GetChildWindows.Count)<br />
        <br />
        With GetChildWindows.ChildWindows(GetChildWindows.Count)<br />
            .ClassName = WinDetails<br />
            .hWnd = ChildP<br />
        End With<br />
        DoEvents<br />
    Loop<br />
End Function<br />
Public Function GetIMText() As YIMType<br />
    Dim IMClass                     As Long<br />
    Dim MidWin                      As Long<br />
    Dim InternetExplorerServer      As Long<br />
    Dim Something                   As typWinFinal<br />
    Dim X                           As Integer<br />
    Dim sTmp                        As String<br />
    Dim yTmp                        As YIMType<br />
    <br />
    'Loop through all the windows finding their handles from predefined classnames.<br />
    IMClass = FindWindow("imclass", vbNullString)<br />
    Something = GetChildWindows(IMClass)<br />
    For X = 0 To Something.Count<br />
        sTmp = Something.ChildWindows(X).ClassName<br />
        If Len(sTmp) > 4 Then<br />
            If StrComp(Left(sTmp, 3), "atl", vbTextCompare) = 0 Then<br />
                InternetExplorerServer = FindWindowEx(Something.ChildWindows(X).hWnd, 0&, "internet explorer_server", vbNullString)<br />
                yTmp = GetIEText(InternetExplorerServer)<br />
                If InStr(1, yTmp.HTML, "function RestoreStyles()") > 0 Then<br />
                    GetIMText = yTmp<br />
                End If<br />
            End If<br />
        End If<br />
    Next<br />
End Function<br />
Private Function GetIEText(ByVal hWnd As Long) As YIMType<br />
    Dim doc                         As IHTMLDocument2<br />
    Dim col                         As IHTMLElementCollection2<br />
    Dim EL                          As IHTMLElement<br />
    Dim l                           As Long<br />
    Dim v1                          As Variant<br />
    Dim v2                          As Variant<br />
    Set doc = IEDOMFromhWnd(hWnd)<br />
    'Pass the data back through the function<br />
    On Error GoTo Ender:<br />
    GetIEText.Text = doc.body.innerText<br />
    GetIEText.HTML = doc.body.innerHTML<br />
    Exit Function<br />
Ender:<br />
    GetIEText.Text = "No Chat Or Pm Open ?"<br />
    Err.Clear<br />
End Function<br />
Private Function IEDOMFromhWnd(ByVal hWnd As Long) As IHTMLDocument<br />
    Dim IID_IHTMLDocument           As UUID<br />
    Dim hWndChild                   As Long<br />
    Dim spDoc                       As IUnknown<br />
    Dim lRes                        As Long<br />
    Dim lMsg                        As Long<br />
    Dim hr                          As Long<br />
    If hWnd <> 0 Then<br />
        'If the Handle is not 0, that means if the window is open .........<br />
        'We tell windows we are going in for the kill, and grabbing the data<br />
        lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")<br />
        Call SendMessageTimeout(hWnd, lMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes)<br />
        If lRes Then<br />
            With IID_IHTMLDocument<br />
                .Data1 = &H626FC520<br />
                .Data2 = &HA41E<br />
                .Data3 = &H11CF<br />
                .Data4(0) = &HA7<br />
                .Data4(1) = &H31<br />
                .Data4(2) = &H0<br />
                .Data4(3) = &HA0<br />
                .Data4(4) = &HC9<br />
                .Data4(5) = &H8<br />
                .Data4(6) = &H26<br />
                .Data4(7) = &H37<br />
            End With<br />
            hr = ObjectFromLresult(lRes, IID_IHTMLDocument, 0, IEDOMFromhWnd)<br />
            'We pass the data back from the function.<br />
        End If<br />
    End If<br />
End Function<br />
<br />
<br />
Public Function GetIMWindowText(lWindow As Long) As YIMType<br />
    Dim IMClass                     As Long<br />
    Dim MidWin                      As Long<br />
    Dim InternetExplorerServer      As Long<br />
    Dim Something                   As typWinFinal<br />
    Dim X                           As Integer<br />
    Dim sTmp                        As String<br />
    Dim yTmp                        As YIMType<br />
    <br />
    'Loop through all the windows finding their handles from predefined classnames.<br />
    'IMClass = FindWindow("imclass", vbNullString)<br />
    Something = GetChildWindows(lWindow)<br />
    For X = 0 To Something.Count<br />
        sTmp = Something.ChildWindows(X).ClassName<br />
        If Len(sTmp) > 4 Then<br />
            If StrComp(Left(sTmp, 3), "atl", vbTextCompare) = 0 Then<br />
                InternetExplorerServer = FindWindowEx(Something.ChildWindows(X).hWnd, 0&, "internet explorer_server", vbNullString)<br />
                yTmp = GetIEText(InternetExplorerServer)<br />
                If InStr(1, yTmp.HTML, "function RestoreStyles()") > 0 Then<br />
                    GetIMWindowText = yTmp<br />
                End If<br />
            End If<br />
        End If<br />
    Next<br />
End Function<br />