Registry procedures

Windows specific forum
Rinzwind
Enthusiast
Enthusiast
Posts: 636
Joined: Wed Mar 11, 2009 4:06 pm
Location: NL

Registry procedures

Post by Rinzwind »

Probably useful to some Windows devs. Based on works and posts of others and I think improved.

Code: Select all

EnableExplicit
#CHAR_SIZE = SizeOf(Character)
#KEY_WOW64_64KEY = $0100
#KEY_WOW64_32KEY = $0200

Procedure.s ExpandString(iString.s)
  ; Expands environment variables in string
  Protected r.s, size.i
  
  size = ExpandEnvironmentStrings_(iString, 0, 0)
  r = Space(size)
  ExpandEnvironmentStrings_(iString, @r, size)
  ProcedureReturn r
EndProcedure

Procedure.i RegRoot(iKey.s)
  ; Returns the root integer value
  ; HKCR, CKCC, HKLM, HKU, HKCC
  Protected pos.i, temp.s, r.i
  
  pos = FindString(iKey, "\")
  If Not pos
    ProcedureReturn
  EndIf
  temp = LCase(Left(iKey, pos - 1))
  Select temp
    Case "hkcr", "hkey_classes_root"
      r = #HKEY_CLASSES_ROOT
    Case "hkcu", "hkey_current_user"
      r = #HKEY_CURRENT_USER
    Case "hklm", "hkey_local_machine"
      r = #HKEY_LOCAL_MACHINE
    Case "hku", "hkey_users"
      r = #HKEY_USERS
    Case "hkcc", "hkey_current_config"
      r = #HKEY_CURRENT_CONFIG
    Default
      ProcedureReturn r
  EndSelect
  ProcedureReturn r
EndProcedure

Procedure.s RegSub(iKey.s)
  ; Returns sub key
  Protected r.s, pos.i
  
  pos = FindString(iKey, "\")
  If Not pos
    ProcedureReturn
  EndIf
  r = Mid(iKey, pos + 1)
  ProcedureReturn r
EndProcedure

Procedure RegWrite(iKey.s, iName.s, iValue.s, iType.i, iForceBit = 0)
  ; Sets registry item to value
  ; iForceBit: 32 or 64 returns 32 or 64 bit registry on a 64 bit system
  Protected h.i, rootKey.i, subKey.s, v.i, datSize.i, *dat, hex.s, oct.i, i.i
  Protected *src, c.c, pos.i
  
  rootKey = RegRoot(iKey)
  subKey = RegSub(iKey)
  If iForceBit = 32
    iForceBit = #KEY_WOW64_32KEY
  ElseIf iForceBit = 64
    iForceBit = #KEY_WOW64_64KEY
  EndIf
  If RegCreateKeyEx_(rootKey, subKey, 0, 0, 0, #KEY_WRITE | iForceBit, 0, @h, 0) = #ERROR_SUCCESS
  ;If RegOpenKeyEx_(rootKey, subKey, 0, #KEY_WRITE | iForceBit, @h) = #ERROR_SUCCESS
    Select iType
      Case #REG_SZ, #REG_EXPAND_SZ
        RegSetValueEx_(h, iName, 0, iType, @iValue, StringByteLength(iValue))
      Case #REG_DWORD
        v = Val(iValue)
        RegSetValueEx_(h, iName, 0, iType, @v, 4)
      Case #REG_QWORD
        v = Val(iValue)
        RegSetValueEx_(h, iName, 0, iType, @v, 8)        
      Case #REG_BINARY
        datSize = Len(iValue) / 2
        *dat = AllocateMemory(datSize)
        For i = 0 To datSize - 1
          hex = "$" + Mid(iValue, (i * 2) + 1, 2)
          oct = Val(hex)
          PokeB(*dat + i, oct)
        Next
        RegSetValueEx_(h, iName, 0, iType, *dat, datSize)
        FreeMemory(*dat)
      Case #REG_MULTI_SZ
        datSize = StringByteLength(iValue) + #CHAR_SIZE
        *dat = AllocateMemory(datSize)
        *src = @iValue
        For i = 0 To (datSize - #CHAR_SIZE) Step #CHAR_SIZE
          c = PeekC(*src + i)
          If c <> #LF
            If c = #CR
              PokeC(*dat + pos, 0)
            Else
              PokeC(*dat + pos, c)  
            EndIf
            pos + #CHAR_SIZE
          EndIf 
        Next
        PokeC(*dat + pos, 0)
        RegSetValueEx_(h, iName, 0, iType, *dat, pos)
        FreeMemory(*dat)
    EndSelect
    RegCloseKey_(h)
  EndIf
EndProcedure

Procedure.s RegRead(iKey.s, iValue.s, iForceBit = 0)
  ; Returns registry value
  Protected h.i, rootKey.i, subkey.s, type.i, *dat, datSize.i
  Protected temp.s, pos.i, size.i, i.i, b.i, c.c, r.s = ""
  
  rootKey = RegRoot(iKey)
  subKey = RegSub(iKey)
  If iForceBit = 32
    iForceBit = #KEY_WOW64_32KEY
  ElseIf iForceBit = 64
    iForceBit = #KEY_WOW64_64KEY
  EndIf
  If RegOpenKeyEx_(rootKey, subKey, 0, #KEY_READ | iForceBit, @h) = #ERROR_SUCCESS
    If RegQueryValueEx_(h, iValue, 0, @type, 0, @datSize) = #ERROR_SUCCESS
      ;Debug datSize
      If datSize = 0
        ProcedureReturn r
      EndIf
      *dat = AllocateMemory(datSize)
      RegQueryValueEx_(h, iValue, 0, @type, *dat, @datSize)
      Select type
        Case #REG_SZ
          r = PeekS(*dat)
          ;Debug StringByteLength(r) + #CHAR_SIZE
        Case #REG_EXPAND_SZ
          r = PeekS(*dat)
          r = ExpandString(r)
        Case #REG_DWORD
          r = Str(PeekL(*dat))
        Case #REG_QWORD
          r = Str(PeekQ(*dat))
        Case #REG_BINARY
          For i = 0 To datSize - 1
            b = PeekB(*dat + i) & $FF ;make unsigned
            r + RSet(Hex(b), 2, "0")
          Next
        Case #REG_MULTI_SZ
          ;charLength = (datSize - #CHAR_SIZE) / #CHAR_SIZE
          pos = 0
          For i = 0 To (datSize - #CHAR_SIZE) Step #CHAR_SIZE
            c = PeekC(*dat + i)
            If c = 0
              If r <> ""
                r + #CRLF$
              EndIf
              temp = PeekS(*dat + pos, (i - pos))
              r + temp
              pos = i + #CHAR_SIZE
            EndIf
          Next          
      EndSelect
      FreeMemory(*dat)
    EndIf  
    RegCloseKey_(h)
  EndIf
  ProcedureReturn r
EndProcedure

RegWrite("HKCU\Software\Test 1", "", "Default", #REG_SZ)
RegWrite("HKCU\Software\Test 1", "binary", "FFFFFFFF", #REG_BINARY)
RegWrite("HKCU\Software\Test 1", "dword", "111", #REG_DWORD)
RegWrite("HKCU\Software\Test 1", "expstring", "Hello %username%", #REG_EXPAND_SZ)
RegWrite("HKCU\Software\Test 1", "multiregsz", "Line 1 abcd" + #CRLF$ + "Line 2 efgh", #REG_MULTI_SZ)
RegWrite("HKCU\Software\Test 1", "qword", "222", #REG_QWORD)
RegWrite("HKCU\Software\Test 1", "regsz", "Hello there", #REG_SZ)
Debug RegRead("HKCU\Software\Test 1", "")
Debug RegRead("HKCU\Software\Test 1", "binary")
Debug RegRead("HKCU\Software\Test 1", "dword")
Debug RegRead("HKCU\Software\Test 1", "expstring")
Debug RegRead("HKCU\Software\Test 1", "multiregsz")
Debug RegRead("HKCU\Software\Test 1", "qword")
Debug RegRead("HKCU\Software\Test 1", "regsz")
Rinzwind
Enthusiast
Enthusiast
Posts: 636
Joined: Wed Mar 11, 2009 4:06 pm
Location: NL

Re: Registry procedures

Post by Rinzwind »

Small updates applied.
User avatar
dobro
Enthusiast
Enthusiast
Posts: 766
Joined: Sun Oct 31, 2004 10:54 am
Location: France
Contact:

Re: Registry procedures

Post by dobro »

and Erase Key ?? :)
Image
Windows 98/7/10 - PB 5.42
■ sites : http://michel.dobro.free.fr/
Post Reply