Page 1 of 1

PBOSL_Registry,testing version

Posted: Tue Nov 14, 2006 11:04 pm
by ts-soft
This is a testing version for PBOSL

With SubSystems all Functions also in Unicode and Threadsafe available

Please test the Lib and give me Error-Reports and tell me missing Functions!


All Functions that give a 0 or "" as result, you should check with the ErrorFunctions!
This is a testing version for PBOSL

With SubSystems all Functions also in Unicode and Threadsafe available

Please test the Lib and give me Error-Reports and tell me missing Functions!

All Functions that give a 0 or "" as result, you should check with the ErrorFunctions!

Functions:

Error:
Result.s = Reg_GetErrorMsg()
Result.l = Reg_GetErrorNr()

Generic:
Result.l = Reg_GetValueTyp(topKey.l, KeyName.s, ValueName.s); returns Registry Value Type
Result.s = Reg_ListSubKey(topKey.l, KeyName.s, Index.l); returns a list of key from a selected KeyName
Result.s = Reg_ListSubValue(topKey.l, KeyName.s, Index.l); returns a list of values from a selected KeyName

Delete:
Result.l = Reg_DeleteKey(topKey.l, KeyName.s); deletes a subkey and all its descendants
Result.l = Reg_DeleteEmptyKey(topKey.l, KeyName.s); deletes an empty key
Result.l = Reg_DeleteValue(topKey.l, KeyName.s, ValueName.s); removes a named value from the specified registry key

Read:
Result.l = Reg_ReadBinary(topKey.l, KeyName.s, ValueName.s); returns a MemoryPointer, don't forgot to free the Memory
Result.l = Reg_ReadLong(topKey.l, KeyName.s, ValueName.s); returns a Long from specified ValueName
Result.q = Reg_ReadQuad(topKey.l, KeyName.s, ValueName.s); returns a Quad from specified ValueName
Result.s = Reg_ReadString(topKey.l, KeyName.s, ValueName.s); returns a String from specified ValueName
Result.s = Reg_ReadExpandString(topKey.l, KeyName.s, ValueName.s, Flag.l = 0); returns ExpandString, Flag = 0 unexpanded, Flag = 1 full expanded
Result.s = Reg_ReadMultiLineString(topKey.l, KeyName.s, ValueName.s); returns a StringField, separate with #LF$, from specified ValueName

Write:
Result.l = Reg_WriteBinary(topKey.l, KeyName.s, ValueName.s, MemoryPointer.l, MemorySize.l = #PB_Any); write a MemoryBuffer to specified ValueName
Result.l = Reg_WriteLong(topKey.l, KeyName.s, ValueName.s, Value.l); write a Long to specified ValueName
Result.l = Reg_WriteQuad(topKey.l, KeyName.s, ValueName.s, Value.q); write a Quad to specified ValueName
Result.s = Reg_WriteString(topKey.l, KeyName.s, ValueName.s, Value.s); write a String to specified ValueName
Result.s = Reg_WriteExpandString(topKey.l, KeyName.s, ValueName.s, Value.s); write a ExpandString to specified ValueName
Result.s = Reg_WriteMultiLineString(topKey.l, KeyName.s, ValueName.s, Value.s); write a StringField, separate with #LF$, to specified ValueName
Download 35 KB

Librarysource:

Code: Select all

removed, actual source in the download package!

Posted: Wed Nov 15, 2006 12:41 am
by ts-soft
some errorchecks added, first post updated

Posted: Wed Nov 15, 2006 2:54 am
by eJan
Great, thanks ts-soft!
Maybe You can write 'specal' tool with feature to convert registry exports (.reg) to PB source, to bypass: RunProgram("regedit.exe", "/s"...) - which can be useful for setups.

Posted: Wed Nov 15, 2006 3:48 am
by ts-soft
eJan wrote:Great, thanks ts-soft!
Maybe You can write 'specal' tool with feature to convert registry exports (.reg) to PB source, to bypass: RunProgram("regedit.exe", "/s"...) - which can be useful for setups.
Time see what can be done there, at least a suitable example should be feasible

Posted: Thu Nov 16, 2006 1:13 am
by ts-soft
@eJan
here a small example to parse a regfile. not finished, not fast, doesn't work for all RegistryTypes :wink:

but maybe you can extend it for your needs.

Code: Select all

; this example isn't finished, use it of your own risk

EnableExplicit

#REG_QWORD = $40

Structure RegistryFile
  hKey.l
  KeyName.s
  ValueName.s
  Value.s
  Type.l
EndStructure

Enumeration 1 ; RegTyp
  #REGEDIT4
  #REGEDIT5
EndEnumeration

Procedure ParseRegFile(RegFile.s, Reg.RegistryFile())
  Protected FF_Reg = ReadFile(#PB_Any, RegFile)
  Protected RegType.l, FileType.l = #PB_Ascii, Text.s
  Protected hKey.l, KeyName.s, ValueName.s, Value.s, Type.l, temp.s

  If FF_Reg
    ; unicodecheck
    If ReadStringFormat(FF_Reg) = #PB_Unicode : FileType = #PB_Unicode : EndIf
    ; check for RegType
    Repeat
      Text = ReadString(FF_Reg, FileType)
      If Trim(Text) = "REGEDIT4" : RegType = #REGEDIT4 : EndIf
      If Trim(Text) = "Windows Registry Editor Version 5.00" : RegType = #REGEDIT5 : EndIf
    Until RegType Or Eof(FF_Reg)
    If RegType
      While Not Eof(FF_Reg)
        Text = Trim(ReadString(FF_Reg, FileType))
        If Left(Text, 1) = "["
          Text = ReplaceString(Text, "[", "")
          Text = ReplaceString(Text, "]", "")
          temp = StringField(Text, 1, "\")
          Select temp
            Case "HKEY_CLASSES_ROOT"     : hKey = #HKEY_CLASSES_ROOT
            Case "HKEY_CURRENT_CONFIG"   : hKey = #HKEY_CURRENT_CONFIG
            Case "HKEY_CURRENT_USER"     : hKey = #HKEY_CURRENT_USER
            Case "HKEY_DYN_DATA"         : hKey = #HKEY_DYN_DATA
            Case "HKEY_LOCAL_MACHINE"    : hKey = #HKEY_LOCAL_MACHINE
            Case "HKEY_PERFORMANCE_DATA" : hKey = #HKEY_PERFORMANCE_DATA
            Case "HKEY_USERS"            : hKey = #HKEY_USERS
            Default : Break
          EndSelect
          KeyName = Right(Text, Len(Text) - Len(temp) -1)
        ElseIf Text
          If hkey And KeyName
            ValueName = StringField(Text, 1, "=")
            ValueName = ReplaceString(ValueName, #DQUOTE$, "")
            temp = Right(Text, Len(Text) - Len(ValueName) - 1)
            If ValueName = "@" : ValueName = "" : EndIf
            temp = ReplaceString(temp, "=", "")
            temp = ReplaceString(temp, #DQUOTE$, "")
            temp = ReplaceString(temp, "\\", "\")
            Text = temp
            temp = StringField(Text, 1, ":")
            Select temp
              Case "dword" : Type = #REG_DWORD
              Case "hex" : Type = #REG_BINARY
              Case "hex(7)" : Type = #REG_MULTI_SZ
              Case "hex(40)" : Type = #REG_QWORD
              Default : Type = #REG_SZ
            EndSelect
            Select Type
              Case #REG_DWORD : Value = ReplaceString(Text, "dword:", "")
              Case #REG_BINARY
                Value = ReplaceString(Text, "hex:", "")
                While Right(Value, 1) = "\"
                  Value + Trim(ReadString(FF_Reg, FileType))
                Wend
              Case #REG_MULTI_SZ
                Value = ReplaceString(Text, "hex(7):", "")
                While Right(Value, 1) = "\"
                  Value + Trim(ReadString(FF_Reg, FileType))
                Wend
                Value = ReplaceString(Value, "\", "")
              Case #REG_QWORD : Value = ReplaceString(Text, "hex(40):", "")
              Default : Value = Text
            EndSelect
            AddElement(Reg())
            With Reg()
              \hKey = hKey
              \KeyName = KeyName
              \ValueName = ValueName
              \Value = Value
              \Type = Type
            EndWith
          EndIf
        EndIf
      Wend
    Else
      Debug "Registry-Format not supported"
      CloseFile(FF_Reg)
      ProcedureReturn #False
    EndIf
    CloseFile(FF_Reg)
  Else
    Debug "error open " + #DQUOTE$ + RegFile + #DQUOTE$
    ProcedureReturn #False
  EndIf
  ProcedureReturn #True
EndProcedure

Procedure.s hKeyToString(hKey.l)
  Select hKey
    Case #HKEY_CLASSES_ROOT : ProcedureReturn "#HKEY_CLASSES_ROOT"
    Case #HKEY_CURRENT_CONFIG : ProcedureReturn "#HKEY_CURRENT_CONFIG"
    Case #HKEY_CURRENT_USER : ProcedureReturn "#HKEY_CURRENT_USER"
    Case #HKEY_DYN_DATA : ProcedureReturn "#HKEY_DYN_DATA"
    Case #HKEY_LOCAL_MACHINE : ProcedureReturn "#HKEY_LOCAL_MACHINE"
    Case #HKEY_PERFORMANCE_DATA : ProcedureReturn "#HKEY_PERFORMANCE_DATA"
    Case #HKEY_USERS : ProcedureReturn "#HKEY_USERS"
  EndSelect
EndProcedure

Procedure HexVal(a$)
  Protected Result.c, *adr.Character, i.l
  a$ = Trim(UCase(a$))
  If Asc(a$) = '$'
    a$ = Trim(Mid(a$, 2, Len(a$)-1))
  EndIf
   *adr = @a$
  For i = 1 To Len(a$)
    Result << 4
    Select *adr\c
      Case '0'
      Case '1' : Result + 1
      Case '2' : Result + 2
      Case '3' : Result + 3
      Case '4' : Result + 4
      Case '5' : Result + 5
      Case '6' : Result + 6
      Case '7' : Result + 7
      Case '8' : Result + 8
      Case '9' : Result + 9
      Case 'A' : Result + 10
      Case 'B' : Result + 11
      Case 'C' : Result + 12
      Case 'D' : Result + 13
      Case 'E' : Result + 14
      Case 'F' : Result + 15
      Default : i = Len(a$)
    EndSelect
    *adr + 1 * SizeOf(Character)
  Next
  ProcedureReturn Result
EndProcedure

Procedure SaveRegAsSource(PBFile.s, Reg.RegistryFile())
  Protected FF_PB.l = CreateFile(#PB_Any, PBFile)
  Protected Source.s, temp.s, I.l, MyQuad.q

  If FF_PB
    WriteStringN(FF_PB, "; created by RegToPB")
    WriteStringN(FF_PB, "")
    ForEach Reg()
      With Reg()
        temp = hKeyToString(\hKey)
        If temp
          Select \Type
            Case #REG_BINARY
              Debug "#REG_BINARY not supported"
            Case #REG_DWORD
              Source = "Reg_WriteLong(" + temp + "," +  #DQUOTE$ + \KeyName +  #DQUOTE$ + "," +  #DQUOTE$ + \ValueName +  #DQUOTE$ + "," + \Value + ")"
              WriteStringN(FF_PB, Source)
            Case #REG_QWORD
              For I = 0 To 7
                PokeC(@MyQuad + I, HexVal(StringField(\Value, I + 1, ",")))
              Next
              Source = "Reg_WriteQuad(" + temp + "," +  #DQUOTE$ + \KeyName +  #DQUOTE$ + "," +  #DQUOTE$ + \ValueName +  #DQUOTE$ + "," + StrQ(MyQuad) + ")"
              WriteStringN(FF_PB, Source)
            Case #REG_MULTI_SZ
              Debug "#REG_MULTI_SZ not supported"
            Case #REG_SZ
              Source = "Reg_WriteString(" + temp + "," +  #DQUOTE$ + \KeyName +  #DQUOTE$ + "," +  #DQUOTE$ + \ValueName +  #DQUOTE$ + "," + #DQUOTE$ + \Value + #DQUOTE$ + ")"
              WriteStringN(FF_PB, Source)
          EndSelect
        EndIf
      EndWith
    Next
    CloseFile(FF_PB)
    ProcedureReturn #True
  Else
    Debug "error create " + #DQUOTE$ + PBFile + #DQUOTE$
  EndIf
  ProcedureReturn #False
EndProcedure

Procedure RegFileToPureSource(RegFile.s, SourceFile.s)
  NewList Reg.RegistryFile()

  If ParseRegFile(RegFile, Reg())
    If SaveRegAsSource(SourceFile, Reg())
      ProcedureReturn #True
    EndIf
  EndIf

  ProcedureReturn #False
EndProcedure

; test
RegFileToPureSource("MyRegFile.reg", "MyTestFile.pb")
// Edit
Example updated
Example also in the download.

Posted: Fri Nov 17, 2006 12:35 am
by eJan
I have exported complete Ace Utilities settings from:
HKEY_CURRENT_USER\Software\Acelogix
Only 3 modificatins nedded in 388 lines of source! :D
#REG_BINARY not supported
Thanks very much ts-soft!
Edit: Registry Workshop 2.7 supported registry types:
Image

Posted: Fri Nov 17, 2006 1:18 am
by ts-soft
@eJan
few errors are inside, for example, are removed "=" from valuenames
I will support mostly used regtypes, but not all, have not enough infos about it

@all
I still hope for a few error messages or wishes, before i write the help!

Posted: Fri Nov 17, 2006 1:19 am
by rsts
This looks very interesting and I need something like this.

Will test as soon as I correct some other problems (in my code, not yours :)

Many thanks for posting this.

cheers

Posted: Fri Nov 17, 2006 8:24 am
by ts-soft
Update:
-renamed
Reg_ListSubKey to Reg_ListSubValue

-added
Reg_ListSubKey
Reg_ReadExpandString (with opt. expanding)
Reg_WriteExpandString

Download: see first post

Posted: Mon Apr 02, 2007 2:09 pm
by Shardik
ts-soft wrote: @all
I still hope for a few error messages or wishes, before i write the help!
Thomas,
I have reported two errors in your PBOSL_Registry procedure Reg_WriteMultiLineString() more than 2 weeks ago in the German forum:
http://www.purebasic.fr/german/viewtopi ... 1&start=11

Why didn't you correct these errors? I even tried to point out that the use of your procedure Reg_WriteMultiLineString() might corrupt the registry... :?

If I use your PBOSL_Registry code (with compiler option "Unicode-Executable erstellen" [in english: "Create unicode executable"] ) and only add this line

Code: Select all

Reg_WriteMultiLineString(#HKEY_CURRENT_USER, "Test", "IP", "192.168.0.1")
and execute that code, I obtain the following wierd looking registry entry:

Image

The binary content of the key IP looks as follows:

Image

The 2 bugs in your procedure Reg_WriteMultiLineString() are the following:

Code: Select all

Mem = AllocateMemory((MemoryStringLength(@Value) + 1) * SizeOf(Character))
A REG_MULTI_SZ string has to be terminated by 2 null bytes (http://msdn2.microsoft.com/en-us/library/ms724923.aspx):
MSDN wrote: lpData - [in] The data to be stored.
For string-based types, such as REG_SZ, the string must be null-terminated. With the REG_MULTI_SZ data type, the string must be terminated with two null characters.
So the above code line has to be changed to

Code: Select all

Mem = AllocateMemory((MemoryStringLength(@Value) + 2) * SizeOf(Character))
The second bug is in this line:

Code: Select all

Error = RegSetValueEx_(hKey, ValueName, 0, #REG_MULTI_SZ, Mem, MemorySize(Mem) + SizeOf(Character))
The calculation of the buffer size is wrong because your routine is working with a buffer size that has already taken the null bytes into account when allocating the buffer. If you were using a string, your calculation would be correct because the terminating zeroes have to be added. So the corrected code must be:

Code: Select all

Error = RegSetValueEx_(hKey, ValueName, 0, #REG_MULTI_SZ, Mem, MemorySize(Mem))
Please don't get me wrong. I am extremely thankful for your work on the PBOSL libraries and your invaluable code contributions in both the german and english forum. I just don't understand why you didn't correct the above 2 bugs in your PBOSL_registry until now, especially as I pointed out that they might do some harm to the registry of a programmer implementing it... And the German forum user PureBasic4.0 - who reported a problem with your procedure Reg_WriteMultiLineString() - even posted that my 2 corrections finally solved his problem... :wink:

Posted: Mon Apr 02, 2007 5:39 pm
by ts-soft
I will fix it in the next days. I hope, i find on eastern the time to write the
help.