Программно найти окно скайпа

Dim wb2 As SHDocVw.IWebBrowser2
Dim pUnk As IUnknown
 
CLSIDFromString "{6D5140C1-7436-11CE-8034-00AA006009FA}",
IID_IServiceProvider
CLSIDFromString "{D30C1661-CDAF-11D0-8A3E-00C04FC9E26E}",
IID_IWebBrowser2
CLSIDFromString SIDSTR_SWebBrowserApp, SID_SWebBrowserApp
 
Using MSAA and the WM_HTML_GETOBJECT message, I am able to get the
HTMLDocument ----document
 
Set pUnk = document.parentWindow
pUnk.QueryInterface IID_IServiceProvider, pService
pService.QueryService SID_SWebBrowserApp, IID_IWebBrowser2, wb2

Public Function GetIWebBrowserFromHWND(ByVal hWnd As Long) As Object
    Dim SHApp As Object, SHWin As Object
    
    Set SHApp = CreateObject("Shell.Application")
    For Each SHWin In SHApp.windows
        If LCase(Right(SHWin.FullName, 12)) = "iexplore.exe" Then
            If SHWin.hWnd = hWnd Then
                Set GetIWebBrowserFromHWND = SHWin
                Exit For
            End If
        End If
    Next
    Set SHApp = Nothing
End Function

 Set srv = IEObj.accChild(CVar(CLng(0)))
       srv.QueryService HTMLUUID, DispUUID, i
    GetMem4 i, ByVal VarPtr(Elem)  
  
    Set pUnk =Elem.parentWindow
    pUnk.QueryService SID_SWebBrowserApp, IID_IWebBrowser2, wb2
et pUnk = document.parentWindow
pUnk.QueryInterface IID_IServiceProvider, pService
pService.QueryService SID_SWebBrowserApp, IID_IWebBrowser2, wb2

Option Explicit
 
' Пример программного подключения Skype
' ? Кривоус Анатолий Анатольевич (The trick), 2014
Dim WithEvents pBrowser        As WebBrowser
 
Private Const IID_IDispatch    As String = "{00020400-0000-0000-C000-000000000046}"
 
Private Const IID_IHTMLElement As String = "{3050f1ff-98b5-11cf-bb82-00aa00bdce0b}"
 
Private Const OBJID_CLIENT     As Long = -4
 
Private Declare Function FindWindowEx _
                Lib "user32" _
                Alias "FindWindowExW" (ByVal hWnd1 As Long, _
                                       ByVal hWnd2 As Long, _
                                       ByVal lpsz1 As Long, _
                                       ByVal lpsz2 As Long) As Long
 
Private Declare Function AccessibleObjectFromWindow _
                Lib "oleacc" (ByVal hwnd As Long, _
                              ByVal dwId As Long, _
                              ByRef riid As UUID, _
                              ByRef ppvObject As Object) As Long
 
Private Declare Function IIDFromString _
                Lib "ole32" (ByVal lpsz As Long, _
                             ByRef lpiid As UUID) As Long
 
Private Declare Function GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
 
Private Sub Form_Load()
 
    Dim ieWnd                As Long                         '
 
    Dim i                    As Long                         '
 
    Dim IEObj                As Object                       '  IHTMLElement
 
    Dim DispUUID             As UUID                         ' UIID IDispatch
 
    Dim HTMLUUID             As UUID                         ' UIID IHTMLElement
 
    Dim IID_IWebBrowser2     As UUID
 
    Dim SID_SWebBrowserApp   As UUID
 
    Dim IID_IServiceProvider As UUID
 
    Dim srv                  As olelib2.IServiceProvider     '
 
    Dim Elem                 As Object                       '
 
    Dim logn                 As Object                       '
 
    Dim pswd                 As Object                       '
 
    Dim btn                  As Object                       '
 
    Dim wb2                  As Object 'SHDocVw.IWebBrowser2
 
    Dim pUnk                 As IUnknown
 
    CLSIDFromString "{6D5140C1-7436-11CE-8034-00AA006009FA}", IID_IServiceProvider
    CLSIDFromString "{D30C1661-CDAF-11D0-8A3E-00C04FC9E26E}", IID_IWebBrowser2
    CLSIDFromString SIDSTR_SWebBrowserApp, SID_SWebBrowserApp
    ' Заполняем UIID'ы
    IIDFromString StrPtr(IID_IDispatch), DispUUID
    IIDFromString StrPtr(IID_IHTMLElement), HTMLUUID
 
    '
    For i = 0 To 4
        ieWnd = FindWindowEx(ieWnd, 0, StrPtr(Choose(i + 1, "IEFrame", "Frame Tab", "TabWindowClass", "Shell DocObject View", "Internet Explorer_Server")), 0)  'i open ie . 
    Next
 
    '
    If AccessibleObjectFromWindow(ieWnd, OBJID_CLIENT, DispUUID, IEObj) Then
        MsgBox "error": Exit Sub
 
    End If
   
    Set srv = IEObj.accChild(CVar(CLng(0)))
    
    srv.QueryService HTMLUUID, DispUUID, i
    GetMem4 i, ByVal VarPtr(Elem)
    
    Set pUnk = Elem.parentWindow 'error
    ' pUnk.QueryInterface IID_IServiceProvider, pService
    pUnk.QueryService SID_SWebBrowserApp, IID_IWebBrowser2, wb2
    
    '
    '    Set logn = Elem.All("username")
    '    logn.Value = "The trick"
    '    '
    '    Set pswd = Elem.All("password")
    '    pswd.Value = "My password"
    '    '
    '    Set btn = Elem.All("buttonSignIn")
    '    btn.focus
    '    btn.Click
    ' Очистка
    '    Set Elem = Nothing
    '    Set btn = Nothing
    '    Set pswd = Nothing
    '    Set logn = Nothing
 
End Sub

Option Explicit
 
Private Const OBJID_CLIENT          As Long = -4
Private Const IIDSTR_IHTMLElement   As String = "{3050f1ff-98b5-11cf-bb82-00aa00bdce0b}"
Private Const SIDSTR_SWebBrowserApp As String = "{0002DF05-0000-0000-C000-000000000046}"
 
Private Declare Function FindWindowEx Lib "user32" _
                         Alias "FindWindowExW" ( _
                         ByVal hWnd1 As Long, _
                         ByVal hWnd2 As Long, _
                         ByVal lpsz1 As Long, _
                         ByVal lpsz2 As Long) As Long
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" ( _
                         ByVal hWnd As Long, _
                         ByVal dwId As Long, _
                         ByRef riid As UUID, _
                         ByRef ppvObject As Object) As Long
Private Declare Function IIDFromString Lib "ole32" ( _
                         ByVal lpsz As Long, _
                         ByRef lpiid As UUID) As Long
                             
Private Sub Form_Load()
    Dim lIndex                  As Long
    Dim hIEWnd                  As Long
    Dim cIEObj                  As Object
    Dim cBrowser                As Object
    Dim cElement                As Object
    Dim tIID_IDispatch          As UUID
    Dim cServProvider           As IServiceProvider
    Dim tIID_IUnknown           As UUID
    Dim tSID_SWebBrowserApp     As UUID
    Dim tIID_IHTMLElement     As UUID
 
    For lIndex = 0 To 4
        hIEWnd = FindWindowEx(hIEWnd, 0, StrPtr(Choose(lIndex + 1, "IEFrame", "Frame Tab", _
                            "TabWindowClass", "Shell DocObject View", "Internet Explorer_Server")), 0)  'i open ie .
    Next
    
    IIDFromString StrPtr(IIDSTR_IDispatch), tIID_IDispatch
    IIDFromString StrPtr(SIDSTR_SWebBrowserApp), tSID_SWebBrowserApp
    IIDFromString StrPtr(IIDSTR_IHTMLElement), tIID_IHTMLElement
    
    If AccessibleObjectFromWindow(hIEWnd, OBJID_CLIENT, tIID_IDispatch, cIEObj) Then
        MsgBox "error": Exit Sub
    End If
 
    Set cServProvider = cIEObj.accChild(CVar(CLng(0)))
 
    cServProvider.QueryService tIID_IHTMLElement, tIID_IDispatch, cElement
    
    Set cServProvider = cElement.Document
    
    cServProvider.QueryService tSID_SWebBrowserApp, tIID_IDispatch, cBrowser
    
    cBrowser.Navigate "https://www.google.com"
    
End Sub

 Option Explicit
Private  WithEvents cBrowser1            As WebBrowser_V1 'refer ieframe. 
''Private  WithEvents cBrowser1            As WebBrowser ' can not used events. 
'Private WithEvents cBrowser1 As InternetExplorer 'canot set this,must set WebBrowser_V1 can used events .why?
Private Const OBJID_CLIENT          As Long = -4
Private Const IIDSTR_IHTMLElement   As String = "{3050f1ff-98b5-11cf-bb82-00aa00bdce0b}"
Private Const SIDSTR_SWebBrowserApp As String = "{0002DF05-0000-0000-C000-000000000046}"
Private Declare Function GetMem4 Lib "msvbvm60" (Src As Any, Dst As Any) As Long
 
Private Declare Function FindWindowEx _
                Lib "user32" _
                Alias "FindWindowExW" (ByVal hWnd1 As Long, _
                                       ByVal hWnd2 As Long, _
                                       ByVal lpsz1 As Long, _
                                       ByVal lpsz2 As Long) As Long
Private Declare Function AccessibleObjectFromWindow _
                Lib "oleacc" (ByVal hWnd As Long, _
                              ByVal dwId As Long, _
                              ByRef riid As UUID, _
                              ByRef ppvObject As Object) As Long
Private Declare Function IIDFromString _
                Lib "ole32" (ByVal lpsz As Long, _
                             ByRef lpiid As UUID) As Long
                             
Private Sub cBrowser1_NavigateComplete(ByVal URL As String)
    Debug.Print URL 
    
End Sub
 
Private Sub Form_Load()
    Dim lIndex              As Long
    Dim hIEWnd              As Long
    Dim cIEObj              As Object
    Dim cBrowser            As Object
    Dim cElement            As Object
    Dim tIID_IDispatch      As UUID
    Dim cServProvider       As IServiceProvider
    Dim tIID_IUnknown       As UUID
    Dim tSID_SWebBrowserApp As UUID
    Dim tIID_IHTMLElement   As UUID
 
    For lIndex = 0 To 4
        hIEWnd = FindWindowEx(hIEWnd, 0, StrPtr(Choose(lIndex + 1, "IEFrame", "Frame Tab", "TabWindowClass", "Shell DocObject View", "Internet Explorer_Server")), 0)  'i open ie .
    Next
    
    IIDFromString StrPtr(IIDSTR_IDispatch), tIID_IDispatch
    IIDFromString StrPtr(SIDSTR_SWebBrowserApp), tSID_SWebBrowserApp
    IIDFromString StrPtr(IIDSTR_IHTMLElement), tIID_IHTMLElement
    
    If AccessibleObjectFromWindow(hIEWnd, OBJID_CLIENT, tIID_IDispatch, cIEObj) Then
        MsgBox "error": Exit Sub
    End If
 
    Set cServProvider = cIEObj.accChild(CVar(CLng(0)))
  
    cServProvider.QueryService tIID_IHTMLElement, tIID_IDispatch, lIndex 
    GetMem4 lIndex, ByVal VarPtr(cElement)
    
    Set cServProvider = cElement.Document
    
    cServProvider.QueryService tSID_SWebBrowserApp, tIID_IDispatch, lIndex 'cBrowser
    GetMem4 lIndex, ByVal VarPtr(cBrowser)
 
    Set cBrowser1 = cBrowser
 
    cBrowser1.Navigate "https://www.google.com"
    
End Sub

    sCommand = "C:\Program Files\Internet Explorer\IEXPLORE.EXE about:blank" ' -noframemerging -private"
   
    sInfo.cb = Len(sInfo)
    sInfo.wShowWindow = SW_HIDE 'SW_HIDE=0
    lSuccess = CreateProcess(sNull, sCommand, ByVal 0&, ByVal 0&, 1&, NORMAL_PRIORITY_CLASS, ByVal 0&, sNull, sInfo, pInfo)

 If pInfo.dwProcessId > 0 Then
        Do
            IEhwnd = GetHwnd(pInfo.dwProcessId)
     
            If IEhwnd > 0 Then Exit Do
        Loop
       ShowWindow IEhwnd, SW_HIDE 'now can hide

Option Explicit
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Declare Function ShowWindow _
                Lib "user32" (ByVal hwnd As Long, _
                              ByVal nCmdShow As Long) As Long
Private Const SW_HIDE = 0
Private Const STARTF_USESHOWWINDOW = 1
Private Const SW_SHOW = 5
Private Declare Function SendMessage _
                Lib "user32" _
                Alias "SendMessageA" (ByVal hwnd As Long, _
                                      ByVal wMsg As Long, _
                                      ByVal wParam As Long, _
                                      lParam As Any) As Long
Private pInfo            As PROCESS_INFORMATION
 
Private IEhwnd           As Long
 
Private Sub Command1_Click()
 
    If pInfo.dwProcessId > 0 Then
 
        Do
            IEhwnd = GetHwnd(pInfo.dwProcessId)
     
            If IEhwnd > 0 Then Exit Do
        Loop
 
        ShowWindow IEhwnd, 5
        Call SendMessage(IEhwnd, 24, 1, 0)
    End If
 
End Sub
 
Private Sub Form_Load()
 
    Dim lSuccess As Long
 
    Dim sInfo    As STARTUPINFO
 
    Dim sCommand As String, sNull As String
 
    sCommand = "mspaint.exe" ' -noframemerging -private"
   
    sInfo.cb = Len(sInfo)
    sInfo.dwFlags = STARTF_USESHOWWINDOW
    sInfo.wShowWindow = SW_HIDE
    lSuccess = CreateProcess(0, sCommand, ByVal 0&, ByVal 0&, 1&, NORMAL_PRIORITY_CLASS, ByVal 0&, sNull, sInfo, pInfo)
    
End Sub

Option Explicit
Public Type PROCESS_INFORMATION
   hProcess As Long
   hThread As Long
   dwProcessId As Long
   dwThreadId As Long
End Type
Public Declare Function CreateProcess Lib "kernel32" _
   Alias "CreateProcessA" _
   (ByVal lpApplicationName As String, _
   ByVal lpCommandLine As String, _
   lpProcessAttributes As Any, _
   lpThreadAttributes As Any, _
   ByVal bInheritHandles As Long, _
   ByVal dwCreationFlags As Long, _
   lpEnvironment As Any, _
   ByVal lpCurrentDriectory As String, _
   lpStartupInfo As STARTUPINFO, _
   lpProcessInformation As PROCESS_INFORMATION) As Long
Public Type STARTUPINFO
   cb As Long
   lpReserved As String
   lpDesktop As String
   lpTitle As String
   dwX As Long
   dwY As Long
   dwXSize As Long
   dwYSize As Long
   dwXCountChars As Long
   dwYCountChars As Long
   dwFillAttribute As Long
   dwFlags As Long
   wShowWindow As Integer
   cbReserved2 As Integer
   lpReserved2 As Long
   hStdInput As Long
   hStdOutput As Long
   hStdError As Long
End Type
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
 
Public Function GetHwnd(ByVal ProcessID As Long) As Long
 
    ' // Get Hwnd from Process ID //
 
    Dim lHwnd As Long, RetHwnd As Long, RetPID As Long
    
    lHwnd = GetDesktopWindow()
    RetHwnd = GetWindow(lHwnd, GW_CHILD)
    
    Do While RetHwnd
        'If IsWindowVisible(RetHwnd) Then
            Call GetWindowThreadProcessId(RetHwnd, RetPID)
            If RetPID = ProcessID Then
                Exit Do
            End If
        'End If
        RetHwnd = GetWindow(RetHwnd, GW_HWNDNEXT)
    Loop
    
    GetHwnd = RetHwnd
 
End Function

Option Explicit
Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Declare Function ShowWindow _
                Lib "user32" (ByVal hwnd As Long, _
                              ByVal nCmdShow As Long) As Long
Private Const SW_HIDE = 0
Private Const STARTF_USESHOWWINDOW = 1
Private Const SW_SHOW = 5
Private Declare Function SendMessage _
                Lib "user32" _
                Alias "SendMessageA" (ByVal hwnd As Long, _
                                      ByVal wMsg As Long, _
                                      ByVal wParam As Long, _
                                      lParam As Any) As Long
Private pInfo            As PROCESS_INFORMATION
 
Private IEhwnd           As Long
 
Private Sub Command1_Click()
 
    If pInfo.dwProcessId > 0 Then
 
        Do
            IEhwnd = GetHwnd(pInfo.dwProcessId)
     
            If IEhwnd > 0 Then Exit Do
        Loop
 
        ShowWindow IEhwnd, 5
        Call SendMessage(IEhwnd, 24, 1, 0)
    End If
 
End Sub
 
Private Sub Form_Load()
 
    Dim lSuccess As Long
 
    Dim sInfo    As STARTUPINFO
 
    Dim sCommand As String, sNull As String
 
    sCommand = "mspaint.exe" ' -noframemerging -private"
   
    sInfo.cb = Len(sInfo)
    sInfo.dwFlags = STARTF_USESHOWWINDOW
    sInfo.wShowWindow = SW_HIDE
    lSuccess = CreateProcess(0, sCommand, ByVal 0&, ByVal 0&, 1&, NORMAL_PRIORITY_CLASS, ByVal 0&, sNull, sInfo, pInfo)
    
End Sub

Option Explicit
Public Type PROCESS_INFORMATION
   hProcess As Long
   hThread As Long
   dwProcessId As Long
   dwThreadId As Long
End Type
Public Declare Function CreateProcess Lib "kernel32" _
   Alias "CreateProcessA" _
   (ByVal lpApplicationName As String, _
   ByVal lpCommandLine As String, _
   lpProcessAttributes As Any, _
   lpThreadAttributes As Any, _
   ByVal bInheritHandles As Long, _
   ByVal dwCreationFlags As Long, _
   lpEnvironment As Any, _
   ByVal lpCurrentDriectory As String, _
   lpStartupInfo As STARTUPINFO, _
   lpProcessInformation As PROCESS_INFORMATION) As Long
Public Type STARTUPINFO
   cb As Long
   lpReserved As String
   lpDesktop As String
   lpTitle As String
   dwX As Long
   dwY As Long
   dwXSize As Long
   dwYSize As Long
   dwXCountChars As Long
   dwYCountChars As Long
   dwFillAttribute As Long
   dwFlags As Long
   wShowWindow As Integer
   cbReserved2 As Integer
   lpReserved2 As Long
   hStdInput As Long
   hStdOutput As Long
   hStdError As Long
End Type
Private Const GW_CHILD = 5
Private Const GW_HWNDNEXT = 2
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
 
Public Function GetHwnd(ByVal ProcessID As Long) As Long
 
    ' // Get Hwnd from Process ID //
 
    Dim lHwnd As Long, RetHwnd As Long, RetPID As Long
    
    lHwnd = GetDesktopWindow()
    RetHwnd = GetWindow(lHwnd, GW_CHILD)
    
    Do While RetHwnd
        'If IsWindowVisible(RetHwnd) Then
            Call GetWindowThreadProcessId(RetHwnd, RetPID)
            If RetPID = ProcessID Then
                Exit Do
            End If
        'End If
        RetHwnd = GetWindow(RetHwnd, GW_HWNDNEXT)
    Loop
    
    GetHwnd = RetHwnd
 
End Function