dotNETportal.cz

Vážení přátelé, prosím POMOOOC !

Mám vlastní aplikaci ve vb, která mimo jiné potvrzuje dialog externí aplikace pomocí SendMessage. Při použití lokální konzole nebo při nastavení Auto login (a rebootu) funguje perfektně. Na XP server, na kterém tato aplikace běží, se ale potřebuji často připojovat přes Remote Desktop. Jsem-li připojen nebo dám-li klienta RDP do okna, pořád ještě OK (i ztratí-li okno RDP focus). Dám-li však RDP na lištu, zavřu ho nebo když RDP ztratí spojení, SendMessage v té aplikaci na serveru přestane fungovat - jakoby bez efektu, zdá se, že cílová aplikace (okno) zprávu neobdrží. Když klienta RDP znovu připojím, je opět vše v pořádku, nově vyslané zprávy se doručují. Stejného výsledku se dosáhne s PostMessage, nebo s použitím shellu - wshshell.SendKeys . K problému dochází při použití různých RDP klientů. Zkoušel jsem toho hodně, i ty zprávy zachytávat (SetWindowsHookEx) a sledovat, opravdu velmi dlouho jsem se snažil na to něco najít, ale bohužel. Jediné rady na netu jsou pro ty, kteří používají wshshell.SendKeys , aby použili SendMessage. Ale tím já jsem začal...

Níže je to podstatné z té aplikace, zkoušel jsem i posílat text (stisky kláves) do notepadu, klikat myší(WM_LBUTTONDOWN), mačkat mezerník (WM_KEYDOWN), simulovat klik myši (BM_CLICK), různý způsob deklarace API funkcí, před posláním zprávy aktivovat tu externí aplikaci i to okno dialogu - nic nepomáhá, všechny způsoby fungují perfektně (včetně SendKeys), ale jen pokud je RDP připojen a není na liště.

Vím, že jste v ČR opravdu ty největší kapacity v oboru, prosím, pomozte. Děkuji velmi! Pomohlo by i, kdyby RDP klient po minimalizaci ponechal relaci na serveru ve stejném stavu, jako při zmenšení RDP do okna. Nejraději bych ale, kdyby ta aplikace fungovala, i když se RDP odpojí.

Imports System.Runtime.InteropServices 

Public Class Form1

    Delegate Function CallBack(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
    Dim proces As CallBack

    Declare Function SetWindowsHookEx Lib "User32.dll" Alias "SetWindowsHookExA" (ByVal idHook As Integer, ByVal HookProc As CallBack, ByVal hInstance As IntPtr, ByVal wParam As Integer) As Integer
    Declare Function CallNextHookEx Lib "user32" (ByVal idHook As Integer, ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
    Declare Function UnhookWindowsHookEx Lib "user32" (ByVal idHook As Integer) As Boolean

    Declare Function GetWindow Lib "user32" (ByVal hwnd As IntPtr, ByVal uCmd As Integer) As IntPtr
    Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hwnd As Integer, ByVal lpString As System.Text.StringBuilder, ByVal cch As Integer) As Integer
    Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Integer
    'Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
    'Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr

    <DllImport("user32", EntryPoint:="SendMessageA", CharSet:=CharSet.Auto, SetLastError:=True, ExactSpelling:=True)> _
    Public Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
    End Function

    <DllImport("user32", EntryPoint:="PostMessageA", CharSet:=CharSet.Auto, SetLastError:=True, ExactSpelling:=True)> _
    Public Shared Function PostMessage(ByVal hWnd As IntPtr, ByVal Msg As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
    End Function

    Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hwnd As Integer) As Integer
    Declare Function SetActiveWindow Lib "user32.dll" (ByVal hwnd As Integer) As Integer
    Declare Auto Function FindWindow Lib "user32.dll" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
    Declare Function IsIconic Lib "user32.dll" (ByVal hwnd As Integer) As Boolean
    Declare Function ShowWindow Lib "user32.dll" (ByVal hwnd As Integer, ByVal nCmdShow As Integer) As Integer

    Dim handler As Integer = 0

    Dim hwnd1 As IntPtr
    Dim hwnd2 As IntPtr
    Dim hwnd3 As IntPtr


    Const SW_RESTORE As Integer = 9
    Const SW_SHOW As Integer = 5
    Const SW_MINIMIZE As Integer = 6
    Const SW_SHOWMINIMIZED As Integer = 2

    Const BM_CLICK As Integer = &HF5
    Const WM_LBUTTONDOWN As Integer = &H201
    Const WM_LBUTTONUP As Integer = &H202
    Const WM_KEYDOWN As Integer = &H100
    Const WM_KEYUP As Integer = &H101

    Dim wshshell = CreateObject("Wscript.Shell")


    Sub PotvrdDialog() Handles Timer1.Tick

        FocusWindow("Pokus", Nothing)

        '
        'další akce, trvající cca 1s
        '

        SetActiveWindow(hwnd1) 'okno dialogu
        'SetActiveWindow(hwnd2) 'okno toho tlačítka

        'wshshell.SendKeys("{LEFT}{ENTER}")

        'SendMessage(hwnd2, WM_KEYDOWN, &H20, &H0) ' &H390001)
        'SendMessage(hwnd2, WM_KEYUP, &H20, &H0) '&HC0390001)

        'SendMessage(hwnd2, WM_LBUTTONDOWN, 0, 0)
        'SendMessage(hwnd2, WM_LBUTTONUP, 0, 0)

        PostMessage(hwnd2, BM_CLICK, 0, 0)

        SendMessage(hwnd2, BM_CLICK, 0, 0)

        FocusWindow("Notepad", Nothing)
        SetActiveWindow(hwnd3) 'okno notepadu

        SendMessage(hwnd3, WM_KEYDOWN, &H20, &H0) ' &H390001)
        SendMessage(hwnd3, WM_KEYUP, &H20, &H0) '&HC0390001)

    End Sub


    Sub FocusWindow(ByVal strWindowCaption As String, ByVal strClassName As String)
        Dim hWnd As Integer
        hWnd = FindWindow(strClassName, strWindowCaption)

        If hWnd > 0 Then
            SetForegroundWindow(hWnd)

            If IsIconic(hWnd) Then  'Restore if minimized
                ShowWindow(hWnd, SW_RESTORE)
            Else
                ShowWindow(hWnd, SW_SHOW)
            End If
        End If
    End Sub

Ještě jsem zjistil, že PostMessage WM_KEYDOWN (nikoliv SendMessage) do toho okna Notepadu funguje, i když je RDP odhlášený:

PostMessage(OknoNotepadu, WM_KEYDOWN, &H20, &H0)
PostMessage(OknoNotepadu, WM_KEYUP, &H20, &H0)

Notepad ale přitom nemusí mít ani focus. Naopak, to dialogové okno musí mít focus, aby fungovalo klikání na tlačítka (nebo stisk mezerníku). V tom právě bude asi ten problém - v získání fucus pro to dialogové okno/tlačítko, když je RDP na liště a nebo odhlášený. Nechápu však proč.

Když přímo tomu oknu dialogu (jedná se o dialog "Stažení souboru", generovaný WebBrowserem) pošlu:

        PostMessage(OknoDialogu, DM_SETDEFID, GetDlgCtrlID(OknoTlacitkaUlozit)), &H0)
        Application.DoEvents()
        PostMessage(OknoDialogu, DM_SETDEFID, GetDlgCtrlID(OknoTlacitkaOtevrit), &H0)
        Application.DoEvents()
        PostMessage(OknoDialogu, DM_SETDEFID, GetDlgCtrlID(OknoTlacitkaStorno), &H0)
        Application.DoEvents()

Tak při minimalizovaném oknu RDP (nebo odpojeném RDP) dialog zareaguje pouze na první zprávu, druhou a třetí ignoruje. Po obnovení okna RDP ten dialog nemá focus, přestože ho preventivně před posíláním zpráv zkouším aktivovat jak funkcí SetForegroundWindow(hWnd), tak i ShowWindow(hWnd, SW_SHOW). Při otevřeném RDP a nebo po restartu serveru s Auto login to funguje samozřejmě normálně - dialog zareaguje na všechny zprávy. Zdá se, že dialog nemůže získat focus, nemá-li ověřeno, že je fyzicky zobrazen. V tom by mohl být ten problém. Prosím, nevíte někdo, jak bych se mohl pokusit to obejít ?

Přeji pěkný den,

prosím, nakopněte mě stručně, jestli jsem něco napsal špatně, jestli mi v otázce něco chybí. Nebo opravdu nikdo nevíte?

A nebo se zeptám jinak: Nevíte náhodou někdo zcela jistě, že to nelze obejít? Např. jedná se o zabezpečení?

Děkuji Velmi,

Dalibor Nový