Использование dynacall.dll для вызова функций API

[SAS]

При использовании кода для перечисления окон работающих приложений с использованием апи работает все нормально:

Код: Выделить всё


'на форме - textbox, вывод списка заголовков окон - в textbox1.text
Private Declare Function apiGetClassName Lib "user32" Alias "GetClassNameA" (ByVal Hwnd As Long, ByVal lpClassname As String, ByVal nMaxCount As Long) As Long
Private Declare Function apiGetDesktopWindow Lib "user32" Alias "GetDesktopWindow" () As Long
Private Declare Function apiGetWindow Lib "user32" Alias "GetWindow" (ByVal Hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function apiGetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function apiGetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal Hwnd As Long, ByVal lpString As String, ByVal aint As Long) As Long

Private Const mcGWCHILD = 5
Private Const mcGWHWNDNext = 2
Private Const mcGWLSTYLE = (-16)
Private Const mcWSVISIBLE = &H10000000
Private Const mconMAXLEN = 255

Function fEnumWindows()
    Dim lngx As Long, lngLen As Long
    Dim lngStyle As Long, strCaption As String

    lngx = apiGetDesktopWindow()
    'Return the first child To Desktop
    lngx = apiGetWindow(lngx, mcGWCHILD)
    Do While Not lngx = 0
        strCaption = fGetCaption(lngx)
        If Len(strCaption) > 0 Then
            lngStyle = apiGetWindowLong(lngx, mcGWLSTYLE)
            'enum visible windows Only
            If lngStyle And mcWSVISIBLE Then
                Text1.Text = Text1.Text & "Class = " & fGetClassName(lngx) & "  Caption = " & fGetCaption(lngx) & Chr(13) & Chr(10)
            End If
        End If
        lngx = apiGetWindow(lngx, mcGWHWNDNext)
    Loop
End Function

Private Function fGetClassName(Hwnd As Long)
    Dim strBuffer As String
    Dim intCount As Integer

    strBuffer = String$(mconMAXLEN - 1, 0)
    intCount = apiGetClassName(Hwnd, strBuffer, mconMAXLEN)
    If intCount > 0 Then
    fGetClassName = Left$(strBuffer, intCount)
    End If
End Function

Private Function fGetCaption(Hwnd As Long)
    Dim strBuffer As String
    Dim intCount As Integer

    strBuffer = String$(mconMAXLEN - 1, 0)
    intCount = apiGetWindowText(Hwnd, strBuffer, mconMAXLEN)
    If intCount > 0 Then
    fGetCaption = Left$(strBuffer, intCount)
    End If
End Function

Private Sub Form_Load()
    Call fEnumWindows
End Sub

мне нужно обойти апи, для того чтобы использовать код в vbscript, для этого я использую dynacall.dll, ссылку на которую я нашел на этом форуме.

код с использованием этой библиотеки преобразуется в следующий:

Код: Выделить всё

Private Const mcGWCHILD = 5
Private Const mcGWHWNDNext = 2
Private Const mcGWLSTYLE = (-16)
Private Const mcWSVISIBLE = &H10000000
Private Const mconMAXLEN = 255
Dim uw, s, c

Function fEnumWindows()
Set uw = CreateObject("DynamicWrapper")
uw.Register "USER32.DLL", "GetClassNameA", "I=HSL", "R=L"
uw.Register "USER32.DLL", "GetDesktopWindow", "R=L"
uw.Register "USER32.DLL", "GetWindow", "I=HL", "R=L"
uw.Register "USER32.DLL", "GetWindowLongA", "I=hl", "R=L"
uw.Register "USER32.DLL", "GetWindowTextA", "I=HSL", "R=L"

    Dim lngx As Long, lngLen As Long
    Dim lngStyle As Long, strCaption As String
   
    lngx = uw.GetDesktopWindow()
    'Return the first child To Desktop
    lngx = uw.GetWindow(lngx, mcGWCHILD)
    Do While Not lngx = 0
        strCaption = fGetCaption(lngx)
        If Len(strCaption) > 0 Then
            lngStyle = uw.GetWindowLongA(lngx, mcGWLSTYLE)
            'enum visible windows Only
            If lngStyle And mcWSVISIBLE Then
                s = fGetClassName(lngx)
                c = fGetCaption(lngx)
                Text1.Text = Text1.Text & s & " " & c & Chr(13) & Chr(10)
            End If
        End If
        lngx = uw.GetWindow(lngx, mcGWHWNDNext)
    Loop
End Function
Private Function fGetClassName(Hwnd As Long)
    Dim strBuffer As String
    Dim intCount As Integer
   
    strBuffer = String$(mconMAXLEN - 1, 0)
    intCount = uw.GetClassNameA(Hwnd, strBuffer, mconMAXLEN)
    If intCount > 0 Then
    fGetClassName = Left$(strBuffer, intCount)
    End If
End Function

Private Function fGetCaption(Hwnd As Long)
    Dim strBuffer As String
    Dim intCount As Integer
    On Error Resume Next
    strBuffer = String$(mconMAXLEN - 1, 0)
    intCount = uw.GetWindowTextA(Hwnd, strBuffer, mconMAXLEN)
    If intCount > 0 Then
    fGetCaption = Left$(strBuffer, intCount)
    End If
End Function
Private Sub Form_Load()
fEnumWindows
End Sub

Почему то у меня этот код не заполняет текстбох заголовками окон. Может кто-то использовал эту dll-ку?

[SAS]

при отладке я понял что из библиотеки не возвращается значения переменной strBuffer, которая модифицируются функциями апи, после обращения к длл в этих переменных остаются те же значения, т.е. сама функция апи работает - возвращает лонг, а вот входную строку не модифицирует.

Код: Выделить всё

Private Function fGetClassName(Hwnd As Long)
    Dim strBuffer As String
    Dim intCount As Integer
   
    strBuffer = String$(mconMAXLEN - 1, 0)
    intCount = uw.GetClassNameA(Hwnd, strBuffer, mconMAXLEN)
    If intCount > 0 Then
    fGetClassName = Left$(strBuffer, intCount)
    End If
End Function

Private Function fGetCaption(Hwnd As Long)
    Dim strBuffer As String
    Dim intCount As Integer
    On Error Resume Next
    strBuffer = String$(mconMAXLEN - 1, 0)
    intCount = uw.GetWindowTextA(Hwnd, strBuffer, mconMAXLEN)
    If intCount > 0 Then
    fGetCaption = Left$(strBuffer, intCount)
    End If
End Function

можно ли получить это значение strBuffer каким-то другим путем?

[SAS]

Я нашел в чем дело, может кому нибуди пригодится:
нужно регистрировать функции не так:

Код: Выделить всё

Set uw = CreateObject("DynamicWrapper")
uw.Register "USER32.DLL", "GetClassNameA", "I=HSL", "R=L"
uw.Register "USER32.DLL", "GetDesktopWindow", "R=L"
uw.Register "USER32.DLL", "GetWindow", "I=HL", "R=L"
uw.Register "USER32.DLL", "GetWindowLongA", "I=hl", "R=L"
uw.Register "USER32.DLL", "GetWindowTextA", "I=HSL", "R=L"

А так (используя для строковых параметров ключ R - от слова Return я думаю):

Код: Выделить всё

Set uw = CreateObject("DynamicWrapper")
uw.Register "USER32.DLL", "GetClassNameA", "I=HRL", "R=L"
uw.Register "USER32.DLL", "GetDesktopWindow", "R=L"
uw.Register "USER32.DLL", "GetWindow", "I=HL", "R=L"
uw.Register "USER32.DLL", "GetWindowLongA", "I=hl", "R=L"
uw.Register "USER32.DLL", "GetWindowTextA", "I=HRL", "R=L"

хотя это и не панацея: некоторые окна все равно не перечисляются, напр. проводник, ie и почемуто MS VS 2003, кроме того генерится ошибка "-2147417848(80010108) Automation error" при вызове функции GetWindowTextA когда HWND соответствует хендлу окон самого VB6 и Symantec Antivirus. Когда обращение к функции происходит из VBScript, вообще недопустимая операция и будет закрыто (IE).
Может быть надо как то по другому параметры задавать при регистрации?

[Andrey Fedorov]

Я нашел в чем дело, может кому нибуди пригодится:

А не проще было просто сразу сделать свою ActiveX Dll-ку, которая сразу возвращает тебе в скрипт нужные данные?

[SAS]

Я нашел в чем дело, может кому нибуди пригодится:

А не проще было просто сразу сделать свою ActiveX Dll-ку, которая сразу возвращает тебе в скрипт нужные данные?

Я умею делать только на VB, а это +1,3 Mb (msvbvm60.dll)

[ALX_2002]

Может я чего то не втыкаю. Но по идее контрол не должен за собой потянуть эту DLL-ку. . Надеюсь я не ошибся... Т.к иначе у меня будут баааашие траблы на работе.

[SAS]

:shock: Может я чего то не втыкаю. Но по идее контрол не должен за собой потянуть эту DLL-ку. . Надеюсь я не ошибся... Т.к иначе у меня будут баааашие траблы на работе.

Сам по себе - то он не потянет, если не нужно (если Dll уже есть в системе), а если нет - то кирдык, работать не будет.