NonSoft

Win32Apiで色々試してみるサンプル(VB6)


 サンプル(ソース/コード)
<このサンプルの概要>
以下のWin32Apiを使用したサンプルソースです。
(1)GetLastError
(2)GetPrivateProfileString
(3)RegOpenKeyEx
(4)RegCloseKey
(5)RegQueryValueEx
(6)SetPrivateProfileString(WritePrivateProfileString)
(7)SetComputerName
(8)SHFileOperation
(9)Sleep
(10)GetWindowThreadProcessId
(11)FindWindow
(12)GetWindow
(13)GetParent

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

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

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

★GetWindowThreadProcessId / FindWindow / GetWindow / GetParent
Private Const GW_HWNDNEXT = 2
Private Declare Function GetParent Lib "user32" _
    (ByVal hwnd As Long) As Long
Private Declare Function GetWindow Lib "user32" _
    (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" _
    (ByVal hwnd As Long, ByRef lpdwprocessid As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" _
    (ByVal hwnd As Long) As Long

' プロセスID(pid)をウィンドウハンドル(hwnd)に変換する
Public Function GetHwndFromPid(ByVal pid As Long) As Long
    Dim hwnd As Long
    hwnd = FindWindow(vbNullString, vbNullString)
    Do Until hwnd = 0
        If GetParent(hwnd) = 0 And IsWindowVisible(hwnd) <> 0 Then
            If pid = GetPidFromHwnd(hwnd) Then
                GetHwndFromPid = hwnd
                Exit Do
            End If
        End If
        hwnd = GetWindow(hwnd, GW_HWNDNEXT)
    Loop
End Function

' ウィンドウハンドル(hwnd)をプロセスID(pid)に変換する
Public Function GetPidFromHwnd(ByVal hwnd As Long) As Long
    Dim pid As Long
    Call GetWindowThreadProcessId(hwnd, pid)
    GetPidFromHwnd = pid
End Function

★RegOpenKeyEx / RegCloseKey / RegQueryValueEx
' レジストリ関係API
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const KEY_ALL_ACCESS = &HF003F
Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" _
    (ByVal hkey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, _
     ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hkey As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" _
    (ByVal hkey As Long, ByVal lpszValueName As String, ByVal dwReserved As Long, _
     lpdwType As Long, lpbData As Any, cbData As Long) As Long

Dim strCmd As String: strCmd = ""
Dim lngBuf As Long: lngBuf = 511
Dim strBuf As String: strBuf = String(lngBuf + 1, Chr(0))
Dim ret   As Long
Dim key   As Long
Dim dtp   As Long

' レジストリKEYオープン(テキストエディタのパス)
ret = RegOpenKeyEx(HKEY_CLASSES_ROOT, _
    "txtfile\shell\open\command", 0, KEY_ALL_ACCESS, key)
If (ret = 0) Then
    ' レジストリVALUE取得
    ret = RegQueryValueEx(key, "", 0, dtp, ByVal strBuf, lngBuf)
    strCmd = Left$(strBuf, InStr(strBuf, Chr$(0)) - 1)
    ' レジストリKEYクローズ
    ret = RegCloseKey(key)
End If
' レジストリから取得したデータのデバック表示
Debug.Print strCmd

★GetPrivateProfileString / SetPrivateProfileString(WritePrivateProfileString)
' iniファイル読み込み/書き込みAPI
Private Declare Function GetPrivateProfileString Lib "kernel32.dll" Alias _
    "GetPrivateProfileStringA" (ByVal lpSectName As String, ByVal lpKeyName As Any, _
    ByVal lpDefault As String, ByVal lpReturnedString As String, _
    ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function SetPrivateProfileString Lib "kernel32.dll" Alias _
    "WritePrivateProfileStringA" (ByVal lpSection As String, ByVal lpKeyName As String, _
    ByVal lpValue As String, ByVal lpFileName As String) As Long

' iniファイル書き込み
SetPrivateProfileString "TEST_SECTION", "TEST_KEY", "test_value2", "d:\temp\test.ini"
    
' iniファイル読み込み
Dim strBuf As String * 1024
Dim lngLen As Long
lngLen = GetPrivateProfileString( _
    "TEST_SECTION", "TEST_KEY", "test_default", strBuf, 1024, "d:\temp\test.ini")

' iniファイル読み込み値のデバック表示
Debug.Print "[" & StrConv(LeftB$(StrConv(strBuf, vbFromUnicode), lngLen), vbUnicode) & "]"

★SetComputerName / GetLastError
Declare Function SetComputerName Lib "kernel32" Alias "SetComputerNameA" _
    (ByVal lpComputerName As String) As Long
Declare Function GetLastError Lib "kernel32" () As Long
Public Sub SampleModule()
    Dim lngRet As Long
    ' NetBiosコンピュータ名が変更された
    ' (注)システムのプロパティのコンピュータ名は変更されなかった(なぜ?)
    lngRet = SetComputerName("TESTCOMNAME")
    If lngRet = 0 Then
	' エラー番号を取得する
        MsgBox GetLastError()
    End If
End Sub

★Sleep
' 画面が固まらないスリープ
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Sub SampleModule(ByVal mSec As Long)
    Dim i As Long
    For i = 0 To mSec - 1 Step 100
        Sleep 100
        DoEvents
    Next i
End Sub

★SHFileOperation
' ゴミ箱へ移動するサンプル
Public Type SHFILEOPSTRUCT
    hWnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String
End Type
Public Declare Function SHFileOperation Lib "shell32" Alias "SHFileOperationA" _
    (lpFileOp As SHFILEOPSTRUCT) As Long
Private Const FO_DELETE = &H3&              ' 削除
Private Const FOF_ALLOWUNDO = &H40&         ' ごみ箱へ
Private Const FOF_NOCONFIRMATION = &H10&    ' 確認ダイアログを表示しなし
Private Const FOF_NOERRORUI = &H400&        ' エラーダイアログを表示しない

Public Function RecyclerDelete(myForm As Form, fileName As String) As Long
    Dim SFOP As SHFILEOPSTRUCT
    SFOP.pFrom = fileName
    SFOP.hWnd = myForm.hWnd
    SFOP.wFunc = FO_DELETE
    SFOP.fFlags = FOF_ALLOWUNDO + FOF_NOERRORUI + FOF_NOCONFIRMATION
    RecyclerDelete = SHFileOperation(SFOP)
End Function