Help with API call?

[amvx86]

I have an old API from a bas file, and I'm trying to convert it. I think I'm on the right track however, I keep running into some problems with it. I can post the old one, and the new one, with the edits that I've made. Is there anyone who would be able to assist me? I don't want someone to re-write the bas or module for me -- I'd like some pointers on where i'm going wrong, and where i've gone wrong and waht to change. Or, is this too much to ask for? I don't want to seem like I'm doing it for homework and want someone to help me -- I think I'm well passed the age of homework :-X lol

./amvx86

[tinstaafl]

Feel free to post what you have. I woulkd suggest, though that if the code is lengthy and there are quite a few problems to break it down into several questions instead of one big massive one. This not only keeps the answers focused but also assists other members who might be researching solutions to the same problems.

[amvx86]

The code is an old module, I think I have it worked out, so I might post original code first, my modded code, and questions on what I'm looking to achieve if possible? I remember you helping me a long time ago about putting the cart before the horse -- dude, i've come a long way and I appreciate the help :-) I'll post in a hot minute.

[amvx86]

This is the old bas / module that I used in VB6...

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (ByVal lpString As String) As Long
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
Private Declare Function ObjectFromLresult Lib "oleacc" (ByVal lResult As Long, riid As UUID, ByVal wParam As Long, ppvObject As Any) As Long
Private Const SMTO_ABORTIFHUNG = &H2
Private Type UUID
   Data1                            As Long
   Data2                            As Integer
   Data3                            As Integer
   Data4(0 To 7)                    As Byte
End Type
Public Type YIMType
    Text                            As String
    HTML                            As String
End Type
Public Function GetIMText() As YIMType
    Dim IMClass                     As Long
    Dim MidWin                      As Long
    Dim InternetExplorerServer      As Long
    'Loop through all the windows finding their handles from predefined classnames.
    IMClass = FindWindow("imclass", vbNullString)
    MidWin = FindWindowEx(IMClass, 0&, "ATL:004EFB68", vbNullString)
    'Loop through all the windows finding their handles from predefined classnames.
    If MidWin = 0 Then
        MidWin = FindWindowEx(IMClass, 0&, "ATL:004F0BA8", vbNullString)
        If MidWin = 0 Then
            MidWin = FindWindowEx(IMClass, 0&, "ATL:004EEB68", vbNullString)
            If MidWin = 0 Then MidWin = FindWindowEx(IMClass, 0&, "ATL:004EBB50", vbNullString)
        End If
        'If you have some errors with the pms not being open, use my API Spy available at www.EliteProdigy.com
        'to get a new value for the ATL:004F0BA8, they seem to change that with every revision of their
        'messenger program, no sweat tho, its easy find.
    End If
    InternetExplorerServer = FindWindowEx(atlefb, 0&, "internet explorer_server", vbNullString)
    Stop
    'The last window we need to find, is the window which the text is in.
    'We grab its handle, and pass it into out GetText function.
    GetIMText = GetIEText(InternetExplorerServer)
End Function
Private Function GetIEText(ByVal hWnd As Long) As YIMType
    Dim doc                         As IHTMLDocument2
    Dim col                         As IHTMLElementCollection2
    Dim EL                          As IHTMLElement
    Dim l                           As Long
    Dim v1                          As Variant
    Dim v2                          As Variant
    Set doc = IEDOMFromhWnd(hWnd)
    'Pass the data back through the function
    On Error GoTo Ender:
    GetIEText.Text = doc.body.innerText
    GetIEText.HTML = doc.body.innerHTML
    Exit Function
Ender:
    GetIEText.Text = "No Chat Or Pm Open ?"
    Err.Clear
End Function
Private Function IEDOMFromhWnd(ByVal hWnd As Long) As IHTMLDocument
    Dim IID_IHTMLDocument           As UUID
    Dim hWndChild                   As Long
    Dim spDoc                       As IUnknown
    Dim lRes                        As Long
    Dim lMsg                        As Long
    Dim hr                          As Long
    If hWnd <> 0 Then
        'If the Handle is not 0, that means if the window is open .........
        'We tell windows we are going in for the kill, and grabbing the data
        lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
        Call SendMessageTimeout(hWnd, lMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes)
        If lRes Then
            With IID_IHTMLDocument
                .Data1 = &H626FC520
                .Data2 = &HA41E
                .Data3 = &H11CF
                .Data4(0) = &HA7
                .Data4(1) = &H31
                .Data4(2) = &H0
                .Data4(3) = &HA0
                .Data4(4) = &HC9
                .Data4(5) = &H8
                .Data4(6) = &H26
                .Data4(7) = &H37
            End With
            hr = ObjectFromLresult(lRes, IID_IHTMLDocument, 0, IEDOMFromhWnd)
            'We pass the data back from the function.
        End If
    End If
End Function

So the above is the code that I'm working with. I've gotten around to most of it and the use of type is no longer supported in VB 2010. The next segment is a listing of what I have done but it is still FAR off... Any suggestions?

[amvx86]

Here is some of the code I converted, but I still lack the know how to make it functional. Any suggestions?

    Structure UUID
        Public Data1 As Long
        Public Data2 As Integer
        Public Data3 As Integer
        Public data4() As Long
        'Data4(0 to 7) As Byte
    End Structure
    Structure typWindows
        Public ClassName As String
        Public hWnd As Long
    End Structure
    Structure typWinFinal
        Public ChildWindows() As typWindows
        Public Count As Integer
    End Structure
    Structure YIMType
        Public Text As String
        Public HTML As String
    End Structure
    Public Const c_ChatStyle As String = "<STYLE>" & vbCrLf & _
                                                ".sendername { font-size:10pt;font-family:Arial;font-weight:bold;color:#000000;text-decoration:none };" & vbCrLf & _
                                                ".recvername { font-size:10pt;font-family:Arial;font-weight:bold;color:#0000FF;text-decoration:none };" & vbCrLf & _
                                                ".ymsgrname { font-size:10pt;font-family:Arial;font-weight:bold;color:#FF0000;text-decoration:none };" & vbCrLf & _
                                                ".chatusername { font-size:10pt;font-family:Arial;color:#FF0000;text-decoration:none };" & vbCrLf & _
                                                ".usertext { font-size:10pt;font-family:Arial; };" & vbCrLf & _
                                                ".redstatus { font-size:10pt;font-family:Arial;font-weight:bold;color:#FF0000;text-decoration:none };" & vbCrLf & _
                                                ".greenstatus { font-size:10pt;font-family:Arial;font-weight:bold;color:#008800;text-decoration:none };" & vbCrLf & _
                                                ".graystatus { font-size:10pt;font-family:Arial;font-weight:bold;color:#888888;text-decoration:none };" & vbCrLf & _
                                                ".chatrecver { font-size:10pt;font-family:Arial;font-weight:bold;color:#880000;text-decoration:none };" & vbCrLf & _
                                                ".chatsender { font-size:10pt;font-family:Arial;font-weight:bold;color:#0000FF;text-decoration:none };" & vbCrLf & _
                                                ".chataction { font-size:10pt;font-family;Arial;color:#880088;text-decoration:none };" & vbCrLf & _
                                                "a { color:#0000FF; };" & vbCrLf & _
                                                "p { text-indent:-7;margin-left:10;margin-top:0;margin-bottom:0 };" & vbCrLf & _
                                                "</STYLE>"
    Public Const c_PMStyle As String = "<STYLE>" & vbCrLf & _
                                                    ".sendername { font-size:10pt;font-family:Arial;font-weight:bold;color:#000000; }" & vbCrLf & _
                                                    ".recvername { font-size:10pt;font-family:Arial;font-weight:bold;color:#0000FF; }" & vbCrLf & _
                                                    ".ymsgrname { font-size:10pt;font-family:Arial;font-weight:bold;color:#FF0000; }" & vbCrLf & _
                                                    ".usertext { font-size:10pt;font-family:Arial; }" & vbCrLf & _
                                                    ".redstatus { font-size:10pt;font-family:Arial;font-weight:bold;color:#FF0000; }" & vbCrLf & _
                                                    ".greenstatus { font-size:10pt;font-family:Arial;font-weight:bold;color:#008800; }" & vbCrLf & _
                                                    ".graystatus { font-size:10pt;font-family:Arial;font-weight:bold;color:#888888; }" & vbCrLf & _
                                                    ".imvnotify { font-size:10pt;font-family:Arial;font-weight:bold;color:#000088; }" & vbCrLf & _
                                                    "a { color:#0000FF; }" & vbCrLf & _
                                                    "p { text-indent:-7;margin-left:10;margin-top:0;margin-bottom:0 }" & vbCrLf & _
                                                    "</STYLE>"
    Public Function GetClassN(ByVal hWnd As Long) As String
        Dim ParentClassName As String
        Dim Z As Long
        '//THIS MIGHT BE GREATLY FUCKED UP SO CHECK IT LATER
        ParentClassName = String.Concat(100, Chr(0))
        Z = GetClassName(hWnd, ParentClassName.Clone, 100)
        GetClassN = Microsoft.VisualBasic.Left(ParentClassName, Z)
    End Function
    Private Function GetChildWindows(ByVal hWnd As Long) As typWinFinal
        Dim ChildP As Long
        Dim LastChild As String
        Dim MainP As Long
        Dim WinDetails As String
        Dim First As Boolean
        Dim AdWin As Long

        GetChildWindows.Count = -1
        MainP = GetWindow(hWnd, GW_CHILD)
        ChildP = GetWindow(MainP, GW_HWNDFIRST)
        Do While ChildP <> 0
            ChildP = GetWindow(ChildP, GW_HWNDNEXT)
            If ChildP = 0 Then Exit Do
            WinDetails = GetClassN(ChildP)

            GetChildWindows.Count = GetChildWindows.Count + 1
            ReDim Preserve GetChildWindows.ChildWindows(GetChildWindows.Count)

            With GetChildWindows.ChildWindows(GetChildWindows.Count)
                .ClassName = WinDetails
                .hWnd = ChildP
            End With
            Application.DoEvents()
        Loop
    End Function

    Public Function GetIMText() As YIMType
        Dim IMClass As Long
        Dim MidWin As Long
        Dim InternetExplorerServer As Long
        Dim Something As typWinFinal
        Dim X As Integer
        Dim sTmp As String
        Dim yTmp As YIMType

        'Loop through all the windows finding their handles from predefined classnames.
        IMClass = FindWindow("imclass", vbNullString)
        Something = GetChildWindows(IMClass)
        For X = 0 To Something.Count
            sTmp = Something.ChildWindows(X).ClassName
            If Len(sTmp) > 4 Then
                If StrComp(Microsoft.VisualBasic.Left(sTmp, 3), "atl", vbTextCompare) = 0 Then
                    InternetExplorerServer = FindWindowEx(Something.ChildWindows(X).hWnd, 0&, "internet explorer_server", vbNullString)
                    yTmp = GetIEText(InternetExplorerServer)
                    If InStr(1, yTmp.HTML, "function RestoreStyles()") > 0 Then
                        GetIMText = yTmp
                    End If
                End If
            End If
        Next
    End Function

    Private Function GetIEText(ByVal hWnd As Long) As YIMType
        '     Dim doc As IHTMLDocument2
        '    Dim col As IHTMLElementCollection2
        '   Dim EL As IHTMLElement
        Dim l As Long
        Dim v1 As Object
        Dim v2 As Object
        '  doc = IEDOMFromhWnd(hWnd)
        'Pass the data back through the function
        On Error GoTo Ender
        ' GetIEText.Text = doc.body.innerText
        'GetIEText.HTML = doc.body.innerHTML
        Exit Function
Ender:
        GetIEText.Text = "No Chat Or Pm Open ?"
        Err.Clear()
    End Function

    <Flags()> _
    Public Enum SendMessageTimeoutFlags
        SMTO_NORMAL = 0
        SMTO_BLOCK = 1
        SMTO_ABORTIFHUNG = 2
        SMTO_NOTIMEOUTIFNOTHUNG = 8
    End Enum
    <DllImport("user32.dll", SetLastError:=True)> _
    Public Shared Function SendMessageTimeout(ByVal windowHandle As IntPtr, ByVal Msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr, ByVal flags As SendMessageTimeoutFlags, ByVal timeout As Integer, ByRef result As IntPtr) As IntPtr
    End Function

    Private Function IEDOMFromhWnd(ByVal hWnd As Long) As HtmlDocument
        Dim IID_IHTMLDocument
        Dim hWndChild As Long
        Dim IUnknown As String
        Dim spDoc = IUnknown
        Dim lRes
        Dim lMsg As Long
        Dim hr As Long
        If hWnd <> 0 Then
            ' If the Handle is not 0, that means if the window is open .........
            'We tell windows we are going in for the kill, and grabbing the data
            lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
            Call SendMessageTimeout(hWnd, lMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes)
            If lRes Then
                With IID_IHTMLDocument
                    .Data1 = &H626FC520
                    .Data2 = &HA41E
                    .Data3 = &H11CF
                    .data4(0) = &HA7
                    .data4(1) = &H31
                    .data4(2) = &H0
                    .data4(3) = &HA0
                    .data4(4) = &HC9
                    .data4(5) = &H8
                    .data4(6) = &H26
                    .data4(7) = &H37
                End With
                hr = ObjectFromLresult(lRes, IID_IHTMLDocument, 0)
                'hr = ObjectFromLresult(lRes, lRes, IEDOMFromhWnd)
                'We pass the data back from the function.
            End If
        End If
        'End If

    End Function

I'd really appreciate the help and feedback.

[amvx86]

No suggestions?

[cgeier]

Here are a few things that you can try:

First of all it is necessary to check the data type definitions for both VB6 and VB .NET:

VB6 Data Types

VB .NET Data Types

One thing to note is that in VB6 a Long is 4 bytes. In VB .NET an Integer is 4 bytes.

In VB .NET an Integer = Int32 which is 4 bytes. A Long = Int64 which is 8 bytes.

Another thing to note is that an "IntPtr" in 32-bit OS is 4 bytes, and in a 64-bit OS is 8 bytes.

Use "IntPtr" instead of Integer, Int32, Long, Int64 (and "UIntPtr" instead of "UInteger", "UInt32", "ULong", "UInt64").

When you see "String" in a pInvoke (Win32) api, replace it with "System.Text.StringBuilder"

Convert VB6 "Type" to "Structure", but use "StructLayout".

The following article references C#, but also applies to VB .NET:
Mastering C# structs

"...If you change the definition of the struct to:"

<StructLayout(LayoutKind.Sequential, Pack:=1)>
Public Structure YourStructureName

End Structure

Note: Above code edited--converted from C# to VB .NET

"...This is what you need to work with most of the structures defined in the Windows API and C/C++..."

To use "StructLayout", add the following imports statement: "Imports System.Runtime.InteropServices".

Before specifying the data types for the parameters it is necessary to look at the definition of the Win API that you want to use. For example, look at GetClassName (see "Windows Data Types" at the end of this post for more info.)

Additionally in some instances you may need to use "System.Runtime.InteropServices.DllImport" (add "Imports System.Runtime.InteropServices").

Instead of:

Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As IntPtr, ByVal lpClassName As StringBuilder, ByVal nMaxCount As Integer) As IntPtr

You can do:

<DllImport("user32.dll", EntryPoint:="GetClassName")>
Public Function GetClassName(ByVal hwnd As IntPtr, ByVal lpClassName As StringBuilder, nMaxCount As Integer) As IntPtr
End Function

Note: "EntryPoint" may or may not need to be specified.

Then to use "GetClassName":

Dim bufferSize As Integer = 256
Dim winClassBuf As New StringBuilder(bufferSize)
Dim winClass As String = String.Empty

Dim retVal As Integer = 0

'get class name
retVal = GetClassName(hwnd, winClassBuf, bufferSize)
winClass = stripNulls(winClassBuf.ToString())

Resources:
Windows Data Types

Note The following for "INT_PTR":

INT_PTR

#if defined(_WIN64) 
 typedef __int64 INT_PTR; 
#else 
 typedef int INT_PTR;
#endif

For 64-bit OS, INT_PTR (IntPtr), is Int64. For 32-bit OS, INT_PTR (IntPtr) is Int (Integer/Int32).

[cgeier]

I made a mistake in the code that I posted above.

Change from:

Dim retVal As Integer = 0

To:

Dim retVal As IntPtr = IntPtr.Zero

Additionally, when looking up a Win API definition, if you see a parameter with "Out" (or "In_Out"...or some version that contains the word "Out"), use "ByRef" instead of "ByVal" and ensure that the variable that you are passing it back to has been initialized. An example would be GetWindowRect.

<DllImport("user32.dll", EntryPoint:="GetWindowRect")>
Public Function GetWindowRect(ByVal hwnd As Integer, ByRef lpRect As Rectangle) As Boolean
End Function

Usage:

Dim winRect As New Rectangle
GetWindowRect(hwnd, winRect)

where "hwnd" is the handle to a window.

[amvx86]

Dude, I wasn't expecting all this. I greatly appreciate what you've done here. I'm going to mess with this and incorporate it... In time to come I might PM you regarding something related to the project that I am working on -=]