Lightbox Info Board : SQLの窓

WinAPI.bas

' ******************************************************
' キーボードコントロール用
' ******************************************************
Public Declare Sub keybd_event Lib "user32" ( _
    ByVal bVk As Byte, _
    ByVal bScan As Byte, _
    ByVal dwFlags As Long, _
    ByVal dwExtraInfo As Long _
)
Public Const KEYEVENTF_KEYUP = &H2
Public Const VK_TAB = &H9

' ******************************************************
' ドキュメントに関連付けられた実行ファイル
' ******************************************************
Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" ( _
    ByVal lpFile As String, _
    ByVal lpDirectory As String, _
    ByVal lpResult As String _
) As Long

Const lbWinAPI_MAX_PATH = 260

' ******************************************************
' ウインドウへメッセージ送信
' ******************************************************
Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
lParam As Any) As Long
Const EM_SETREADONLY = &HCF

' ******************************************************
' ini ファイルアクセス
' ******************************************************
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias _
"GetPrivateProfileStringA" ( _
    ByVal lpAppName As String, _
    ByVal lpKeyName As String, _
    ByVal lpDefault As String, _
    ByVal lpReturnedString As String, _
    ByVal nSize As Long, _
    ByVal iniFileName As String _
) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias _
"WritePrivateProfileStringA" ( _
    ByVal lpApplicationName As String, _
    ByVal lpKeyName As String, _
    ByVal lpString As String, _
    ByVal lpFileName As String _
) As Long

' ******************************************************
' 列挙
' ******************************************************
Declare Function EnumWindows Lib "user32" ( _
    ByVal lpEnumFunc As Long, _
    ByVal lParam As Long _
) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
    ByVal hWnd As Long, _
    ByVal lpString As String, _
    ByVal cch As Long _
) As Long
Declare Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
    ByVal hWnd As Long, _
    ByVal lpClassName As String, _
    ByVal nMaxCount As Long _
) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long _
) As Long
Declare Function GetWindowThreadProcessId Lib "user32" ( _
    ByVal hWnd As Long, _
    lpdwProcessId As Long _
) As Long
Declare Function GetModuleFileName Lib "kernel32" Alias "GetModuleFileNameA" ( _
    ByVal hModule As Long, _
    ByVal lpFileName As String, _
    ByVal nSize As Long _
) As Long


Dim lbWinAPIGrid As MSHFlexGrid
Dim lbWinAPIEnumCount As Integer

' //////////////////////////////////////////////////////////////////////////

' ******************************************************
' 指定されたファイル名に関連付けられている実行可能
' ファイルの名前を取得
' ******************************************************
Public Function lbGetExecutable(DocPath As String) As String

    Dim RetPath As String * lbWinAPI_MAX_PATH
    Dim ret As Long
    
    RetPath = String(lbWinAPI_MAX_PATH, Chr(0))
    
    ret = FindExecutable(DocPath, 0, RetPath)
    If ret <= 32 Then
        lbGetExecutable = ""
    Else
        lbGetExecutable = Left(RetPath, InStr(RetPath, Chr(0)) - 1)
    End If

End Function

' ******************************************************
' Textboxを編集不可にする
' 選択可能で灰色にならない
' ******************************************************
Public Function lbReadonlyTextbox(Target As TextBox)
    
    Call SendMessage(Target.hWnd, EM_SETREADONLY, 1, 0)

End Function

' ******************************************************
' プログラムのあるディレクトリのINIへ書き込む
' ******************************************************
Public Function lbWriteIni( _
    Section As String, _
    Entry As String, _
    Value As String _
)
    
    Dim iniFileName As String
    
    iniFileName = App.Path & "\" & App.EXEName & ".ini"
    
    Call WritePrivateProfileString( _
        Section, _
        Entry, _
        Value, _
        iniFileName _
    )

End Function

' ******************************************************
' プログラムのあるディレクトリのINIより読み込む
' ******************************************************
Public Function lbGetIni( _
    Section As String, _
    Entry As String, _
    Default As String _
) As String
    
    Dim iniFileName As String
    
    iniFileName = App.Path & "\" & App.EXEName & ".ini"
    
    Dim strValue As String * 512
    
    strValue = String(512, Chr(0))
    
    Call GetPrivateProfileString( _
        Section, _
        Entry, _
        Default, _
        strValue, _
        512, _
        iniFileName _
    )

    lbGetIni = Left(strValue, InStr(strValue, Chr(0)) - 1)

End Function

' ***************************************************
' ENTER -> TAB
' Enter キーをだいたいにおいてTAB キー扱いする
' Form のKeyPreview を True にする必要がある
' Form_KeyPress(KeyAscii As Integer)で呼び出す
' ***************************************************
Public Function lbEnterToTab(KeyAscii As Integer)

    If KeyAscii = vbKeyReturn Then
        Call keybd_event(VK_TAB, 0, 0, 0)
        Call keybd_event(VK_TAB, 0, KEYEVENTF_KEYUP, 0)
    End If

End Function

' ******************************************************
' トップレベルウインドウの列挙
' ******************************************************
Public Function lbEnumWindows(Grid As MSHFlexGrid)

    Set lbWinAPIGrid = Grid
    lbWinAPIGrid.Rows = 2
    lbWinAPIGrid.Cols = 7
    lbWinAPIGrid.Clear
    
    lbWinAPIGrid.TextMatrix(0, 1) = "ハンドル"
    lbWinAPIGrid.TextMatrix(0, 2) = "タイトル"
    lbWinAPIGrid.TextMatrix(0, 3) = "クラス"
    lbWinAPIGrid.TextMatrix(0, 4) = "インスタンス"
    lbWinAPIGrid.TextMatrix(0, 5) = "スレッド"
    lbWinAPIGrid.TextMatrix(0, 6) = "プロセス"
        
    lbWinAPIEnumCount = 0
    
    Call EnumWindows(AddressOf lbCallbackEnumWindowsProc, 0)

End Function

' ******************************************************
' トップレベルウインドウの列挙(Callback)
' ******************************************************
Public Function lbCallbackEnumWindowsProc( _
    ByVal hWnd As Long, _
    ByVal lParam As Long _
) As Boolean

    Dim i As Integer
    Dim RowCount As Integer

    lbWinAPIEnumCount = lbWinAPIEnumCount + 1
    
    lbWinAPIGrid.Rows = lbWinAPIEnumCount + 1
    
    ' ウインドウハンドル
    lbWinAPIGrid.TextMatrix(lbWinAPIEnumCount, 1) = hWnd

    Dim strValue As String * 512
    
    strValue = String(512, Chr(0))
    Call GetWindowText(hWnd, strValue, 512)
    
    ' ウインドウタイトル
    lbWinAPIGrid.TextMatrix(lbWinAPIEnumCount, 2) = _
        Left(strValue, InStr(strValue, Chr(0)) - 1)
    
    strValue = String(512, Chr(0))
    Call GetClassName(hWnd, strValue, 512)
    
    ' クラス
    lbWinAPIGrid.TextMatrix(lbWinAPIEnumCount, 3) = _
        Left(strValue, InStr(strValue, Chr(0)) - 1)
    
    Dim hInstance
    
    hInstance = GetWindowLong(hWnd, -6)
    
    ' インスタンス
    lbWinAPIGrid.TextMatrix(lbWinAPIEnumCount, 4) = _
        GetWindowLong(hWnd, -6)
    
    Dim hThread
    Dim hProcess
    
    hThread = GetWindowThreadProcessId(hWnd, hProcess)
    
    ' スレッド
    lbWinAPIGrid.TextMatrix(lbWinAPIEnumCount, 5) = hThread
    ' プロセス
    lbWinAPIGrid.TextMatrix(lbWinAPIEnumCount, 6) = hProcess
    
    lbCallbackEnumWindowsProc = True

End Function