Registry Module (windows only)
Re: Registry Module (windows only)
fixed! thanks to Crusiatus Black
and sorry for the delay.
and sorry for the delay.
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Re: Registry Module (windows only)
Hi ts-soft,
i have written a program which uses your registry.pb. Sometimes my programs halts with the following error:
I isolated my problem till the line of code within the procedure WriteValue in the registry.pb.
When trying to free memory the pc stops:
I don't know what is the cause of the problem nor how i can prevent it. Do you have any hint for me?
thanks in advance
Sundance
PS: I can run the program only on a non developer pc. I think i need to run/debug the exe with the purifier. ATM i don't know how to achieve this...
i have written a program which uses your registry.pb. Sometimes my programs halts with the following error:
I isolated my problem till the line of code within the procedure WriteValue in the registry.pb.
When trying to free memory the pc stops:
Code: Select all
FreeMemory(*lpData)
thanks in advance
Sundance
PS: I can run the program only on a non developer pc. I think i need to run/debug the exe with the purifier. ATM i don't know how to achieve this...
Re: Registry Module (windows only)
Hi.
It seems i have found the problem. I made a mistake when allocating memory in the first lines of the program.
With the help of some lines of code i had found the heap problem i had created.
I have found a link to it somewhere in the internet here is the url to it:
http://www.purebasic.fr/blog/?p=55
This is really a cool thing and i think i will use it more often then i think.
Made a module for easier usage:
see you guys
Sundance
It seems i have found the problem. I made a mistake when allocating memory in the first lines of the program.
With the help of some lines of code i had found the heap problem i had created.
I have found a link to it somewhere in the internet here is the url to it:
http://www.purebasic.fr/blog/?p=55
This is really a cool thing and i think i will use it more often then i think.
Made a module for easier usage:
Code: Select all
DeclareModule HeapTest
Declare _TestHeaps(File$, Line)
EndDeclareModule
Module HeapTest
Procedure _TestHeaps(File$, Line)
Protected StringHeap, MemoryBase, MemoryHeap
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
!extrn _PB_StringHeap
!extrn _PB_Memory_Heap
!mov eax, dword [_PB_StringHeap]
!mov [p.v_StringHeap], eax
!mov eax, dword [_PB_MemoryBase]
!mov [p.v_MemoryBase], eax
!mov eax, dword [_PB_Memory_Heap]
!mov [p.v_MemoryHeap], eax
CompilerElse
!extrn PB_StringHeap
!extrn PB_Memory_Heap
!mov rax, qword [PB_StringHeap]
!mov [p.v_StringHeap], rax
!mov rax, qword [_PB_MemoryBase]
!mov [p.v_MemoryBase], rax
!mov rax, qword [PB_Memory_Heap]
!mov [p.v_MemoryHeap], rax
CompilerEndIf
If HeapValidate_(StringHeap, 0, 0) = 0
MessageRequester("StringHeap corrupted !", File$+" : "+Str(Line))
EndIf
If HeapValidate_(MemoryBase, 0, 0) = 0
MessageRequester("MemoryBase heap corrupted !", File$+" : "+Str(Line))
EndIf
If HeapValidate_(MemoryHeap, 0, 0) = 0
MessageRequester("AllocateMemory heap corrupted !", File$+" : "+Str(Line))
EndIf
EndProcedure
Macro TestHeaps
_TestHeaps(#PB_Compiler_File, #PB_Compiler_Line)
EndMacro
EndModule
see you guys
Sundance
Re: Registry Module (windows only)
Hello.
Big Thanks @ ts-soft for the Code on the First page. i made a few changes Look in the Source
Big Thanks @ ts-soft for the Code on the First page. i made a few changes Look in the Source
Code: Select all
;======================================================================
; Module: Registry.pbi
;
; Author: Thomas (ts-soft) Schulz, Martin Schäfer
; Date: September 18, 2014
; Version: 1.4.2.1
; Target Compiler: PureBasic 5.2+
; Target OS: Windows
; License: Free, unrestricted, no warranty whatsoever
; Use at your own risk
; Target Test OS Windows 7 (64Bit), Windows 8 (32Bit), WindowsXP (32Bit)
;======================================================================
; History:
; Version 1.4.2.2 Sep 18, 2014
; Module changed to RegEditEX
; Return Codes fixed
; + Reg File Import
; + Reg File Export (Using Original Microsoft Structure)
; DeleteTree works IN 64Bit mode on 32Bit Hive
; + Dynamic Hive Redirection
; + SubKeyExists
; Deletekey. it use only DeletKeyEX_ for Windows Version >=60
; and the old variant for Windows Version <= 53
;
; Version 1.4.2, Jun 27, 2014
; fixed WriteValue
; Version 1.4.1, Sep 02, 2013
; fixed XP_DeleteTree()
; Version 1.4, Sep 02, 2013
; fixed Clear Resultstructure
; + compatibility to WinXP
; Version 1.3.3, Sep 01, 2013
; + Clear Resultstructure
; Version 1.3.2, Aug 31, 2013
; fixed a Bug with WriteValue and Unicode
; Version 1.3.1, Aug 30, 2013
; + DeleteTree() ; Deletes the subkeys and values of the specified key recursively.
; Version 1.3, Aug 30, 2013
; + ErrorString to RegValue Structure
; + RegValue to all Functions
; RegValue holds Errornumber and Errorstring!
; Renamed CountValues to CountSubValues
; Version 1.2.1, Aug 25, 2013
; source length reduced with macros
; Version 1.2, Aug 25, 2013
; + CountSubKeys()
; + CountValues()
; + ListSubKey()
; + ListSubValue()
; + updated example
;
; Version 1.1, Aug 25, 2013
; + ReadValue for #REG_BINARY returns a comma separate string with hexvalues (limited to 2096 bytes)
; + small example
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
DeclareModule RegEditEX
Structure RegValue
TYPE.l ; like: #REG_BINARY, #REG_DWORD ...
SIZE.l
ERROR.l
ERRORSTR.s
DWORD.l ; #REG_DWORD
QWORD.q ; #REG_QWORD
*BINARY ; #REG_BINARY
STRING.s ; #REG_EXPAND_SZ, #REG_MULTI_SZ, #REG_SZ
EndStructure
Enumeration -1 Step -1
#REG_ERR_ALLOCATE_MEMORY
#REG_ERR_BINARYPOINTER_MISSING
#REG_ERR_REGVALUE_VAR_MISSING
EndEnumeration
#LH_REGISTRYFILE=303
Declare.i GetErrorCode()
Declare.s GetErrorMsg()
Declare.i ReadType(topKey, ; like #HKEY_LOCAL_MACHINE, #HKEY_CURRENT_USER, #HKEY_CLASSES_ROOT ...
KeyName.s, ; KeyName without topKey
ValueName.s = "", ; ValueName, "" for Default
WOW64 = #False, ; If #TRUE, uses the 'Wow6432Node' path for Key
*Ret.RegValue = 0) ; result 0 = error or #REG_NONE (not supported)
Declare.s ReadValue(topKey,KeyName.s,ValueName.s = "",WOW64 = #False,*Ret.RegValue = 0,FileExport=0)
Declare.i WriteValue(topKey,
KeyName.s,
ValueName.s,
Value.s, ; Value as string
Type.l, ; Type like: #REG_DWORD, #REG_EXPAND_SZ, #REG_SZ
WOW64 = #False,
*Ret.RegValue = 0) ; to return more infos, is required for #REG_BINARY!
; result 0 = error, > 0 = successfull (1 = key created, 2 = key opened)
Declare.i CreateSubKey(topKey, SubKeyName.s ,WOW64 = #False, *Ret.RegValue = 0)
Declare.i DeleteTree(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
Declare.i DeleteKey(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
Declare.i DeleteValue(topKey, KeyName.s, ValueName.s, WOW64 = #False, *Ret.RegValue = 0)
Declare.i CountSubKeys(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
Declare.i CountSubValues(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
Declare.s ListSubKey(topKey, KeyName.s, index, WOW64 = #False, *Ret.RegValue = 0) ; the index is 0-based!
Declare.s ListSubValue(topKey, KeyName.s, index, WOW64 = #False, *Ret.RegValue = 0)
Declare.i SubKeyExists(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
Declare.i FileImport(RegistryFile$, WOW64 = #False)
Declare.i FileExport(RegistryFile$, ManagedKeyPath$,WOW64 = #False)
Declare.s WindowsVersion(iSelect=0)
;Der Export keyPath auf 64Bit System wird ohne \WOW6432Node\ geschrieben, Kann man sich aber anpassen ;)
EndDeclareModule
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Module RegEditEX
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Prototype RegDeleteKeyEXW(hKey.i, lpSubKey.p-Unicode, samDesired.l, Reserved.l = 0)
Prototype RegSetValueEXW(hKey.i, lpValueName.p-Unicode, Reserved.l, dwType.l, *lpData, cbData.l)
Prototype RegDeleteTreeW(hKey.i, lpSubKey.p-Unicode = 0)
Global RegDeleteKeyEXW.RegDeleteKeyEXW
Global RegSetValueEXW.RegSetValueEXW
Global RegDeleteTreeW.RegDeleteTreeW
Structure KEY_ITEM_COUNT
KeyNames.l
KeyPaths.l
EndStructure
Structure KEYS_NAME
KeyValueID.l
KeyName.s
KeyData.s
EndStructure
Structure PATH_NAME
KeyValueID.l
KeyName.s
KeyFullPath.s
EndStructure
Global NewList FullKeyPath.PATH_NAME() ; Alle gefundenen Dateien mit kompletten Pfad
Global NewList FullKeyName.KEYS_NAME()
Global KEYCOUNT.KEY_ITEM_COUNT
Structure REGCODES
ERROR.l
ERRORSTR.s
EndStructure
Global NewList RegCodes.REGCODES()
AddElement(RegCodes()): RegCodes()\ERROR = 0
AddElement(RegCodes()): RegCodes()\ERRORSTR.s = ""
Define Advapi32dll.i
Advapi32dll = OpenLibrary(#PB_Any, "Advapi32.dll")
If Advapi32dll
RegDeleteKeyEXW = GetFunction(Advapi32dll, "RegDeleteKeyExW")
RegSetValueEXW = GetFunction(Advapi32dll, "RegSetValueExW")
RegDeleteTreeW = GetFunction(Advapi32dll, "RegDeleteTreeW")
EndIf
#KEY_WOW64_64KEY = $100
#KEY_WOW64_32KEY = $200
Macro OpenKey()
If #PB_Processor_x64
If WOW64 = #True
samDesired | #KEY_WOW64_64KEY
Else
samDesired | #KEY_WOW64_32KEY
EndIf
Else
samDesired | #KEY_WOW64_32KEY
EndIf
If Left(KeyName, 1) = "\" : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1) : EndIf
If *Ret <> 0: ClearStructure(*Ret, RegValue): EndIf
error = RegOpenKeyEx_(topKey, KeyName, 0, samDesired, @hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error)
If hKey: RegCloseKey_(hKey): EndIf
ProcedureReturn #False
EndIf
EndMacro
Macro OpenKeyS()
If #PB_Processor_x64
If WOW64 = #True
samDesired | #KEY_WOW64_64KEY
Else
samDesired | #KEY_WOW64_32KEY
EndIf
Else
samDesired | #KEY_WOW64_32KEY
EndIf
If Left(KeyName, 1) = "\" : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1) : EndIf
If *Ret <> 0: ClearStructure(*Ret, RegValue): EndIf
error = RegOpenKeyEx_(topKey, KeyName, 0, samDesired, @hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error)
If hKey: RegCloseKey_(hKey): EndIf
ProcedureReturn ""
EndIf
EndMacro
;////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure.s WindowsVersion(iSelect=0)
Protected sMajor$, sMinor$, sBuild$, Version$, sPlatform$, SystemRoot$, iResult.l
Define Os.OSVERSIONINFO
Define WinVersion$
Os\dwOSVersionInfoSize = SizeOf(OSVERSIONINFO)
GetVersionEx_(@Os.OSVERSIONINFO)
Select iSelect
Case 0:
sMajor$ = Str(Os\dwMajorVersion)
sMinor$ = Str(Os\dwMinorVersion)
ProcedureReturn sMajor$+sMinor$
Case 1:
sBuild$ = Str(Os\dwBuildNumber)
ProcedureReturn sBuild$
Case 2:
sSPack$ = PeekS(@Os\szCSDVersion)
ProcedureReturn sSPack$
Case 4:
sPlatform$ = Str(Os\dwPlatformId)
sMajor$ = Str(Os\dwMajorVersion)
sMinor$ = Str(Os\dwMinorVersion)
Version$= sPlatform$+"."+sMajor$+"."+sMinor$
Select Version$
Case "1.0.0": ProcedureReturn "Windows 95"
Case "1.1.0": ProcedureReturn "Windows 98"
Case "1.9.0": ProcedureReturn "Windows Millenium"
Case "2.3.0": ProcedureReturn "Windows NT 3.51"
Case "2.4.0": ProcedureReturn "Windows NT 4.0"
Case "2.5.0": ProcedureReturn "Windows 2000"
Case "2.5.1": ProcedureReturn "Windows XP"
Case "2.5.3": ProcedureReturn "Windows 2003 (SERVER)"
Case "2.6.0": ProcedureReturn "Windows Vista"
Case "2.6.1": ProcedureReturn "Windows 7"
Case "2.6.2": ProcedureReturn "Windows 8" ;Build 9200
Default: ProcedureReturn "Unknown"
EndSelect
Case 5:
If ExamineEnvironmentVariables()
While NextEnvironmentVariable()
SystemRoot$ = EnvironmentVariableName()
If (LCase(SystemRoot$)="systemroot")
ProcedureReturn EnvironmentVariableValue()
EndIf
Wend
EndIf
Case 6:
If ExamineEnvironmentVariables()
While NextEnvironmentVariable()
SystemRoot$ = EnvironmentVariableName()
If (LCase(SystemRoot$)="systemroot")
iResult = FileSize(SystemRoot$+"SYSWOW64\")
If (iResult = -2)
ProcedureReturn EnvironmentVariableValue()+"\SYSWOW64\"
Else
ProcedureReturn EnvironmentVariableValue()+"\SYSTEM32\"
EndIf
EndIf
Wend
EndIf
EndSelect
;-----------------------------------------------------------------------------------------------
; Get_WindowsVersion(iSelect=0), Holt die Aktuelle Windows Version, via iSelect lässt sich
; mehrere Information zurückgeben
; iSelect=5 gibt das Windows Root Verzeichnis Zurück
; iSelect=6 gibt das Windows System Verzeichnis Zurück
;-----------------------------------------------------------------------------------------------
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure HiveFSRedirection(samDesired,WOW64)
If #PB_Processor_x64
If WOW64 = #True
ProcedureReturn samDesired | #KEY_WOW64_64KEY
Else
ProcedureReturn samDesired | #KEY_WOW64_32KEY
EndIf
Else
ProcedureReturn samDesired | #KEY_WOW64_32KEY
EndIf
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure.s GetLastErrorStr(error)
Protected Buffer.i, result.s
If FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER | #FORMAT_MESSAGE_FROM_SYSTEM, 0, error, 0, @Buffer, 0, 0)
result = PeekS(Buffer)
LocalFree_(Buffer)
SelectElement(RegCodes(),0)
RegCodes()\ERROR = error
SelectElement(RegCodes(),1)
RegCodes()\ERRORSTR = result
ProcedureReturn result
EndIf
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure.i GetErrorCode(): SelectElement(RegCodes(),0): ProcedureReturn Regcodes()\ERROR: EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure.s GetErrorMsg(): SelectElement(RegCodes(),1): ProcedureReturn Regcodes()\ERRORSTR: EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure CreateSubKey(topKey, SubKeyName.s ,WOW64 = #False, *Ret.RegValue = 0)
Protected error, lpSecurityAttributes.SECURITY_ATTRIBUTES, hKey, create,samDesired = #KEY_ALL_ACCESS
samDesired = HiveFSRedirection(samDesired,WOW64)
error = RegCreateKeyEx_(topKey, SubKeyName, 0, 0, #REG_OPTION_NON_VOLATILE, samDesired, @lpSecurityAttributes, @hKey, @create)
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error)
If hKey: RegCloseKey_(hKey): EndIf: ProcedureReturn createKey
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure.i XP_DeleteTree(topKey, KeyName.s,WOW64, *RET.RegValue = 0)
Protected hKey, error, dwSize.l, sBuf.s = Space(260), samDesired = #KEY_ENUMERATE_SUB_KEYS
samDesired = HiveFSRedirection(samDesired,WOW64)
OpenKey()
; If Left(KeyName, 1) = "\" : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
; If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1) : EndIf
;
; If *Ret <> 0: ClearStructure(*Ret, RegValue): EndIf
;
; error = RegOpenKeyEx_(topKey, @KeyName, 0, #KEY_ENUMERATE_SUB_KEYS, @hKey)
; If error
; If *Ret <> 0
; *Ret\ERROR = error
; *Ret\ERRORSTR = GetLastErrorStr(error)
; EndIf
; GetLastErrorStr(error)
;
; If hKey: RegCloseKey_(hKey): EndIf: ProcedureReturn #False
; EndIf
Repeat
dwSize.l = 260
error = RegEnumKeyEx_(hKey, 0, @sBuf, @dwSize, 0, 0, 0, 0)
If Not error: XP_DeleteTree(hKey, sBuf,WOW64): EndIf
Until error
RegCloseKey_(hKey)
error = RegDeleteKey_(topKey, KeyName)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error)
ProcedureReturn #False
EndIf
GetLastErrorStr(error)
ProcedureReturn #True
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure.i DeleteTree(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_ALL_ACCESS
Protected hKey
Protected SubKeyToRemove$
samDesired = HiveFSRedirection(samDesired,WOW64)
If RegDeleteTree = 0
ProcedureReturn XP_DeleteTree(topKey, KeyName,WOW64, *RET)
EndIf
OpenKey()
error = RegDeleteTreeW(hKey)
RegCloseKey_(hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error)
ProcedureReturn #False
EndIf
GetLastErrorStr(error)
ProcedureReturn #True
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure.i DeleteKey(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_WRITE, WinVersion.i
samDesired = HiveFSRedirection(samDesired,WOW64)
If Left(KeyName, 1) = "\" : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1) : EndIf
WinVersion.i = Val(WindowsVersion())
If (WinVersion.i >= 60)
error = RegDeleteKeyEXW(topKey, KeyName, samDesired)
ElseIf (WinVersion.i <= 53)
error = RegDeleteKey_(topKey, KeyName)
EndIf
If error
If *Ret <> 0
ClearStructure(*Ret, RegValue)
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error)
ProcedureReturn #False
EndIf
GetLastErrorStr(error)
ProcedureReturn #True
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure.i DeleteValue(topKey, KeyName.s, ValueName.s, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_WRITE
Protected hKey
OpenKey()
error = RegDeleteValue_(hKey, ValueName)
RegCloseKey_(hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error): ProcedureReturn #False
EndIf
GetLastErrorStr(error)
ProcedureReturn #True
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure.i CountSubKeys(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_READ
Protected hKey, count
OpenKey()
error = RegQueryInfoKey_(hKey, 0, 0, 0, @count, 0, 0, 0, 0, 0, 0, 0)
RegCloseKey_(hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error): ProcedureReturn #False
EndIf
GetLastErrorStr(error)
ProcedureReturn count
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure.s ListSubKey(topKey, KeyName.s, index, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_READ
Protected hKey, size, result.s
OpenKeyS()
error = RegQueryInfoKey_(hKey, 0, 0, 0, 0, @size, 0, 0, 0, 0, 0, 0)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error)
RegCloseKey_(hKey): ProcedureReturn ""
EndIf
size + 1
result = Space(size)
error = RegEnumKeyEx_(hKey, index, @result, @size, 0, 0, 0, 0)
RegCloseKey_(hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error): ProcedureReturn ""
EndIf
GetLastErrorStr(error)
ProcedureReturn result
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure.i CountSubValues(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_READ
Protected hKey, count
OpenKey()
error = RegQueryInfoKey_(hKey, 0, 0, 0, 0, 0, 0, @count, 0, 0, 0, 0)
RegCloseKey_(hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error): ProcedureReturn #False
EndIf
GetLastErrorStr(error)
ProcedureReturn count
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure.s ListSubValue(topKey, KeyName.s, index, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_READ
Protected hKey, size, result.s
OpenKeyS()
error = RegQueryInfoKey_(hKey, 0, 0, 0, 0, 0, 0, 0, @size, 0, 0, 0)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error)
RegCloseKey_(hKey): ProcedureReturn ""
EndIf
size + 1
result = Space(size)
error = RegEnumValue_(hKey, index, @result, @size, 0, 0, 0, 0)
RegCloseKey_(hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error): ProcedureReturn ""
EndIf
GetLastErrorStr(error)
ProcedureReturn result
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure.i ReadType(topKey, KeyName.s, ValueName.s = "", WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_READ
Protected hKey, lpType
OpenKey()
error = RegQueryValueEx_(hKey, ValueName, 0, @lpType, 0, 0)
RegCloseKey_(hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error)
ProcedureReturn #False
EndIf
GetLastErrorStr(error)
ProcedureReturn lpType
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure.s ReadValue(topKey, KeyName.s, ValueName.s = "", WOW64 = #False, *Ret.RegValue = 0,FileExport=0)
Protected error, result.s, samDesired = #KEY_READ
Protected hKey, lpType.l, *lpData, lpcbData.l, ExSZlength, *ExSZMem, i
OpenKeyS()
error = RegQueryValueEx_(hKey, ValueName, 0, 0, 0, @lpcbData)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error): RegCloseKey_(hKey): ProcedureReturn ""
EndIf
If lpcbData
*lpData = AllocateMemory(lpcbData)
If *lpData = 0
If *Ret <> 0
*Ret\ERROR = #REG_ERR_ALLOCATE_MEMORY
*Ret\ERRORSTR = "Error: Can't allocate memory"
EndIf
SelectElement(RegCodes(),0): RegCodes()\ERROR = #REG_ERR_ALLOCATE_MEMORY
SelectElement(RegCodes(),1): RegCodes()\ERRORSTR = "Error: Can't allocate memory"
RegCloseKey_(hKey): ProcedureReturn ""
EndIf
EndIf
error = RegQueryValueEx_(hKey, ValueName, 0, @lpType, *lpData, @lpcbData)
RegCloseKey_(hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error): FreeMemory(*lpData): ProcedureReturn ""
EndIf
If *Ret <> 0: *Ret\TYPE = lpType: EndIf
Select lpType
Case #REG_BINARY
If lpcbData <= 2096
For i = 0 To lpcbData - 1
result + "$" + RSet(Hex(PeekA(*lpData + i)), 2, "0") + ","
Next
Else
For i = 0 To 2095
result + "$" + RSet(Hex(PeekA(*lpData + i)), 2, "0") + ","
Next
EndIf
result = Left(result, Len(result) - 1)
If *Ret <> 0: *Ret\BINARY = *lpData: *Ret\SIZE = lpcbData :EndIf: ProcedureReturn result ; we don't free the memory!
Case #REG_DWORD
If *Ret <> 0
*Ret\DWORD = PeekL(*lpData)
*Ret\SIZE = SizeOf(Long)
EndIf
If FileExport=0
result = Str(PeekL(*lpData))
EndIf
If FileExport=1
result = Str(PeekL(*lpData))
iLenght = Len(result)
If (iLenght = 1)
result = "dword:0000000"+Str(PeekL(*lpData))
ElseIf (iLenght = 2)
result = "dword:000000"+Str(PeekL(*lpData))
ElseIf (iLenght = 3)
result = "dword:00000"+Str(PeekL(*lpData))
ElseIf (iLenght = 4)
result = "dword:0000"+Str(PeekL(*lpData))
ElseIf (iLenght = 5)
result = "dword:000"+Str(PeekL(*lpData))
ElseIf (iLenght = 6)
result = "dword:00"+Str(PeekL(*lpData))
ElseIf (iLenght = 7)
result = "dword:0"+Str(PeekL(*lpData))
EndIf
EndIf
Case #REG_EXPAND_SZ
ExSZlength = ExpandEnvironmentStrings_(*lpData, 0, 0)
If ExSZlength > 0
*ExSZMem = AllocateMemory(ExSZlength)
If *ExSZMem
If ExpandEnvironmentStrings_(*lpData, *ExSZMem, ExSZlength)
result = PeekS(*ExSZMem)
If *Ret <> 0
*Ret\STRING = result
*Ret\SIZE = Len(result)
EndIf
EndIf
FreeMemory(*ExSZMem)
EndIf
Else
Debug "Error: Can't allocate memory"
EndIf
Case #REG_MULTI_SZ
While i < lpcbData
If PeekS(*lpData + i, 1) = ""
result + #LF$
Else
result + PeekS(*lpData + i, 1)
EndIf
i + SizeOf(Character)
Wend
If Right(result, 1) = #LF$: result = Left(result, Len(result) - 1): EndIf
If *Ret <> 0: *Ret\STRING = result: *Ret\SIZE = Len(result): EndIf
Case #REG_QWORD
If *Ret <> 0 :*Ret\QWORD = PeekQ(*lpData): *Ret\SIZE = SizeOf(Quad): EndIf
result = Str(PeekQ(*lpData))
Case #REG_SZ
If (*lpData <> 0)
result = PeekS(*lpData)
EndIf
If *Ret <> 0: *Ret\STRING = result: *Ret\SIZE = Len(result): EndIf
EndSelect
If (*lpData <> 0)
FreeMemory(*lpData)
EndIf
GetLastErrorStr(error)
ProcedureReturn result
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure.i WriteValue(topKey, KeyName.s, ValueName.s, Value.s, Type.l, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_WRITE
Protected hKey, *lpData, lpcbData.q, count, create, i, tmp.s, pos, temp1.l, temp2.q
samDesired = HiveFSRedirection(samDesired,WOW64)
If Left(KeyName, 1) = "\" : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1) : EndIf
If *Ret <> 0
If Type <> #REG_BINARY: ClearStructure(*Ret, RegValue)
Else
*Ret\TYPE = 0
*Ret\ERROR = 0
*Ret\ERRORSTR = ""
*Ret\DWORD = 0
*Ret\QWORD = 0
*Ret\STRING = ""
EndIf
EndIf
error = RegCreateKeyEx_(topKey, KeyName, 0, 0, 0, samDesired, 0, @hKey, @create)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error)
If hKey: RegCloseKey_(hKey): EndIf: ProcedureReturn #False
EndIf
Select Type
Case #REG_BINARY
If *Ret = 0
If *Ret <> 0
*Ret\ERROR = #REG_ERR_REGVALUE_VAR_MISSING
*Ret\ERRORSTR = "Error: Required *Ret.RegValue parameter not found!"
EndIf
SelectElement(RegCodes(),0): RegCodes()\ERROR = #REG_ERR_REGVALUE_VAR_MISSING
SelectElement(RegCodes(),1): RegCodes()\ERRORSTR = "Error: Required *Ret.RegValue parameter not found!"
RegCloseKey_(hKey): ProcedureReturn #False
EndIf
lpcbData = *Ret\SIZE
*lpData = *Ret\BINARY
If *lpData = 0
If *Ret <> 0
*Ret\ERROR = #REG_ERR_BINARYPOINTER_MISSING
*Ret\ERRORSTR = "Error: No Pointer to BINARY defined!"
EndIf
SelectElement(RegCodes(),0): RegCodes()\ERROR = #REG_ERR_BINARYPOINTER_MISSING
SelectElement(RegCodes(),1): RegCodes()\ERRORSTR = "Error: No Pointer to BINARY defined!"
RegCloseKey_(hKey): ProcedureReturn #False
EndIf
If lpcbData = 0: lpcbData = MemorySize(*lpData): EndIf
error = RegSetValueEx_(hKey, ValueName, 0, #REG_BINARY, *lpData, lpcbData)
Case #REG_DWORD
temp1 = Val(Value)
error = RegSetValueEx_(hKey, ValueName, 0, #REG_DWORD, @temp1, 4)
Case #REG_QWORD
temp2 = Val(Value)
error = RegSetValueEx_(hKey, ValueName, 0, #REG_QWORD, @temp2, 8)
Case #REG_EXPAND_SZ, #REG_SZ
error = RegSetValueEx_(hKey, ValueName, 0, Type, @Value, StringByteLength(Value) + SizeOf(Character))
Case #REG_MULTI_SZ
count = CountString(Value, #LF$)
For i = 0 To count
tmp = StringField(Value, i + 1, #LF$)
lpcbData + StringByteLength(tmp, #PB_Unicode) + 2
Next
If lpcbData
*lpData = AllocateMemory(lpcbData)
If *lpData
For i = 0 To count
tmp = StringField(Value, i + 1, #LF$)
PokeS(*lpData + pos, tmp, -1, #PB_Unicode)
pos + StringByteLength(tmp, #PB_Unicode) + 2
Next
error = RegSetValueEXW(hKey, ValueName, 0, Type, *lpData, lpcbData)
FreeMemory(*lpData)
Else
If *Ret <> 0
*Ret\ERROR = #REG_ERR_ALLOCATE_MEMORY
*Ret\ERRORSTR = "Error: Can't allocate memory"
EndIf
SelectElement(RegCodes(),0): RegCodes()\ERROR = #REG_ERR_ALLOCATE_MEMORY
SelectElement(RegCodes(),1): RegCodes()\ERRORSTR = "Error: Can't allocate memory"
RegCloseKey_(hKey): ProcedureReturn #False
EndIf
EndIf
EndSelect
RegCloseKey_(hKey)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error): ProcedureReturn #False
EndIf
GetLastErrorStr(error)
ProcedureReturn create
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure.i SubKeyExists(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_READ
Protected hKey, lpType, hKeyLabel
OpenKey()
error = RegOpenKeyEx_(hKey, ValueName, 0, samDesired, @hKeyLabel)
RegCloseKey_(hKeyLabel)
If error
If *Ret <> 0
*Ret\ERROR = error
*Ret\ERRORSTR = GetLastErrorStr(error)
EndIf
GetLastErrorStr(error)
ProcedureReturn error
EndIf
GetLastErrorStr(error)
ProcedureReturn error
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure.i ConvertRegKey2TopAndKeyName(key$)
Protected iPos.i
Structure RegConverted
TopKey.q
Keyname$
EndStructure
Global NewList RegConverted.RegConverted()
AddElement(RegConverted()): RegConverted()\TopKey.q = 0
AddElement(RegConverted()): RegConverted()\Keyname$ = ""
iPos = FindString(key$,"HKEY_CLASSES_ROOT\")
If iPos <> 0
SelectElement(RegConverted(),0): RegConverted()\TopKey = #HKEY_CLASSES_ROOT
SelectElement(RegConverted(),1)
RegConverted()\Keyname$ = ReplaceString(key$,"HKEY_CLASSES_ROOT\","")
ProcedureReturn
EndIf
iPos = FindString(key$,"HKEY_CURRENT_CONFIG\")
If iPos <> 0
SelectElement(RegConverted(),0): RegConverted()\TopKey = #HKEY_CURRENT_CONFIG
SelectElement(RegConverted(),1)
RegConverted()\Keyname$ = ReplaceString(key$,"HKEY_CURRENT_CONFIG\","")
ProcedureReturn
EndIf
iPos = FindString(key$,"HKEY_CURRENT_USER\")
If iPos <> 0
SelectElement(RegConverted(),0): RegConverted()\TopKey = #HKEY_CURRENT_USER
SelectElement(RegConverted(),1)
RegConverted()\Keyname$ = ReplaceString(key$,"HKEY_CURRENT_USER\","")
ProcedureReturn
EndIf
iPos = FindString(key$,"HKEY_DYN_DATA\")
If iPos <> 0
SelectElement(RegConverted(),0): RegConverted()\TopKey = #HKEY_DYN_DATA
SelectElement(RegConverted(),1)
RegConverted()\Keyname$ = ReplaceString(key$,"HKEY_DYN_DATA\","")
ProcedureReturn
EndIf
iPos = FindString(key$,"HKEY_LOCAL_MACHINE\")
If iPos <> 0
SelectElement(RegConverted(),0): RegConverted()\TopKey = #HKEY_LOCAL_MACHINE
SelectElement(RegConverted(),1)
RegConverted()\Keyname$ = ReplaceString(key$,"HKEY_LOCAL_MACHINE\","")
ProcedureReturn
EndIf
iPos = FindString(key$,"HKEY_PERFORMANCE_DATA\")
If iPos <> 0
SelectElement(RegConverted(),0): RegConverted()\TopKey = #HKEY_PERFORMANCE_DATA
SelectElement(RegConverted(),1)
RegConverted()\Keyname$ = ReplaceString(key$,"HKEY_PERFORMANCE_DATA\","")
ProcedureReturn
EndIf
iPos = FindString(key$,"HKEY_USERS\")
If iPos <> 0
SelectElement(RegConverted(),0): RegConverted()\TopKey = #HKEY_USERS
SelectElement(RegConverted(),1)
RegConverted()\Keyname$ = ReplaceString(key$,"HKEY_USERS\","")
ProcedureReturn
EndIf
Debug "Unknown: "+ key$
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure FileImport_GetTypes(iSection$,iSectionsKey$,iRegistryFile$,topKey,WOW64=#False)
Protected StrLng, iValue$, iDatas$, iResult, iErrorCode, DWordPos
iSection$ = ReplaceString(iSection$,Chr(34),"")
HexPos = FindString(iSection$,"hex:",1)
If HexPos <> 0
StrLng = Len(iSection$)
;// Multiline Hex Strings : Settings101"=hex:01,01,00,00,00,00,00,00,2f,04,00,00,01,00,00,00,00,00,00,00,\
StrSlash = FindString(iSection$,"\",StrLng)
If StrSlash <> 0
iDatas$ = ""
iBreak = #False
If OpenFile(0,iRegistryFile$)
If ReadFile(0, iRegistryFile$)
While Eof(0) = 0
iLIneTC$ = ReadString(0, #PB_Unicode)
iLIneTC$ = ReplaceString(iLIneTC$,Chr(34),"")
iLIneLng = Len(iLIneTC$)
If (iSection$ = iLIneTC$)
iDatas$ = iLIneTC$
While Eof(0) = 0
iLIneTC$ = ReadString(0, #PB_Unicode):
iLIneTC$ = ReplaceString(iLIneTC$,Chr(34),"")
iLIneLng = Len(iLIneTC$)
iDatas$ = iDatas$+Trim(iLIneTC$)
If (Len(iLIneTC$) = 0)
iBreak = #True
Break
EndIf
If (FindString(iLIneTC$,",\",iLIneLng-1) = 0)
iBreak = #True
Break
EndIf
Wend
EndIf
If (iBreak = #True)
iSection$ = ReplaceString(iDatas$,Chr(92),"")
StrLng = Len(iSection$)
Break
EndIf
Wend
EndIf
EndIf
CloseFile(0)
EndIf
iValue$ = Left(iSection$,HexPos-2): iDatas$ = Mid(iSection$,HexPos)
iDatas$ = ReplaceString(iDatas$,"hex:",""): iDatas$ = ReplaceString(iDatas$,Chr(44),"")
WriteValue(topKey, iSectionsKey$, iValue$, iDatas$,#REG_BINARY, WOW64): Debug GetErrorMsg(): ProcedureReturn
Else
DWordPos = FindString(iSection$,"dword:",1)
If DWordPos <> 0
StrLng = Len(iSection$)
iValue$ = Left(iSection$,DWordPos-2): iDatas$ = Mid(iSection$,DWordPos)
iDatas$ = ReplaceString(iDatas$,"dword:",""): iDatasL = Val("$"+iDatas$)
WriteValue(topKey, iSectionsKey$, iValue$, Str(iDatasL),#REG_DWORD, WOW64): Debug GetErrorMsg(): ProcedureReturn
Else
StrPos = FindString(iSection$,"=",1)
If StrPos <> 0
StrLng = Len(iSection$)
iValue$ = Left(iSection$,StrPos-1)
If Chr(64) = iValue$: iValue$ = "": EndIf
iDatas$ = Mid(iSection$,StrPos+1): iDatas$ = ReplaceString(iDatas$,"\\","\")
WriteValue(topKey, iSectionsKey$, iValue$, iDatas$,#REG_SZ, WOW64): GetErrorMsg(): ProcedureReturn
EndIf
EndIf
EndIf
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure FileImport_GetSectionsNames(path.s, List OutList.s())
Protected *adr, temp.s,
*buffer = AllocateMemory($4000)
GetPrivateProfileSectionNames_(*buffer, $4000, path)
*adr = *buffer
Repeat
temp = PeekS(*adr)
If temp <> "": AddElement(OutList()): OutList() = temp: EndIf
Debug temp
*adr + Len(temp) + 1
Until temp = ""
FreeMemory(*buffer)
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure FileImport_GetSection(section.s, path.s, List OutList.s())
Protected *buffer, *adr, temp.s
*buffer = AllocateMemory($4000)
GetPrivateProfileSection_(section, *buffer, $4000, path)
*adr = *buffer
Repeat
temp.s = PeekS(*adr)
If temp <> "": AddElement(OutList()): OutList() = temp: EndIf
*adr + Len(temp) + 1
Until temp = ""
FreeMemory(*buffer)
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure FileImport(RegistryFile$, WOW64=#False)
Protected Position.i, Size.i, HKey.q, SKey.s
NewList SectionsNames.s()
NewList Section.s()
Size.i = FileSize(RegistryFile$)
If (Size.i <> 0) Or (Size.i <> -1)
FileImport_GetSectionsNames(RegistryFile$, SectionsNames())
ForEach SectionsNames()
ConvertRegKey2TopAndKeyName(SectionsNames())
SelectElement(RegConverted(),0): HKey.q = Regconverted()\TopKey.q
SelectElement(RegConverted(),1): SKey.s = Regconverted()\Keyname$
FreeList(RegConverted())
CreateSubKey(HKey.q, SKey.s ,WOW64)
ClearList(Section())
FileImport_GetSection(SectionsNames(), RegistryFile$, Section())
ForEach Section()
Position = FindString(Section(),"=",1)
If (Position <> 0)
FileImport_GetTypes(Section(),SKey.s,RegistryFile$,HKey.q,WOW64):Debug Section()
EndIf
Next
Next
EndIf
FreeList(SectionsNames()): FreeList(Section())
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure FileExport_CRLF(File$)
If OpenFile(#LH_REGISTRYFILE,File$)
FileSeek(#LH_REGISTRYFILE, Lof(#LH_REGISTRYFILE))
WriteStringN(#LH_REGISTRYFILE, "",#PB_Ascii)
CloseFile(#LH_REGISTRYFILE)
EndIf
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure FileExport_SECT(File$,RegistryData$)
If OpenFile(#LH_REGISTRYFILE,File$)
FileSeek(#LH_REGISTRYFILE, Lof(#LH_REGISTRYFILE))
WriteStringN(#LH_REGISTRYFILE, RegistryData$,#PB_Ascii)
CloseFile(#LH_REGISTRYFILE)
EndIf
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure FileExport_ADD(KeyName$,ManagedPath$,IndexID.i,Count.i)
If Len(KeyName$) = 0 :ProcedureReturn #False: EndIf
ResetList(FullKeyPath())
If ListSize(FullKeyPath()) = 0
Else
ResetList(FullKeyPath())
While NextElement(FullKeyPath())
If (FullKeyPath()\KeyName = KeyName$)
ProcedureReturn #False
EndIf
Wend
EndIf
AddElement(FullKeyPath())
FullKeyPath()\KeyValueID = IndexID.i
FullKeyPath()\KeyName = KeyName$
FullKeyPath()\KeyFullPath = ManagedPath$+KeyName$
;Debug Str(IndexID.i)+"/"+Count+" ["+ManagedPath$+KeyName$+"]"
ProcedureReturn #True
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure FileExport_COUT(HKey.q, SKey.s,WOW64,ManagedPath$)
Protected iResult
ManagedPath$ = ReplaceString(ManagedPath$,SKey.s,"")
Cout = CountSubKeys(HKey.q, SKey.s,WOW64)
For i = 0 To Cout - 1
If Cout <> 0
KeyName$ = ListSubKey(HKey.q, SKey.s,i,WOW64)
If Len(KeyName$) <> 0
SKey.s = SKey.s+"\"+KeyName$
iResult = FileExport_ADD(SKey.s,ManagedPath$,i,Cout)
If iResult = 1
FileExport_COUT(HKey.q, SKey.s,WOW64,ManagedPath$)
EndIf
EndIf
SKey.s = ReverseString(SKey.s)
iPos = FindString(SKey.s,"\",1)
SKey.s = Mid(SKey.s,iPOs+1,Len(SKey.s))
SKey.s = ReverseString(SKey.s)
EndIf
Next
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure FileExport_PREP(File$,ManagedKeyPath$,WOW64,RegistryFile$)
Protected cout
ConvertRegKey2TopAndKeyName(ManagedKeyPath$)
SelectElement(RegConverted(),0): HKey.q = Regconverted()\TopKey.q
SelectElement(RegConverted(),1): LKey.s = Regconverted()\Keyname$
FreeList(RegConverted())
FileExport_CRLF(RegistryFile$)
FileExport_SECT(RegistryFile$,"["+ManagedKeyPath$+"]")
cout = CountSubValues(HKey.q, LKey.s,WOW64)
If cout <> 0
For i = 0 To Cout - 1
KeyName$ = ListSubValue(HKey.q, LKey.s, i, WOW64)
KeyData$ = ReadValue(HKey.q, LKey.s, KeyName$, WOW64,0,1)
If (Len(KeyName$) <> 0) And (Len(KeyData$) <> 0)
KeyName$ = Chr(34)+KeyName$+Chr(34)
iPos = FindString(KeyData$,"dword:",1)
If iPos = 0
KeyData$ = Chr(34)+KeyData$+Chr(34)
KeyData$ = ReplaceString(KeyData$,"\","\\",1)
Else
KeyData$ = KeyData$
EndIf
Else
If (Len(KeyName$) = 0) And (Len(KeyData$) <> 0)
KeyName$ = "@"
KeyData$ = Chr(34)+KeyData$+Chr(34)
Else
If (Len(KeyName$) = 0) And (Len(KeyData$) = 0)
KeyName$ = "@"
KeyData$ = Chr(34)+""+Chr(34)
EndIf
EndIf
EndIf
FileExport_SECT(RegistryFile$,KeyName$+"="+KeyData$)
Next
EndIf
EndProcedure
;//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
;
Procedure FileExport(RegistryFile$,ManagedKeyPath$,WOW64=#False)
Protected iSubKeys.i, HKey.q, SKey.s, KeyName$
If OpenFile(#LH_REGISTRYFILE,RegistryFile$)
WriteStringN(#LH_REGISTRYFILE, "Windows Registry Editor Version 5.00",#PB_UTF8)
CloseFile(#LH_REGISTRYFILE)
EndIf
ConvertRegKey2TopAndKeyName(ManagedKeyPath$)
SelectElement(RegConverted(),0): HKey.q = Regconverted()\TopKey.q
SelectElement(RegConverted(),1): SKey.s = Regconverted()\Keyname$
FreeList(RegConverted())
FileExport_PREP(File$,ManagedKeyPath$,WOW64,RegistryFile$)
FileExport_COUT(HKey.q, SKey.s,WOW64,ManagedKeyPath$)
ResetList(FullKeyPath())
While NextElement(FullKeyPath())
FileExport_PREP(File$,FullKeyPath()\KeyFullPath,WOW64,RegistryFile$)
Wend
FileExport_CRLF(RegistryFile$)
EndProcedure
EndModule
;/////////////////////////////////////////////////////////////////////////////////////////
; Commands
;
; RegEditEX::ReadType(HighKey.i,LowKey$, ValueName.s, WOW64 = #False/#True)
; RegeditEX::ReadValue(HighKey.i,LowKey$,ValueName.s, WOW64 = #False/#True,0,0)
;
; RegEditEX::WriteValue(HighKey.i,LowKey$, ValueName.s,Value.s,Type.l,WOW64 = #False/#True)
; RegEditEX::CreateSubKey(HighKey.i,LowKey$)
;
; RegEditEX::DeleteTree(HighKey.i,LowKey$, WOW64 = #False/#True)
; RegEditEX::DeleteKey(HighKey.i,LowKey$, WOW64 = #False/#True)
; RegEditEX::DeleteValue(HighKey.i,LowKey$, ValueName.s, WOW64 = #False/#True)
;
; RegEditEX::CountSubKeys(HighKey.i,LowKey$, WOW64 = #False/#True)
; RegEditEX::CountSubValues(HighKey.i,LowKey$, WOW64 = #False/#True)
;
; RegEditEX::ListSubKey(HighKey, LowKey$.s, index, WOW64 = #False/#True)
; RegEditEX::ListSubValue(HighKey, LowKey$.s, index, WOW64 = #False/#True)
;
; RegEditEX::FileImport(RegistryFile$, WOW64 = #False/False)
; RegEditEX::FileExport(RegistryFile$, ManagedKeyPath$,WOW64 = #False/False)
;
; Die Hive Redirection läuft voll Automatisch. Sobald sich DAS programm auf einem 32Bit Basierten System befindet
; hat der WOW64 = #False/#True Redirection Wert keine Bedeutung mehr und alle Keys werden normal IN dem 32Bit Baum
; bearbeitet. WOW64 = #False/#True Wert funktioniert NUR auf 64Bit Systemen
;
; Beispiele, Bitte auskommentieren , Successfully Testet WindowsXP (32Bit), Windows 7 (64Bit), Windows 8 (32Bit)
MessageRequester("","Key Wird Erstellt (64Bit Hive) :HKEY_LOCAL_MACHINE\Software\Test64Bit")
RegEditEX::CreateSubKey(#HKEY_LOCAL_MACHINE,"Software\Test64Bit",#True)
MessageRequester("",RegEditEX::GetErrorMsg())
MessageRequester("","Key Wird Erstellt (32Bit Hive) :HKEY_LOCAL_MACHINE\Software\Test32Bit")
RegEditEX::CreateSubKey(#HKEY_LOCAL_MACHINE,"Software\Test32Bit")
MessageRequester("",RegEditEX::GetErrorMsg())
MessageRequester("","Überprüfe Key (64Bit Hive) :HKEY_LOCAL_MACHINE\Software\Test64Bit")
RegEditEX::SubKeyExists(#HKEY_LOCAL_MACHINE, "Software\Test64Bit",#True)
MessageRequester("",RegEditEX::GetErrorMsg())
MessageRequester("","Überprüfe Key (32Bit Hive) :HKEY_LOCAL_MACHINE\Software\Test64Bit (Fehler unter 64Bit muss erscheinen)")
RegEditEX::SubKeyExists(#HKEY_LOCAL_MACHINE, "Software\Test64Bit")
MessageRequester("",RegEditEX::GetErrorMsg())
MessageRequester("","Lösche Key (64Bit Hive) :HKEY_LOCAL_MACHINE\Software\Test64Bit")
RegEditEX::DeleteKey(#HKEY_LOCAL_MACHINE, "Software\Test64Bit",#True)
MessageRequester("",RegEditEX::GetErrorMsg())
MessageRequester("","Lösche Key (32Bit Hive) :HKEY_LOCAL_MACHINE\Software\Test32Bit")
RegEditEX::DeleteKey(#HKEY_LOCAL_MACHINE, "Software\Test32Bit")
MessageRequester("",RegEditEX::GetErrorMsg())
MessageRequester("","LIste und Zähle Keys auf (32Bit Hive) DisplayName/DisplayVersion"+#CRLF$+sSubKey$ )
sSubKey$ = "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\"
iView$ = ""
count = RegEditEX::CountSubKeys(#HKEY_LOCAL_MACHINE, sSubKey$)
For i = 0 To count - 1
Ordner$ = RegEditEX::ListSubKey(#HKEY_LOCAL_MACHINE, sSubKey$, i)
DisplayName$ = RegEditEX::ReadValue(#HKEY_LOCAL_MACHINE,sSubKey$+Ordner$+"\","DisplayName")
DisplayVers$ = RegEditEX::ReadValue(#HKEY_LOCAL_MACHINE,sSubKey$+Ordner$+"\","DisplayVersion")
If (Len(DisplayName$) <> 0) And (Len(DisplayVers$) <> 0)
iView$ = iView$+Str(i)+"/"+Str(count)+" ["+DisplayName$+" ; "+DisplayVers$+"]"+#CRLF$
;Debug Str(i)+"/"+Str(count)+" ["+DisplayName$+" ; "+DisplayVers$+"]"
EndIf
Next
MessageRequester("",iView$)
MessageRequester("","Exportiere 'HKEY_LOCAL_MACHINE\SOFTWARE\Adobe' Nach C:\Adobe.Reg vom 32Bit Hive")
RegEditEX::FileExport("C:\AdobeExport.reg","HKEY_LOCAL_MACHINE\SOFTWARE\Adobe")
MessageRequester("", "Import aus Spass C:\AdobeExport.reg nach 'HKEY_LOCAL_MACHINE\SOFTWARE\Adobe' in den 64Bit Hive")
RegEditEX::FileImport("C:\AdobeExport.reg")
MessageRequester("","Löche den Baum 'HKEY_LOCAL_MACHINE\SOFTWARE\Adobe' (64Bit Hive)")
RegEditEX::DeleteTree(#HKEY_LOCAL_MACHINE,"SOFTWARE\Adobe")
If RegEditEX::GetErrorCode() = 2
RegEditEX::DeleteKey(#HKEY_LOCAL_MACHINE, "SOFTWARE\Adobe",#True)
EndIf
MessageRequester("",RegEditEX::GetErrorMsg())
Re: Registry Module (windows only)
Hi,
I am very new to PB, still evaluating the demo version, and would like to try accessing the registry. I tried to use this library ( Registry.pbi by ts-soft) and the example but keep getting errors like:
RegOpenKeyEx_ is not a function (or not available in the demo version) array, list, map or macro. Is it a case of "not available in the demo version" or is there something else I am missing?
I am very new to PB, still evaluating the demo version, and would like to try accessing the registry. I tried to use this library ( Registry.pbi by ts-soft) and the example but keep getting errors like:
RegOpenKeyEx_ is not a function (or not available in the demo version) array, list, map or macro. Is it a case of "not available in the demo version" or is there something else I am missing?
- Kwai chang caine
- Always Here
- Posts: 5353
- Joined: Sun Nov 05, 2006 11:42 pm
- Location: Lyon - France
Re: Registry Module (windows only)
Hello
With demo version you can't use API
In PB an API terminate always by an underscore like this :
RegCreateKeyEx_()
With demo version you can't use API
In PB an API terminate always by an underscore like this :
RegCreateKeyEx_()
The happiness is a road...
Not a destination
Not a destination
Re: Registry Module (windows only)
Hi Kwai Chang Caine,
Thank you, I was afraid it might be that. Other than this issue I have found PB to be quite easy to use.
Thank you, I was afraid it might be that. Other than this issue I have found PB to be quite easy to use.
Re: Registry Module (windows only)
Update for some API, to use the new PB5.40
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Re: Registry Module (windows only)
Hi,
maybe I'm a bit to stupid, but...
I needed to check if a key is available.
I found nothing which does this so I implemented:
Or is there an other way?
Bernd
maybe I'm a bit to stupid, but...
I needed to check if a key is available.
I found nothing which does this so I implemented:
Code: Select all
Procedure.i IsKey(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
Protected error, samDesired = #KEY_READ, hKey
OpenKey()
RegCloseKey_(hKey)
ProcedureReturn #True
EndProcedure
Bernd
- Kwai chang caine
- Always Here
- Posts: 5353
- Joined: Sun Nov 05, 2006 11:42 pm
- Location: Lyon - France
Re: Registry Module (windows only)
Hello at all
I try to change a binary value with the splendid code of TsSoft without succes
I have search but not found numerous example about this function
When i run this lineI have this result
Someone can help me to use the write valueHave a good day
I try to change a binary value with the splendid code of TsSoft without succes
I have search but not found numerous example about this function
When i run this line
Code: Select all
Debug ReadValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer", "ShellState")
and i whant replacing the "$24,$00,$00,$00,$33" by "$24,$00,$00,$00,$37"$24,$00,$00,$00,$33,$A8,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$01,$00,$00,$00,$12,$00,$00,$00,$00,$00,$00,$00,$22,$00,$00,$00
Someone can help me to use the write value
Code: Select all
WriteValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer", "ShellState", Valeur$ , #REG_BINARY)
The happiness is a road...
Not a destination
Not a destination
Re: Registry Module (windows only)
You are using string parameter, but the first post says:
ts-soft wrote:Supports for Read and Write:
#REG_BINARY (requires the *Ret.RegValue parameter)
- Kwai chang caine
- Always Here
- Posts: 5353
- Joined: Sun Nov 05, 2006 11:42 pm
- Location: Lyon - France
Re: Registry Module (windows only)
Hello FRYQUEZ
In fact i don't understand how use this function
How sending binary
i have found this code of WOLF, but he using DATA, and i prefer using variable
So i have tried this, but obviously that not works
In fact i don't understand how use this function
How sending binary
i have found this code of WOLF, but he using DATA, and i prefer using variable
Code: Select all
DataSection
regbin_data:
Data.b 0,1,2,3,4,5,6,7,8,9,128,255 ;byte in decimal !
end_regbin_data:
EndDataSection
openkey = #HKEY_LOCAL_MACHINE
subkey.s = "SOFTWARE"
keyset.s = "test"
hkey.l = 0
RegCreateKey_(OpenKey,SubKey,@hKey)
RegSetValueEx_(hKey,keyset,0,#REG_BINARY,?regbin_data,?end_regbin_data - ?regbin_data)
RegCloseKey_(hKey)
Code: Select all
UseModule Registry
SentenceHex$ = "24,00,00,00,37,A8,00,00,00,00,00,00,00,00,00,00,00,00,00,00,01,00,00,00,12,00,00,00,00,00,00,00,22,00,00,00"
Size = CountString(SentenceHex$, ",") + 1
*PtrMem = AllocateMemory(Size)
Offset = 0
For i = 1 To Size
Hex$ = StringField(SentenceHex$, i, ",")
Bin = Hex2Dec(Hex$)
PokeB(*PtrMem + Offset, Bin)
Offset + 1
Next
If WriteValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\", "ShellState", "", #REG_BINARY, #False, *PtrMem)
Debug ReadValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\", "ShellState")
EndIf
The happiness is a road...
Not a destination
Not a destination
Re: Registry Module (windows only)
Hi KCC,
how about this?
BTW: be careful with "ShellState", it stores settings in bits. So changing 1 byte can effect more than one setting.
how about this?
Code: Select all
UseModule Registry
RegValue.RegValue
RegValue\TYPE = #REG_BINARY
ReadValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\", "ShellState", 0, RegValue)
If RegValue\SIZE >= 5
;change the bytes you want
PokeB(RegValue\BINARY + 4, $37)
If WriteValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\", "ShellState", Valeur$, #REG_BINARY, #False, RegValue)
Debug ReadValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\", "ShellState")
EndIf
EndIf
ClearStructure(RegValue, RegValue)
Last edited by fryquez on Tue Apr 19, 2016 5:03 pm, edited 1 time in total.
- Kwai chang caine
- Always Here
- Posts: 5353
- Joined: Sun Nov 05, 2006 11:42 pm
- Location: Lyon - France
Re: Registry Module (windows only)
Waaaaaoouuuh !!!
Exactely what i search, since a long time
Thanks a lot for your precious first help to the worst programing man in the world (perhaps even the universe)
Have a very good day FRYQUEZ
Exactely what i search, since a long time
Thanks a lot for your precious first help to the worst programing man in the world (perhaps even the universe)
Have a very good day FRYQUEZ
The happiness is a road...
Not a destination
Not a destination
Re: Registry Module (windows only)
Another solution I wrote some time ago: http://purebasic.fr/english/viewtopic.php?f=12&t=43994