|
|||||
<このサンプルの概要> 以下の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 |