Помогите пожалуйста найти ошибку

[oskolok_vatbI]

Вот код:

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

Private Sub Command2_Click()
Shell ("D:/ONIKS.000/ow06.exe")

Do Until hWindow > 0
hWindow = FindWindow(vbNullString, "Имя окна")
Loop

    hMenu = GetMenu(hWindow)
    hMenuSub = GetSubMenu(hMenu, 0)
    hMenuItm = GetMenuItemID(hMenuSub, 0)
    PostMessage hWindow, WM_COMMAND, hMenuItm, 0

Do Until hParent > 0
hParent = FindWindow(vbNullString, "Открыть")
Loop

If (hParent) Then
    sText = "TEST"
    ReDim sByteArr(Len(sText) + 1)
    sByteArr = StringToByteArray(sText)

    Do Until hChild > 0
    hChild = GetDlgItem(hParent, 1152)
    Loop

If (hChild) Then
    SendMessage hChild, WM_SETTEXT, ByVal 0&, sByteArr(0)

TextLen = SendMessage(hChild, WM_GETTEXTLENGHT, 0, 0) + 1
If (TextLen) Then
WinText = String(TextLen, Chr$(0))
Call SendMessage(hChild, WM_GETTEXT, TextLen, ByVal WinText)
End If
End If
End If
End Sub

Программа запускается, запускает другую программу, через верхнее меню добираюсь до диалога выбора файлов... и не могу загнать строку в поле имени открываемых файлов - она остается пустой, причем, мне кажется (может и кажется конечно уже) что в поле нечто мелькает. Далее пытаюсь из этого поля считать текст - в переменной WinText он действительно есть. Пошагово программа работает хорошо, все появляется там где и нужно, а в обычном режиме не хочет. Еще работает если сделать:

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

for i = 0 To 100000
    SendMessage hChild, WM_SETTEXT, ByVal 0&, sByteArr(0)
Next i


но почему так ? Система обработать не успевает ? Или что ? И как бороться с этим ? Спасибо.

[_igor_]

Было что-то похожее, только я вызывал подряд много функций из .dll
В пошаговом режиме все работало, а exe вешал и ничего не происходило.
Решил так - написал для каждой вызываемой функции обвертку типа

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

private sub wrap_func_from_dll ()
   call func_from_dll ()
end sub

После этого все заработало, хотя обьяснить почему трудно

[Arcady_XQST]

SendMessage hChild, WM_SETTEXT, ByVal 0&, sByteArr(0)

Можно заменить на

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

SendMessage hChild, WM_SETTEXT, ByVal 0&, ByVal sText

Скоро пример с блокнотом натыкаю.

[Arcady_XQST]

Гм... С полем ввода имени файла не работает. Но с кнопкой работает без проблем. Вот код (1 TextBox, 1 CommandButton):

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

Option Explicit

Private Declare Function FindWindow Lib "user32.dll" 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 EnableWindow Lib "user32" (ByVal hwnd As Long, ByVal fEnable As Long) As Long

Private Declare Function GetMenu Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetSubMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetMenuItemID Lib "user32.dll" (ByVal hMenu As Long, ByVal nPos As Long) As Long

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WM_COMMAND As Long = &H111

Private Const WM_ENABLE = &HA
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_SETTEXT = &HC

Private Sub Command1_Click()
    Dim hWindow As Long
    Dim hOpenWnd As Long
    Dim hTextBox As Long
    Dim hMenu As Long
    Dim hMenuItm As Long
    Dim hMenuSub As Long
   
    Shell "notepad.exe", vbNormalFocus
   
    Do Until (hWindow) ' Ctrl + Pause/Break для остановки
        DoEvents
        hWindow = FindWindow("Notepad", "Безымянный - Блокнот")
    Loop
   
    If (hWindow) Then
        hMenu = GetMenu(hWindow) ' Хэндл меню
        hMenuSub = GetSubMenu(hMenu, &H0) ' Хэндл подменю
        hMenuItm = GetMenuItemID(hMenuSub, &H1) 'Идентификатор пункта подменю
        PostMessage hWindow, WM_COMMAND, hMenuItm, &H0  ' Нажали ...
    End If
   
    If (hWindow) Then
        Do Until (hOpenWnd) ' Ctrl + Pause/Break для остановки
            DoEvents
            hOpenWnd = FindWindow("#32770", "Открыть")
        Loop
       
        If (hOpenWnd) Then
            Do Until (hTextBox)
                DoEvents
                hTextBox = FindWindowEx(hOpenWnd, ByVal &H0, "Button", "&Открыть")
                'hTextBox = FindWindowEx(hOpenWnd, ByVal &H0, "Edit", vbNullString)
            Loop
           
            If (hTextBox) Then
                Me.Caption = "Returned: " & SendMessage(hTextBox, WM_SETTEXT, &H0, ByVal Text1.Text)
            End If
        End If
    End If
End Sub

[oskolok_vatbI]

SendMessage hChild, WM_SETTEXT, ByVal 0&, sByteArr(0)

Можно заменить на

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

SendMessage hChild, WM_SETTEXT, ByVal 0&, ByVal sText

Скоро пример с блокнотом натыкаю.

Спасибо большое, заменил. А вот текст так и не ставится.