PureBasic Forums - English

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")