It is currently Fri Apr 10, 2020 7:52 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 70 posts ]  Go to page Previous  1, 2, 3, 4, 5  Next
Author Message
 Post subject: Re: Registry Module (windows only)
PostPosted: Thu Apr 21, 2016 12:25 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4662
Location: Lyon - France
Thanks MISTREL 8)
Can be useful too, we never know :?
Because for KCC, the REGISTRY of window is like a a dictionnary for a baby :mrgreen:

After have tale the locky malware or one of his brother :?
For restore quickly all the personal preferences of my window in one clic (or nearly), i try to modify, numerous keys of the registry on several machine under several different windows versions, i'm a little bit affraid to the see the final result :lol:

Have a good day :wink:

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Mon May 02, 2016 2:51 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4662
Location: Lyon - France
Hello at all
I search now to rename a key, apparently TsSoft and Mistrel have not thinking to do this function
Someone know how do this ?

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Mon May 02, 2016 3:40 pm 
Offline
Always Here
Always Here
User avatar

Joined: Thu Jun 24, 2004 2:44 pm
Posts: 5755
Location: Berlin - Germany
Create Key and Delete Key!

_________________
PureBasic 5.71 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 19.3 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Mon May 02, 2016 8:32 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4662
Location: Lyon - France
Thanks a lot TsSoft for your answer
And again all my congratulation, for your splendid work 8)

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Thu May 12, 2016 10:40 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Mon Sep 20, 2004 7:12 am
Posts: 545
Location: Hell
This was a nasty one, I searched quite a while for an IAE to finally find out, that ExpandEnvironmentStrings() never can work. because it is no function of Advapi32.dll but kernel32.dll!

And there is a second error in this function:
The return value is in CHARACTERS not bytes ;)

_________________
Link dead?
Change h3x0r.ath.cx into hex0rs.coderbu.de and all will be fine.


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Fri May 27, 2016 12:27 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Mon Sep 20, 2004 7:12 am
Posts: 545
Location: Hell
O.k., it seems as if ts-soft has overseen my post above.
I've fixed the ExpandEnvironmentStrings() and added a CopyTree() procedure (only >= Win Vista! I was too lazy to support XP also).

Code:
;======================================================================
; Module:          Registry.pbi
;
; Author:          Thomas (ts-soft) Schulz
; Date:            May 27, 2016
; Version:         1.5.1
; Target Compiler: PureBasic 5.2+
; Target OS:       Windows
; License:         Free, unrestricted, no warranty whatsoever
;                  Use at your own risk
;======================================================================

; History:
; Version 1.5.1, May 27, 2016
; fixed ExpandEnvironmentStrings()
; + CopyTree()

; History:
; Version 1.5.0, Sep 04, 2015
; fixed for Use with PB5.40 and higher

; 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 Registry
   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

   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)
   ; result "" = error

   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 DeleteTree(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
   ; Deletes the subkeys and values of the specified key recursively.
   ; result 0 = error

   Declare.i DeleteKey(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
   ; result 0 = error

   Declare.i DeleteValue(topKey, KeyName.s, ValueName.s, WOW64 = #False, *Ret.RegValue = 0)
   ; result 0 = error

   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 CopyTree(topKeySource, KeyNameSource.s, topKeyDestination, KeyNameDestination.s, WOW64 = #False, *Ret.RegValue = 0)

EndDeclareModule

Module Registry
   EnableExplicit

   Prototype RegDeleteKey(hKey.i, lpSubKey.p-Unicode, samDesired.l, Reserved.l = 0)
   Prototype RegSetValue(hKey.i, lpValueName.p-Unicode, Reserved.l, dwType.l, *lpData, cbData.l)
   Prototype RegDeleteTree(hKey.i, lpSubKey.p-Unicode = 0)
   Prototype RegEnumKeyEx(hKey.i, dwIndex.l, *lpName, *lpcName, *lpReserved, *lpClass, *lpcClass, *lpftLastWriteTime)
   Prototype RegCopyTree(hKeySrc.i, *lpSubKey, hKeyDest.i)

   Global RegDeleteKey.RegDeleteKey
   Global RegSetValue.RegSetValue
   Global RegDeleteTree.RegDeleteTree
   Global RegEnumKeyEx.RegEnumKeyEx
   Global RegCopyTree.RegCopyTree

   Define dll.i

   dll = OpenLibrary(#PB_Any, "Advapi32.dll")
   If dll
      
      RegDeleteKey             = GetFunction(dll, "RegDeleteKeyExW")
      RegSetValue              = GetFunction(dll, "RegSetValueExW")
      RegDeleteTree            = GetFunction(dll, "RegDeleteTreeW")
      RegEnumKeyEx             = GetFunction(dll, "RegEnumKeyExW")
      RegCopyTree              = GetFunction(dll, "RegCopyTreeW")


   EndIf
   
   #KEY_WOW64_64KEY = $100
   #KEY_WOW64_32KEY = $200

   Macro OpenKey()
      If WOW64
         CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
         samDesired | #KEY_WOW64_64KEY
         CompilerElse
         samDesired | #KEY_WOW64_32KEY
         CompilerEndIf
      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
         Debug GetLastErrorStr(error)
         If hKey
            RegCloseKey_(hKey)
         EndIf
         ProcedureReturn #False
      EndIf
   EndMacro

   Macro OpenKeyS()
      If WOW64
         CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
         samDesired | #KEY_WOW64_64KEY
         CompilerElse
         samDesired | #KEY_WOW64_32KEY
         CompilerEndIf
      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
         Debug GetLastErrorStr(error)
         If hKey
            RegCloseKey_(hKey)
         EndIf
         ProcedureReturn ""
      EndIf
   EndMacro

   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)

         ProcedureReturn result
      EndIf
   EndProcedure

   Procedure.i XP_DeleteTree(topKey, KeyName.s, *Ret.RegValue = 0)
      Protected hKey, error, dwSize.l, sBuf.s = Space(260)

      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
         Debug 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)
         EndIf
      Until error
      RegCloseKey_(hKey)
      error = RegDeleteKey_(topKey, KeyName)
      If error
         If *Ret <> 0
            *Ret\ERROR    = error
            *Ret\ERRORSTR = GetLastErrorStr(error)
         EndIf
         Debug GetLastErrorStr(error)
         ProcedureReturn #False
      EndIf

      ProcedureReturn #True
   EndProcedure

   Procedure.i DeleteTree(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
      Protected error, samDesired = #KEY_ALL_ACCESS
      Protected hKey

      If RegDeleteTree = 0
         ProcedureReturn XP_DeleteTree(topKey, KeyName, *Ret)
      EndIf

      OpenKey()

      error = RegDeleteTree(hKey)
      RegCloseKey_(hKey)
      If error
         If *Ret <> 0
            *Ret\ERROR    = error
            *Ret\ERRORSTR = GetLastErrorStr(error)
         EndIf
         Debug GetLastErrorStr(error)
         ProcedureReturn #False
      EndIf
      ProcedureReturn #True
   EndProcedure
   
   Procedure.i CopyTree(topKeySource, KeyNameSource.s, topKeyDestination, KeyNameDestination.s, WOW64 = #False, *Ret.RegValue = 0)
      Protected error, samDesired, create
      Protected hKey, hKeyD, topKey, KeyName.s

      If OSVersion() < #PB_OS_Windows_Vista
         ProcedureReturn #False
      EndIf
      
      topKey     = topKeySource
      KeyName    = KeyNameSource
      samDesired = #KEY_READ
      
      OpenKey()
      
      If hKey
       
         error = RegCreateKeyEx_(topKeyDestination, KeyNameDestination, 0, #Null$, 0, #KEY_ALL_ACCESS, 0, @hKeyD, @create)
       
        If hKeyD
           error = RegCopyTree(hKey, #Null, hKeyD)
           RegCloseKey_(hKeyD)
        EndIf
       
        RegCloseKey_(hKey)
      EndIf
      
      If error
         If *Ret <> 0
            *Ret\ERROR    = error
            *Ret\ERRORSTR = GetLastErrorStr(error)
         EndIf
         Debug GetLastErrorStr(error)
         ProcedureReturn #False
      EndIf

      ProcedureReturn #True
   EndProcedure
      
      

   Procedure.i DeleteKey(topKey, KeyName.s, WOW64 = #False, *Ret.RegValue = 0)
      Protected error, samDesired = #KEY_WRITE

      If WOW64
         CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
         samDesired | #KEY_WOW64_64KEY
         CompilerElse
         samDesired | #KEY_WOW64_32KEY
         CompilerEndIf
      EndIf

      If Left(KeyName, 1) = "\"  : KeyName = Right(KeyName, Len(KeyName) - 1) : EndIf
      If Right(KeyName, 1) = "\" : KeyName = Left(KeyName, Len(KeyName) - 1)  : EndIf

      If RegDeleteKey
         error = RegDeleteKey(topKey, KeyName, samDesired)
      Else
         error = RegDeleteKey_(topKey, KeyName)
      EndIf
      If error
         If *Ret <> 0
            ClearStructure(*Ret, RegValue)
            *Ret\ERROR    = error
            *Ret\ERRORSTR = GetLastErrorStr(error)
         EndIf
         Debug GetLastErrorStr(error)
         ProcedureReturn #False
      EndIf
      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
         Debug GetLastErrorStr(error)
         ProcedureReturn #False
      EndIf
      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
         Debug GetLastErrorStr(error)
         ProcedureReturn #False
      EndIf
      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
         Debug 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
         Debug GetLastErrorStr(error)
         ProcedureReturn ""
      EndIf
      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
         Debug GetLastErrorStr(error)
         ProcedureReturn #False
      EndIf
      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
         Debug 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
         Debug GetLastErrorStr(error)
         ProcedureReturn ""
      EndIf
      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
         Debug GetLastErrorStr(error)
         ProcedureReturn #False
      EndIf
      ProcedureReturn lpType
   EndProcedure

   Procedure.s ReadValue(topKey, KeyName.s, ValueName.s = "", WOW64 = #False, *Ret.RegValue = 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
         Debug 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
            Debug "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
         Debug 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
            result = Str(PeekL(*lpData))

         Case #REG_EXPAND_SZ
            ExSZlength = ExpandEnvironmentStrings_(*lpData, 0, 0)
            If ExSZlength > 0
               ExSZlength + 1
               CompilerIf #PB_Compiler_Unicode
                  ExSZlength * 2
               CompilerEndIf
               *ExSZMem = AllocateMemory(ExSZlength)
               If *ExSZMem
                  If ExpandEnvironmentStrings_(*lpData, *ExSZMem, ExSZlength)
                     result = PeekS(*ExSZMem, ExSZlength)
                     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
            result = PeekS(*lpData)
            If *Ret <> 0
               *Ret\STRING = result
               *Ret\SIZE   = Len(result)
            EndIf
      EndSelect

      FreeMemory(*lpData)

      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

      If WOW64
         CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
         samDesired | #KEY_WOW64_64KEY
         CompilerElse
         samDesired | #KEY_WOW64_32KEY
         CompilerEndIf
      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
         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, #Null$, 0, samDesired, 0, @hKey, @create)
      If error
         If *Ret <> 0
            *Ret\ERROR    = error
            *Ret\ERRORSTR = GetLastErrorStr(error)
         EndIf
         Debug 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
               Debug "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
               Debug "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 = RegSetValue(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
                  Debug "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
         Debug GetLastErrorStr(error)
         ProcedureReturn #False
      EndIf

      ProcedureReturn create
   EndProcedure

EndModule

CompilerIf #PB_Compiler_IsMainFile
EnableExplicit

Define count, i

count = Registry::CountSubValues(#HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices")
For i = 0 To count - 1
   Debug Registry::ListSubValue(#HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", i)
Next

Debug "-----------------------"

UseModule Registry

Define.s Multi_SZ_Str = "ts-soft" + #LF$ + "Software-Development" + #LF$ + #LF$ + "Copyright 2013" + #LF$ + "Programmed in PureBasic"

If  WriteValue(#HKEY_CURRENT_USER, "Software\ts-soft", "demo", Multi_SZ_Str, #REG_MULTI_SZ)
   Debug ReadValue(#HKEY_CURRENT_USER, "Software\ts-soft", "demo")
   Select MessageRequester("Registry-Example", "Delete the demo Registry-Value?", #PB_MessageRequester_YesNo)
      Case #PB_MessageRequester_Yes
         If DeleteValue(#HKEY_CURRENT_USER, "Software\ts-soft", "demo")
            Debug "Value deleted"
         Else
            Debug "Value not deleted"
         EndIf
   EndSelect
EndIf
CompilerEndIf

_________________
Link dead?
Change h3x0r.ath.cx into hex0rs.coderbu.de and all will be fine.


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Fri May 27, 2016 10:07 pm 
Offline
Always Here
Always Here
User avatar

Joined: Thu Jun 24, 2004 2:44 pm
Posts: 5755
Location: Berlin - Germany
HeX0R wrote:
O.k., it seems as if ts-soft has overseen my post above.


Sorry, i barely have time at the moment and use most of the time Linux.

Thx for the upgrade!

_________________
PureBasic 5.71 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 19.3 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Wed Jun 01, 2016 2:30 pm 
Offline
Enthusiast
Enthusiast

Joined: Tue Oct 14, 2014 12:09 pm
Posts: 286
HI Ts-Soft,
It seems i have problem to read HKEY LOCAL MACHINE key with Windows 10 and this programm. Have you information about that's
The value was not found with for example
Code:
Debug ReadValue(#HKEY_LOCAL_MACHINE, "software\OEM\ADC\CustomizationKeys", "")

Thanks in advance


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Wed Jun 01, 2016 4:46 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Wed Feb 01, 2012 3:30 pm
Posts: 764
Location: Nottinghamshire UK
Hi loulou2522 Use regedit it`s there in Win10
Zebuddi. :)
Code:
      
Debug ReadValue(#HKEY_LOCAL_MACHINE, "SOFTWARE\OEM\ADC\CustomizationKeys\CarrierId\Keys", "carrierId")

_________________
malleo, caput, bang. Ego, comprehendunt in tempore


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Thu Aug 11, 2016 4:37 am 
Offline
New User
New User

Joined: Thu Aug 11, 2016 4:00 am
Posts: 3
Hello at all
I'm trying to get a list of installed programs, with some parameters.
Code:
IncludeFile "Registry.pbi"
UseModule Registry
Define count, i
count = Registry::CountSubKeys(#HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall", #True)
  For i = 0 To count - 1
    Subkey$= Registry::ListSubKey(#HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall", i, #True)
    ProgName$=Registry::ReadValue(#HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"+"\"+Subkey$, "DisplayName",#True)
   If ProgName$
      ProgVersion$=Registry::ReadValue(#HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"+"\"+Subkey$, "DisplayVersion",#True)
      UninstallString$=Registry::ReadValue(#HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall"+"\"+Subkey$, "UninstallString",#True)
      Debug "ProgName$="+ ProgName$ + " ProgVersion$=" + ProgVersion$ + " UninstallString$=" + UninstallString$
   EndIf   
  Next


All 64 bit systems when trying to get the parameter UninstallString program crashes on the line
ExSZlength = ExpandEnvironmentStrings (* lpData, 0, 0)
with error
Invalid memory access. (Read error at address 0)
Can anyone help me?


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Thu Aug 11, 2016 4:44 am 
Offline
Addict
Addict
User avatar

Joined: Thu Jun 04, 2015 7:10 am
Posts: 1672
try "Debug *lpData" just before that call, as im guessing *lpData is 0 (null ptr), so you'll need to do a *lpData = @mylongvariable.l

_________________
Thankyou to all the coders who generously helped & encouraged me in the nearly 2yrs when i was welcome here,
it was a tremendous privilege. I learned a lot. I wish you and your families all the best and success for the future.


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Thu Aug 11, 2016 6:13 am 
Offline
New User
New User

Joined: Thu Aug 11, 2016 4:00 am
Posts: 3
Thank you, Keya. Unfortunately I have very little programming in PureBasic, so I do not quite understand your advice. Can in more detail?
The code snippet in error
Code:
      Case #REG_EXPAND_SZ
        Debug *lpData ; I get number value
        ExSZlength = ExpandEnvironmentStrings(*lpData, 0, 0) ; <-Error  - Invalid memory access. (Read error at address 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



Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Thu Aug 11, 2016 8:41 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Mon Sep 20, 2004 7:12 am
Posts: 545
Location: Hell
You saw my post here and the following fixed version?

_________________
Link dead?
Change h3x0r.ath.cx into hex0rs.coderbu.de and all will be fine.


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Sat Aug 13, 2016 5:50 am 
Offline
New User
New User

Joined: Thu Aug 11, 2016 4:00 am
Posts: 3
Thank you very much, HeX0R!
I have replaced the old Code(1.50) with this module (1.51)
Error fixed


Top
 Profile  
Reply with quote  
 Post subject: Re: Registry Module (windows only)
PostPosted: Sat Jan 14, 2017 12:47 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Thu Nov 26, 2015 6:52 pm
Posts: 174
Location: Italy
I've added the Registry Module to my PureBASIC Archives repo on GitHub:

https://github.com/tajmone/purebasic-archives

I've split the example from the module source, to make it standalone.

If anyone improved (or will improve) to the original source, please share it on the repo and help me keep an updated version of the module.

_________________
The PureBASIC Archives:
FOSS Resources:


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 70 posts ]  Go to page Previous  1, 2, 3, 4, 5  Next

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 9 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye