PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Tailbite bug ??

https://www.purebasic.fr/english/viewtopic.php?t=15127

Page 1 of 1

Tailbite bug ??

Posted: Mon May 16, 2005 11:29 pm
by Droopy
When I test the Lib ( Create with Tailbite 1.2PR1 ) the program crash
( The same lib works great with Tailbite prior 1.2Pr1 )

Code: Select all

Debug RegCreateKey("HKEY_LOCAL_MACHINE\SOFTWARE\Droopy",".")
Debug RegDeleteKeyWithAllSub("HKEY_LOCAL_MACHINE\SOFTWARE\Droopy",".")
Here's the Lib Source

Code: Select all

; WebCode Tweaked by Droopy
; Read & Change the Registry
; Can read & Write #REG_SZ or #REG_DWORD 

Procedure RegConvertRegKeyToTopKey(Key.s)
  
  topKey.s=StringField(Key,1,"\")
  topKey=UCase(topKey)
  
  Select topKey
    
    Case "HKEY_CLASSES_ROOT"
      retour=#HKEY_CLASSES_ROOT
      
    Case "HKEY_CURRENT_USER"
      retour=#HKEY_CURRENT_USER
      
    Case "HKEY_LOCAL_MACHINE"
      retour=#HKEY_LOCAL_MACHINE
      
    Case "HKEY_USERS"
      retour=#HKEY_USERS 
      
    Case "HKEY_CURRENT_CONFIG"
      retour=#HKEY_CURRENT_CONFIG 
   
  EndSelect
  
  ProcedureReturn retour
  
EndProcedure

Procedure.s RegConvertRegKeyToKeyName(Key.s)
  PositionSlash=FindString(Key,"\",1)
  retour.s=Right(Key,(Len(Key)-PositionSlash))
  ProcedureReturn retour
EndProcedure

ProcedureDLL RegSetValue(Key.s, ValueName.s, Value.s, Type, ComputerName.s) ;- OK
  
  ; Return 1 if success / 0 if fail
  
  topKey=RegConvertRegKeyToTopKey(Key)
  KeyName.s=RegConvertRegKeyToKeyName(Key)
  lpData.s 
  
  If Left(KeyName, 1) = "\" 
    KeyName = Right(KeyName, Len(KeyName) - 1) 
  EndIf 
  
  If ComputerName = "." 
    GetHandle = RegOpenKeyEx_(topKey, KeyName, 0, #KEY_ALL_ACCESS, @hKey) 
  Else 
    lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry) 
    GetHandle = RegOpenKeyEx_(lhRemoteRegistry, KeyName, 0, #KEY_ALL_ACCESS, @hKey) 
  EndIf 
  
  If GetHandle = #ERROR_SUCCESS 
    lpcbData = 255 
    lpData = Space(255) 
    
    Select Type 
      Case #REG_SZ 
        GetHandle = RegSetValueEx_(hKey, ValueName, 0, #REG_SZ, @Value, Len(Value) + 1) 
      Case #REG_DWORD 
        lValue = Val(Value) 
        GetHandle = RegSetValueEx_(hKey, ValueName, 0, #REG_DWORD, @lValue, 4) 
    EndSelect 
    
    RegCloseKey_(hKey) 
    ergebnis = 1 
    ProcedureReturn ergebnis 
  Else 
    RegCloseKey_(hKey) 
    ergebnis = 0 
    ProcedureReturn ergebnis 
  EndIf 
EndProcedure 

ProcedureDLL.s RegGetValue(Key.s, ValueName.s, ComputerName.s) ;- OK
  
  ; Return an empty string if key or value don't exist
  
  topKey=RegConvertRegKeyToTopKey(Key)
  KeyName.s=RegConvertRegKeyToKeyName(Key)
  lpData.s 
  GetValue.s ="" 
  
  If Left(KeyName, 1) = "\" 
    KeyName = Right(KeyName, Len(KeyName) - 1) 
  EndIf 
   
  If ComputerName = "." 
    GetHandle = RegOpenKeyEx_(topKey, KeyName, 0, #KEY_ALL_ACCESS, @hKey) 
  Else 
    lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry) 
    GetHandle = RegOpenKeyEx_(lhRemoteRegistry, KeyName, 0, #KEY_ALL_ACCESS, @hKey) 
  EndIf 
  
  If GetHandle = #ERROR_SUCCESS 
    lpcbData = 255 
    lpData = Space(255) 
    
    GetHandle = RegQueryValueEx_(hKey, ValueName, 0, @Type, @lpData, @lpcbData) 
    
    If GetHandle = #ERROR_SUCCESS 
      
      Select Type 
        Case #REG_SZ 
           
          GetHandle = RegQueryValueEx_(hKey, ValueName, 0, @Type, @lpData, @lpcbData) 
          
          If GetHandle = 0 
            GetValue = Left(lpData, lpcbData - 1) 
          Else 
            GetValue = "" 
          EndIf 
          
        Case #REG_DWORD 
          GetHandle = RegQueryValueEx_(hKey, ValueName, 0, @lpType, @lpDataDWORD, @lpcbData) 
          
          If GetHandle = 0 
            GetValue = Str(lpDataDWORD) 
          Else 
            GetValue = "0" 
          EndIf 
          
      EndSelect 
    EndIf 
  EndIf 
  RegCloseKey_(hKey) 
  ProcedureReturn GetValue 
EndProcedure 

ProcedureDLL.s RegListSubKey(Key.s, Index, ComputerName.s) ;- OK
  
  ; Retourne la sous clé qui a l'index ( Index à incrémenter de 0 à ? )
  ; Quand plus de sous clé : chaine vide en retour
  
  topKey=RegConvertRegKeyToTopKey(Key)
  KeyName.s=RegConvertRegKeyToKeyName(Key)
  
  lpName.s 
  lpftLastWriteTime.FILETIME 
  
  If Left(KeyName, 1) = "\" 
    KeyName = Right(KeyName, Len(KeyName) - 1) 
  EndIf 
  
  If ComputerName = "." 
    GetHandle = RegOpenKeyEx_(topKey, KeyName, 0, #KEY_ALL_ACCESS, @hKey) 
  Else 
    lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry) 
    GetHandle = RegOpenKeyEx_(lhRemoteRegistry, KeyName, 0, #KEY_ALL_ACCESS, @hKey) 
  EndIf 
  
  If GetHandle = #ERROR_SUCCESS 
    lpcbName = 255 
    lpName = Space(255) 
    
    GetHandle = RegEnumKeyEx_(hKey, Index, @lpName, @lpcbName, 0, 0, 0, @lpftLastWriteTime) 
    
    If GetHandle = #ERROR_SUCCESS 
      ListSubKey.s = Left(lpName, lpcbName) 
    Else 
      ListSubKey.s = "" 
    EndIf 
  EndIf 
  RegCloseKey_(hKey) 
  ProcedureReturn ListSubKey 
EndProcedure 

ProcedureDLL RegDeleteValue(Key.s, ValueName.s, ComputerName.s) ;- OK
  
  ; Return 1 if success / 0 if fail
  ; return 0 if key don't exist
  
  topKey=RegConvertRegKeyToTopKey(Key)
  KeyName.s=RegConvertRegKeyToKeyName(Key)
  
  If Left(KeyName, 1) = "\" 
    KeyName = Right(KeyName, Len(KeyName) - 1) 
  EndIf 
  
  If ComputerName = "." 
    GetHandle = RegOpenKeyEx_(topKey, KeyName, 0, #KEY_ALL_ACCESS, @hKey) 
  Else 
    lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry) 
    GetHandle = RegOpenKeyEx_(lhRemoteRegistry, KeyName, 0, #KEY_ALL_ACCESS, @hKey) 
  EndIf 
  
  If GetHandle = #ERROR_SUCCESS 
    GetHandle = RegDeleteValue_(hKey, @ValueName) 
    If GetHandle = #ERROR_SUCCESS 
      DeleteValue = #True 
    Else 
      DeleteValue = #False 
    EndIf 
  EndIf 
  RegCloseKey_(hKey) 
  ProcedureReturn DeleteValue 
EndProcedure 

ProcedureDLL RegCreateKey(Key.s, ComputerName.s) ;- OK
  
  ; Return 1 if succes / 0 if fail
  ; It create subkey if KeyPath don't exist
  
  topKey=RegConvertRegKeyToTopKey(Key)
  KeyName.s=RegConvertRegKeyToKeyName(Key)
  
  lpSecurityAttributes.SECURITY_ATTRIBUTES 
  
  If Left(KeyName, 1) = "\" 
    KeyName = Right(KeyName, Len(KeyName) - 1) 
  EndIf 
  
  If ComputerName = "." 
    GetHandle = RegCreateKeyEx_(topKey, KeyName, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, @lpSecurityAttributes, @hNewKey, @GetHandle) 
  Else 
    lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry) 
    GetHandle = RegCreateKeyEx_(lhRemoteRegistry, KeyName, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, @lpSecurityAttributes, @hNewKey, @GetHandle) 
  EndIf 
  
  If GetHandle = #ERROR_SUCCESS 
    GetHandle = RegCloseKey_(hNewKey) 
    CreateKey = #True 
  Else 
    CreateKey = #False 
  EndIf 
  ProcedureReturn CreateKey 
EndProcedure 

ProcedureDLL RegDeleteKey(Key.s, ComputerName.s) ;- OK
  
  ; Return 1 if succes / 0 if fail
  ; Key must be empty
  
  topKey=RegConvertRegKeyToTopKey(Key)
  KeyName.s=RegConvertRegKeyToKeyName(Key)
  
  If Left(KeyName, 1) = "\" 
    KeyName = Right(KeyName, Len(KeyName) - 1) 
  EndIf 
  
  If ComputerName = "." 
    GetHandle = RegDeleteKey_(topKey, @KeyName) 
  Else 
    lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry) 
    GetHandle = RegDeleteKey_(lhRemoteRegistry, @KeyName) 
  EndIf 
  
  If GetHandle = #ERROR_SUCCESS 
    DeleteKey = #True 
  Else 
    DeleteKey = #False 
  EndIf 
  ProcedureReturn DeleteKey 
EndProcedure 

ProcedureDLL.s RegListSubValue(Key.s, Index, ComputerName.s) ;- OK
  
  ; return an empty string if key don't exit
  
  topKey=RegConvertRegKeyToTopKey(Key)
  KeyName.s=RegConvertRegKeyToKeyName(Key)
  
  lpName.s 
  lpftLastWriteTime.FILETIME 
  ListSubValue.s 
  
  If Left(KeyName, 1) = "\" 
    KeyName = Right(KeyName, Len(KeyName) - 1) 
  EndIf 
  
  If ComputerName = "." 
    GetHandle = RegOpenKeyEx_(topKey, KeyName, 0, #KEY_ALL_ACCESS, @hKey) 
  Else 
    lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry) 
    GetHandle = RegOpenKeyEx_(lhRemoteRegistry, KeyName, 0, #KEY_ALL_ACCESS, @hKey) 
  EndIf 
  
  
  If GetHandle = #ERROR_SUCCESS 
    lpcbName = 255 
    lpName = Space(255) 
    
    GetHandle = RegEnumValue_(hKey, Index, @lpName, @lpcbName, 0, 0, 0, 0) 
    
    If GetHandle = #ERROR_SUCCESS 
      ListSubValue = Left(lpName, lpcbName) 
    Else 
      ListSubValue = "" 
    EndIf 
    RegCloseKey_(hKey) 
  EndIf 
  ProcedureReturn ListSubValue 
EndProcedure 

ProcedureDLL.b RegKeyExists(Key.s, ComputerName.s) ;- OK
  
  ; Return 1 if succes / 0 if fail
  
  topKey=RegConvertRegKeyToTopKey(Key)
  KeyName.s=RegConvertRegKeyToKeyName(Key)
  
  If Left(KeyName, 1) = "\" 
    KeyName = Right(KeyName, Len(KeyName) - 1) 
  EndIf 
  
  If ComputerName = "." 
    GetHandle = RegOpenKeyEx_(topKey, KeyName, 0, #KEY_ALL_ACCESS, @hKey) 
  Else 
    lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry) 
    GetHandle = RegOpenKeyEx_(lhRemoteRegistry, KeyName, 0, #KEY_ALL_ACCESS, @hKey) 
  EndIf 
  
  If GetHandle = #ERROR_SUCCESS 
    KeyExists = #True 
  Else 
    KeyExists = #False 
  EndIf 
  ProcedureReturn KeyExists 
EndProcedure 

Procedure RegDeleteKeyWithAllSubInternal(Key.s,ComputerName.s) ;/ OK (Internal )

  topKey=RegConvertRegKeyToTopKey(Key)
  KeyName.s=RegConvertRegKeyToKeyName(Key)
  
  i=0 
  a$="" 
  Repeat 
    b$=a$ 
    a$=RegListSubKey(Key,0,"") 
    If a$<>"" 
      RegDeleteKeyWithAllSubInternal(Key+"\"+a$,"") 
    EndIf 
  Until a$=b$ 
  RegDeleteKey(Key, ComputerName) 
EndProcedure 

ProcedureDLL RegDeleteKeyWithAllSub(Key.s,ComputerName.s);- OK

  ; Return 1 if success / 0 if fail ( Or key to delete don't exist )
  
  retour1 = RegKeyExists(Key.s,ComputerName.s)
  retour2+ RegDeleteKeyWithAllSubInternal(Key,ComputerName)
  
  If retour1=1 And  retour2=0 : retour=1 : EndIf
  
  ProcedureReturn retour
EndProcedure

ProcedureDLL RegCreateKeyValue(Key.s,ValueName.s,Value.s,Type,ComputerName.s) ;- OK

  ; Return 1 if succes / 0 if fail
  
  RegCreateKey(Key,ComputerName) 
  ProcedureReturn RegSetValue(Key,ValueName,Value,Type,ComputerName) 
EndProcedure

Posted: Tue May 17, 2005 12:16 am
by El_Choni
I'll check this tomorrow, thanks for the report.

Posted: Fri May 20, 2005 9:34 pm
by Droopy
I test again and with Tailbite 1.2 Beta 2.0 this Lib works
The bug happen only with Tailbite 1.2PR1

Posted: Sat May 21, 2005 1:28 pm
by El_Choni
I'll check it today.

Posted: Thu May 26, 2005 7:39 pm
by El_Choni
Fixed. I hope it'll be available soon in PureArea and PureProject sites.

Regards,

Posted: Thu May 26, 2005 7:59 pm
by Droopy
Thanks a lot :D :D :D

Posted: Thu May 26, 2005 11:22 pm
by Andre
El_Choni wrote:Fixed. I hope it'll be available soon in PureArea and PureProject sites.
Latest version is available on PureArea.net Showcase :D
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited