/' Get Registry Values by Paul Tice 02-27-2010, お好きに使って下さい https://www.freebasic.net/forum/viewtopic.php?t=15183 戻り値 String REG_BINARY Hex エンコードされた値を返します REG_DWORD と REG_QWORD は、As Str(value) で戻ります 対象 REG_SZ, REG_EXPAND_SZ (expanded), REG_DWORD, REG_QWORD, REG_BINARY, REG_MULTI_SZ REG_EXPAND_SZ 現在のユーザーのための拡張値 REG_EXPAND_SZ 値は 4096 bytes 未満です REG_MULTI_SZ CHR(0)で区切られた文字列 string を返します Windows x64 のため 64ビットレジストリ出力先変更を扱います 32ビットのプログラムは、デフォルトではすべてのキーや値を見ることができません、 そして、WOW632Node を読むと、無限ループにハマります 32 Bit レジストリ表示のため %syspath%\syswow64\regedit.exe を実行します HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductID はテストに好都合です 参照 http://support.microsoft.com/kb/896459 http://msdn.microsoft.com/en-us/library/aa384232%28VS.85%29.aspx http://msdn.microsoft.com/en-us/library/aa384129(VS.85).aspx 対象外 REG_DWORD_BIG_ENDIAN, REG_LINK, REG_NONE, REG_RESOURCE_LIST, REG_FULL_RESOURCE_DESCRIPTION, REG_RESOURCE_REQUIREMENTS_LIST Windows 2000 サポートを期待されても、Windows 2000 は取り扱いません WOW64_64KEY、検索/削除 "or &H0100" のためです 利用できる十分なバッファ・スペースがあるか、確認チェックしません、 マイクロソフトは、レジストリに保存されているファイル名を、 ロング値(2,048バイト以上)のファイルとして保存する必要がある、と指定します しかし、これを強制していません。 NT 以降の実際の最大値サイズは、_Available Memory_ です! これは、単純に、特に REG_BINARY 型の問題かもしれません トップレベル・キーを、HKEY_LOCAL_MACHINE と別のものに変更したり、 対象とするトップレベル・キーを渡すために、コード追加できます '/ #Include Once "windows.bi" '既に winreg.bi は含まれています Declare Function getregvalue(subkey As String, value As String) As String Dim As String RegValue, WhatSubkey, WhatValue '--- 表示例--- WhatSubkey="SOFTWARE\Microsoft\Windows NT\CurrentVersion" WhatValue="DigitalProductID" RegValue=getregvalue(WhatSubkey,WhatValue) Print WhatSubkey+"\"+WhatValue+"=" Print RegValue Print WhatValue="MultiSZ" RegValue=getregvalue(WhatSubkey,WhatValue) Print WhatSubkey+"\"+WhatValue+"=" Print RegValue Print WhatSubkey="SOFTWARE\Microsoft\Windows\CurrentVersion" WhatValue="DevicePath" RegValue=getregvalue(WhatSubkey,WhatValue) Print WhatSubkey+"\"+WhatValue+"=" Print RegValue Print Print"何かキーを押と終了します" Sleep Private Function getregvalue(subkey As String,value As String) As String Dim hk As HKEY = Any Dim sz As DWORD = Any Dim typ As DWORD = Any Dim test As Long test = RegOpenKeyEx(HKEY_LOCAL_MACHINE, subkey, 0, KEY_READ Or &H0100, @hk) '&H0100 は KEY_WOW64_64KEY のビットマスク, &H0200 は KEY_WOW64_32KEY のビットマスク If test = ERROR_SUCCESS Then test=RegQueryValueEx(hk, value, NULL, @typ, NULL, @sz) If test=ERROR_SUCCESS Then Select Case typ Case 1 Dim As String buf_sz buf_sz = String(sz, 0) test=RegQueryValueEx(hk, value, NULL, @typ, Strptr(buf_sz), @sz) If test = ERROR_SUCCESS Then RegCloseKey(hk) Return Left(buf_sz, sz - 1) Else Return "ERR_"+Str(test) End If Case 2 Dim As String buf_sz, buf_exp_sz Dim As Long test2 buf_exp_sz = String(4096, 0) buf_sz = String(sz, 0) test=RegQueryValueEx(hk, value, NULL, @typ, Strptr(buf_sz), @sz) If test = ERROR_SUCCESS Then RegCloseKey(hk) test=ExpandEnvironmentStrings(Strptr(buf_sz),Strptr(buf_exp_sz), 1024) If test= ERROR_SUCCESS Then Return "ERR_Expand_Enviroment_Strings_"+Str(test) Else Return Left(buf_exp_sz,test) End If Else Return "ERR_"+Str(test) End If Case 3 Dim buf(sz) As Byte Dim As String buf_binary Dim i As Integer test=RegQueryValueEx(hk, value, NULL, @typ, @buf(0), @sz) If test = ERROR_SUCCESS Then For i = 0 To sz buf_binary+=Hex(buf(i)) Next i Return buf_binary Else Return "Err_"+Str(test) End If Case 4 Dim As dword buf_dword test=RegQueryValueEx(hk, value, NULL, @typ, cast(byte ptr, @buf_dword), @sz) If test = ERROR_SUCCESS Then RegCloseKey(hk) Return Str(buf_dword) Else Return "ERR_"+Str(test) End If Case 7 Dim As String buf_sz buf_sz = String(sz, 0) test=RegQueryValueEx(hk, value, NULL, @typ, Strptr(buf_sz), @sz) If test = ERROR_SUCCESS Then RegCloseKey(hk) Return Left(buf_sz, sz) Else Return "ERR_"+Str(test) End If Case 11 Dim buf_qword As Ulongint Ptr test=RegQueryValueEx(hk, value, NULL, @typ, cast(byte ptr, @buf_qword), @sz) If test = ERROR_SUCCESS Then RegCloseKey(hk) Return Str(buf_qword) Else Return "ERR_"+Str(test) End If Case Else Return "ERR_REG_TYPE_"+Str(typ)+"Not Handled" End Select End If RegCloseKey(hk) If test=2 Then Return "ERR_RegQueryValueEx_Value_Not_Found" Else If test=5 Then Return "ERR_RegQueryValueEx_AccessDenied" Else Return "ERR_OpenKey_"+Str(test) End If End If End If Return "" End Function
#Include "RegistryReadWrite.bas" Dim regpath As string Dim keyname As String /' キーを読む例 '/ regpath = "SOFTWARE\Microsoft\Windows NT\CurrentVersion" keyname = "ProductName" Print keyname & "=" & ReadRegistry(HKEY_LOCAL_MACHINE,regpath,keyname) regpath = "Control Panel\Desktop\WindowMetrics" keyname = "PaddedBorderWidth" Print keyname & "=" & ReadRegistry(HKEY_CURRENT_USER,regpath,keyname) keyname = "ScrollWidth" Print keyname & "=" & ReadRegistry(HKEY_CURRENT_USER,regpath,keyname) /' キーを書く例 '/ regpath = "SOFTWARE\MySoftwareCompany" keyname = "MyEntry" WriteRegistry (HKEY_CURRENT_USER,regpath, keyname, ValDword, "25") Print "実行しました! 何かキーを押して下さい..." Sleep
/' 基本 Windows Registry Read/Write 関数 以下の VB6 ソースから移植 -Vincent DeCampo, 2010 原作者 UNKOWN '/ #Include "windows.bi" #Include "vbcompat.bi" ' 可能なレジストリデータ型 Enum InTypes ValNull = 0 ValString = 1 ValXString = 2 ValBinary = 3 ValDWord = 4 ValLink = 6 ValMultiString = 7 ValResList = 8 End Enum ' レジストリ・セクションの定義 'Const HKEY_CLASSES_ROOT = &H80000000 'Const HKEY_CURRENT_USER = &H80000001 'Const HKEY_LOCAL_MACHINE = &H80000002 'Const HKEY_USERS = &H80000003 'Const HKEY_PERFORMANCE_DATA = &H80000004 'Const HKEY_CURRENT_CONFIG = &H80000005 Function ReadRegistry(ByVal Group as HKEY, ByVal Section As LPCSTR, ByVal Key As LPCSTR) As String Dim as DWORD lDataTypeValue, lValueLength Dim sValue As String * 2048 Dim As String Tstr1, Tstr2 Dim lKeyValue As HKEY Dim lResult as Integer Dim td As Double sValue = "" lResult = RegOpenKey(Group, Section, @lKeyValue) lValueLength = Len(sValue) lResult = RegQueryValueEx(lKeyValue, Key, 0&, @lDataTypeValue, Cast(Byte Ptr,@sValue), @lValueLength) If (lResult = 0) Then Select Case lDataTypeValue case REG_DWORD td = Asc(Mid(sValue, 1, 1)) + &H100& * Asc(Mid(sValue, 2, 1)) + &H10000 * Asc(Mid(sValue, 3, 1)) + &H1000000 * CDbl(Asc(Mid(sValue, 4, 1))) sValue = Format(td, "000") case REG_BINARY ' Return a binary field as a hex string (2 chars per byte) Tstr2 = "" For I As Integer = 1 To lValueLength Tstr1 = Hex(Asc(Mid(sValue, I, 1))) If Len(Tstr1) = 1 Then Tstr1 = "0" & Tstr1 Tstr2 += Tstr1 Next sValue = Tstr2 Case Else sValue = Left(sValue, lValueLength - 1) End Select End If lResult = RegCloseKey(lKeyValue) Return sValue End Function Sub WriteRegistry(ByVal Group as HKEY, ByVal Section As LPCSTR, ByVal Key As LPCSTR, ByVal ValType As InTypes, value As String) Dim lResult as Integer Dim lKeyValue As HKEY Dim lNewVal as DWORD Dim sNewVal As String * 2048 lResult = RegCreateKey(Group, Section, @lKeyValue) If ValType = ValDWord Then lNewVal = CUInt(value) lResult = RegSetValueEx(lKeyValue, Key, 0&, ValType, Cast(Byte Ptr,@lNewVal), SizeOf(DWORD)) Else If ValType = ValString Then sNewVal = value & Chr(0) lResult = RegSetValueEx(lKeyValue, Key, 0&, ValString, Cast(Byte Ptr,@sNewVal), Len(sNewVal)) EndIf End If lResult = RegFlushKey(lKeyValue) lResult = RegCloseKey(lKeyValue) End Sub