NonSoft

Win32Apiにより全てのウィンドウと
コントロールの情報を取得するサンプル(VB6)


 サンプル(ソース/コード)
<このサンプルの概要>
以下のWin32Apiを使用したサンプルソースです。
(1)EnumWindows
(2)EnumChildWindows
(3)GetClassName
(4)SendMessage
(5)GetWindowThreadProcessId
(6)OpenProcess
(7)CloseHandle
(8)VirtualAllocEx
(9)VirtualFreeEx
(10)ReadProcessMemory
(11)WriteProcessMemory

VB.NETでApiを宣言(Declare)する場合はVB.NET用に変換する必要があります。
変換方法のサンプルはこちらです。VB6とVB.NETのAPI宣言(Declare)の違いを比較したサンプル

C#.NETでApiを宣言(Declare)する場合はC#.NET用に変換する必要があります。
変換方法のサンプルはこちらです。VB6とC#.NETのAPI宣言(Declare)の違いを比較したサンプル

その他のサンプルソースはこちらです。
Win32Api定義のサンプル サンプルソース

Private Const SB_GETPARTS = &H406
Private Const SB_GETTEXT = &H402
Private Const SB_GETTEXTLENGTH = &H403
Private Const PROCESS_VM_OPERATION = &H8&
Private Const PROCESS_VM_READ = &H10&
Private Const PROCESS_VM_WRITE = &H20&
Private Const MEM_RESERVE = &H2000&
Private Const MEM_COMMIT = &H1000&
Private Const MEM_RELEASE = &H8000&
Private Const PAGE_READWRITE = &H4&
Private Const WM_GETTEXT = &HD
Private Declare Function EnumWindows Lib "user32.dll" _
    (ByVal lpEnumFunc As Long, lParam As Any) As Long
Private Declare Function EnumChildWindows Lib "user32" _
    (ByVal hwndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
    (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
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 Declare Function GetWindowThreadProcessId Lib "user32" _
    (ByVal hWnd As Long, lplngProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
     ByVal lngProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
    (ByVal hObject As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32.dll" _
    (ByVal lngProcessH As Long, lpAddress As Any, ByVal dwSize As Long, _
     ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" _
    (ByVal lngProcessH As Long, ByVal lpAddress As Long, _
     ByVal dwSize As Long, ByVal dwFreeType As Long) As Integer
Private Declare Function ReadProcessMemory Lib "kernel32" _
    (ByVal lngProcessH As Long, lpBaseAddress As Any, lpBuffer As Any, _
     ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" _
    (ByVal lngProcessH As Long, lpBaseAddress As Any, lpBuffer As Any, _
     ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long

' コントロール毎の情報を設定するコレクション
Private colWindows As New Collection

' ウィンドウとコントロールを全て取得
Public Function GetAllWindows() As Collection
    On Error Resume Next
    Dim i As Long
    Dim lngRet As Long
    
    ' コントロール毎の情報を設定するコレクション生成
    Set colWindows = New Collection
    Set GetAllWindows = colWindows
    
    ' トップレベルウィンドウを全て取得
    lngRet = EnumWindows(AddressOf EnumWindowsProc, 0)
    
    ' 親ウィンドウに属するコントロールを全て取得
    For i = 1 To colWindows.Count
        lngRet = EnumChildWindows(colWindows.Item(i).Item(1)(0), _
                         AddressOf EnumChildWindowsProc, i)
    Next i
End Function

' トップレベルウィンドウを全て取得
Public Function EnumWindowsProc(ByVal hWnd As Long, lParam As Long) As Long
    On Error Resume Next
    Dim lngRet As Long
    Dim strClassB As String * 255, strTitleB As String * 255
    Dim strClass As String, strTitle As String

    ' クラス名取得
    lngRet = GetClassName(hWnd, strClassB, 255)
    strClass = StripNulls(strClassB)
    
    ' ウィンドウのタイトル取得
    lngRet = SendMessage(hWnd, WM_GETTEXT, 255, ByVal strTitleB)
    strTitle = StripNulls(strTitleB)
    
    ' 取得した情報を配列に設定
    Dim strDa(2) As Variant
    strDa(0) = hWnd
    strDa(1) = strClass
    strDa(2) = strTitle
    
    ' 取得した情報をコレクションに設定
    Dim colDa As New Collection
    colDa.Add strDa
    
    ' トップレベルウィンドウ毎のコレクションに追加
    colWindows.Add colDa
    
    ' リターン
    EnumWindowsProc = 1
End Function

' 指定された親ウィンドウに属するコントロールを全て取得
Function EnumChildWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
    On Error Resume Next
    Dim lngRet As Long
    Dim strClassB As String * 255, strTitleB As String * 255
    Dim strClass As String, strTitle As String

    ' クラス名取得
    lngRet = GetClassName(hWnd, strClassB, 255)
    strClass = StripNulls(strClassB)
    
    ' ウィンドウのタイトル取得
    lngRet = SendMessage(hWnd, WM_GETTEXT, 255, ByVal strTitleB)
    strTitle = StripNulls(strTitleB)
    
    ' クラス名毎の特殊処理
    If strClass = "msctls_statusbar32" Then
        strTitle = strTitle & "(" & GetStatusBarText(hWnd) & ")"
    End If
    
    ' 取得した情報を配列に設定
    Dim strDa(2) As Variant
    strDa(0) = hWnd
    strDa(1) = strClass
    strDa(2) = strTitle
    
    ' コントロール毎のコレクションに追加
    colWindows.Item(lParam).Add strDa
    
    ' リターン
    EnumChildWindowsProc = 1
End Function

' ステータスバーの文字列を全て取得
Public Function GetStatusBarText(hWnd As Long) As String
    On Error Resume Next
    Dim lngLen As Long
    Dim lngPart As Long
    Dim lngNo As Long
    Dim strTmpB As String * 255
    Dim strTmp As String
    
    ' ステータスバーのパート数を取得
    lngPart = SendMessage(hWnd, SB_GETPARTS, 0, 0)
    
    ' ステータスバーの各パートの文字列を取得
    For lngNo = 0 To lngPart - 1
        ' ステータスバーの各パートの文字列の長さを取得
        lngLen = SendMessage(hWnd, SB_GETTEXTLENGTH, ByVal lngNo, ByVal 0)
        lngLen = (lngLen And &HFFFF&)
        
        ' 共有メモリを使用しステータスバーの各パートの文字列を取得
        If lngLen > 0 Then
            Call SendMessageByVAEString(hWnd, SB_GETTEXT, lngNo, strTmpB)
            strTmp = StripNulls(strTmpB)
            GetStatusBarText = GetStatusBarText & strTmp
        End If
        
        ' 各パートをカンマ区切りの文字列にする
        If lngNo < lngPart - 1 Then
            GetStatusBarText = GetStatusBarText & ","
        End If
    Next lngNo
End Function

' 共有メモリを使用しSendMessageを発行/情報取得
Public Function SendMessageByVAEString( _
    ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As String) As Long
    On Error Resume Next
    Dim lngRet As Long
    Dim lngProcessId As Long
    Dim lngProcessH As Long
    Dim lngVirtual As Long
    Dim bytBuf() As Byte
    lParam = String(Len(lParam), 0)
    bytBuf = StrConv(lParam, vbFromUnicode)

    ' 指定されたコントロールが存在するプロセスのIDを取得
    Call GetWindowThreadProcessId(hWnd, lngProcessId)

    ' プロセスのオープン
    lngRet = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or _
                         PROCESS_VM_WRITE, False, lngProcessId)
    If lngRet = 0 Then
        SendMessageByVAEString = 0
        Exit Function
    End If
    lngProcessH = lngRet
    
    ' プロセス内に共有メモリ確保
    lngRet = VirtualAllocEx(lngProcessH, ByVal 0, UBound(bytBuf) + 1, _
                            MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
    If lngRet = 0 Then
        SendMessageByVAEString = 0
        Call CloseHandle(lngProcessH)
        Exit Function
    End If
    
    lngVirtual = lngRet
    
    ' 共有メモリ初期化
    lngRet = WriteProcessMemory(lngProcessH, lngVirtual, bytBuf(0), UBound(bytBuf) + 1, ByVal 0)
    If lngRet = 0 Then
        SendMessageByVAEString = 0
        Call VirtualFreeEx(lngProcessH, lngVirtual, 0, MEM_RELEASE)
        Call CloseHandle(lngProcessH)
        Exit Function
    End If
    
    ' SendMessage発行
    SendMessageByVAEString = SendMessage(hWnd, wMsg, wParam, lngVirtual)
            
    ' 共有メモリから情報取得
    lngRet = ReadProcessMemory(lngProcessH, lngVirtual, bytBuf(0), UBound(bytBuf) + 1, ByVal 0)
    If lngRet = 0 Then
        SendMessageByVAEString = 0
        Call VirtualFreeEx(lngProcessH, lngVirtual, 0, MEM_RELEASE)
        Call CloseHandle(lngProcessH)
        Exit Function
    End If

    ' 共有メモリから取得した文字列をユニコード変換
    lParam = StrConv(bytBuf, vbUnicode)

    ' 共有メモリ解放
    lngRet = VirtualFreeEx(lngProcessH, lngVirtual, 0, MEM_RELEASE)
    If lngRet = 0 Then
        SendMessageByVAEString = 0
    End If
    
    ' プロセスのクローズ
    lngRet = CloseHandle(lngProcessH)
    If lngRet = 0 Then
        SendMessageByVAEString = 0
    End If
End Function

' 文字列からNULL文字以降をカット
Public Function StripNulls(ByVal strOrg As String) As String
    On Error Resume Next
    If (InStr(strOrg, Chr(0)) > 0) Then
        strOrg = Left(strOrg, InStr(strOrg, Chr(0)) - 1)
    End If
    StripNulls = strOrg
End Function