PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Registry.pbi (Überarbeitet)

https://www.purebasic.fr/german/viewtopic.php?t=14900

Seite 1 von 2

Registry.pbi (Überarbeitet)

Verfasst: 18.11.2007 16:52
von mk-soft
betreffend des Thread http://www.purebasic.fr/german/viewtopic.php?t=14893 habe ich den Code mal überarbeitet.

Registry.pbi

Code: Alles auswählen

;-TOP
; Kommentar     : Read and change the Registry / FileAssociate
; Author        : Unknown
; Second Author : mk-soft
; Datei         : Registry.pbi
; Version       : 1.01
; Erstellt      : ???
; Geändert      : 18.11.2007
; 
; Compilermode  :
;
; ***************************************************************************************

;#PB_Lit2Msg stop

;EnableExplicit

; ***************************************************************************************

Global RegLasterror.l
Global RegLastMessage.s

; ***************************************************************************************

CompilerIf Defined(FormatMessage, #PB_Procedure) = #False
  
  Procedure.s FormatMessage(ErrorNumber.l)

    Protected *Buffer, len, result.s
    
    len = FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER|#FORMAT_MESSAGE_FROM_SYSTEM,0,ErrorNumber,0,@*Buffer,0,0)
    If len
      result = PeekS(*Buffer, len - 2)
      LocalFree_(*Buffer)
      ProcedureReturn result
    Else
      ProcedureReturn "Errorcode: " + Hex(ErrorNumber)
    EndIf
    
  EndProcedure

CompilerEndIf

; ***************************************************************************************

Procedure Reg_SetValue(topKey, sKeyName.s, sValueName.s, vValue.s, lType, ComputerName.s = "")
   
  Protected hKey.l, lhRemoteRegistry.l
  Protected r1.l, Result.l
  Protected lpData.s{256}
  Protected lpcbData.l, lValue.l
  
  RegLastError = 0
  
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn #False
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  EndIf
  
  If r1 = #ERROR_SUCCESS
    lpcbData = 255
    Select lType
      Case #REG_SZ
        r1 = RegSetValueEx_(hKey, sValueName, 0, #REG_SZ, @vValue, Len(vValue) + 1)
      Case #REG_DWORD
        lValue = Val(vValue)
        r1 = RegSetValueEx_(hKey, sValueName, 0, #REG_DWORD, @lValue, 4)
    EndSelect
    If r1 = #ERROR_SUCCESS
      Result = #True
    Else
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      Result = #False
    EndIf
  Else
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
    Result = #False
  EndIf
  
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
  
  ProcedureReturn Result
  
EndProcedure

; ***************************************************************************************

Procedure.s Reg_GetValue(topKey, sKeyName.s, sValueName.s, ComputerName.s = "")
   
  Protected hKey.l, lhRemoteRegistry.l
  Protected r1.l, Result.l
  Protected lpData.s{256}, GetValue.s
  Protected lType.l, lpcbData.l, lpDataDWORD.l
  
  RegLastError = 0
  GetValue.s = ""
  
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
  
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn ""
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  EndIf
  
  If r1 = #ERROR_SUCCESS
    lpcbData = 255
    r1 = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpData, @lpcbData)
    If r1 = #ERROR_SUCCESS
      Select lType
        Case #REG_SZ
          r1 = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpData, @lpcbData)
          If r1 = #ERROR_SUCCESS
            GetValue = Left(lpData, lpcbData - 1)
          Else
            GetValue = ""
          EndIf
        Case #REG_DWORD
          r1 = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpDataDWORD, @lpcbData)
          If r1 = #ERROR_SUCCESS
            GetValue = Str(lpDataDWORD)
          Else
            GetValue = ""
          EndIf
      EndSelect
      If r1 = #ERROR_SUCCESS
        Result = #True
      Else
        RegLastError = r1
        RegLastMessage = FormatMessage(RegLastError)
        Result = #False
      EndIf
    Else 
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
    EndIf
  Else
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
  EndIf
  
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
  
  ProcedureReturn GetValue
  
EndProcedure

; ***************************************************************************************

Procedure.s Reg_ListSubKey(topKey, sKeyName.s, Index, ComputerName.s = "")
 
  Protected hKey.l, lhRemoteRegistry.l
  Protected r1.l, Result.l
  Protected lpName.s{256}, ListSubKey.s
  Protected lpcbName.l
  Protected lpftLastWriteTime.FILETIME
  
  RegLastError = 0
  
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
  
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn ""
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  EndIf
  
  If r1 = #ERROR_SUCCESS
    lpcbName = 255
    r1 = RegEnumKeyEx_(hKey, Index, @lpName, @lpcbName, 0, 0, 0, @lpftLastWriteTime)
    If r1 = #ERROR_SUCCESS
      ListSubKey.s = Left(lpName, lpcbName)
    Else
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ListSubKey.s = ""
    EndIf
  Else 
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
    ListSubKey.s = ""
  EndIf
  
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
  
  ProcedureReturn ListSubKey

EndProcedure

; ***************************************************************************************

Procedure Reg_DeleteValue(topKey, sKeyName.s, sValueName.s, ComputerName.s = "")
  
  Protected hKey.l, lhRemoteRegistry.l
  Protected r1.l, DeleteValue.l
  
  RegLastError = 0
  
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
  
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn #False
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  EndIf
  
  If r1 = #ERROR_SUCCESS
    r1 = RegDeleteValue_(hKey, @sValueName)
    If r1 = #ERROR_SUCCESS
      DeleteValue = #True
    Else
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      DeleteValue = #False
    EndIf
  Else 
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
    DeleteValue = #False
  EndIf
  
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
  
  ProcedureReturn DeleteValue
  
EndProcedure

; ***************************************************************************************

Procedure Reg_CreateKey(topKey, sKeyName.s, ComputerName.s = "")
  
  ; Result #REG_CREATED_NEW_KEY = 1
  ; Result #REG_OPENED_EXISTING_KEY = 2
  
  Protected hKey.l, lhRemoteRegistry.l
  Protected r1.l, CreateKey.l
  Protected lpSecurityAttributes.SECURITY_ATTRIBUTES
  
  RegLastError = 0
  
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
  
  If ComputerName = ""
    r1 = RegCreateKeyEx_(topKey, sKeyName, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, @lpSecurityAttributes, @hKey, @CreateKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn #False
    EndIf
    r1 = RegCreateKeyEx_(lhRemoteRegistry, sKeyName, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, @lpSecurityAttributes, @hKey, @CreateKey)
  EndIf
  
  If r1 = #ERROR_SUCCESS
    ;
  Else
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
  EndIf
  
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
  
  ProcedureReturn CreateKey

EndProcedure

; ***************************************************************************************

Procedure Reg_DeleteKey(topKey, sKeyName.s, ComputerName.s = "")
  
  Protected hKey.l, lhRemoteRegistry.l
  Protected r1.l, DeleteKey.l
  
  RegLastError = 0
  
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
  
  If ComputerName = ""
    r1 = RegDeleteKey_(topKey, @sKeyName)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn #False
    EndIf
    r1 = RegDeleteKey_(lhRemoteRegistry, @sKeyName)
  EndIf
  
  If r1 = #ERROR_SUCCESS
    DeleteKey = #True
  Else
    DeleteKey = #False
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
  EndIf
  
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
  
  ProcedureReturn DeleteKey

EndProcedure

; ***************************************************************************************

Procedure.s Reg_ListSubValue(topKey, sKeyName.s, Index, ComputerName.s = "")
  
  Protected hKey.l, lhRemoteRegistry.l
  Protected r1.l, Result.l
  Protected lpName.s{256}, ListSubValue.s
  Protected lpcbName.l
  Protected lpftLastWriteTime.FILETIME
  
  RegLastError = 0
  
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
  
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn ""
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  EndIf
  
  If r1 = #ERROR_SUCCESS
    lpcbName = 255
    r1 = RegEnumValue_(hKey, Index, @lpName, @lpcbName, 0, 0, 0, 0)
    If r1 = #ERROR_SUCCESS
      ListSubValue = Left(lpName, lpcbName)
    Else
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ListSubValue.s = ""
    EndIf
  Else 
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
    ListSubValue.s = ""
  EndIf
  
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
  
  ProcedureReturn ListSubValue
   
EndProcedure

; ***************************************************************************************

Procedure Reg_KeyExists(topKey, sKeyName.s, ComputerName.s = "")
   
  Protected hKey.l, lhRemoteRegistry.l
  Protected r1.l, KeyExists.l
  
  RegLastError = 0
  
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
  
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn #False
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  EndIf
  
  If r1 = #ERROR_SUCCESS
    KeyExists = #True
  Else
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
    KeyExists = #False
  EndIf
  
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
  
  ProcedureReturn KeyExists
  
EndProcedure

; ***************************************************************************************

Procedure Reg_DeleteKeyWithAllSub(topKey,sKeyName.s,ComputerName.s = "")
   
   Protected i.l
   Protected a$="", b$
   
   Repeat
      b$=a$
      a$=Reg_ListSubKey(topKey,sKeyName,0,"")
      If a$<>""
         Reg_DeleteKeyWithAllSub(topKey,sKeyName+"\"+a$,"")
      EndIf
   Until a$=b$
   Reg_DeleteKey(topKey, sKeyName, ComputerName)
EndProcedure

; ***************************************************************************************

Procedure Reg_CreateKeyValue(topKey,sKeyName.s,sValueName.s,vValue.s,lType,ComputerName.s = "")
   Reg_CreateKey(topKey,sKeyName,ComputerName)
   ProcedureReturn Reg_SetValue(topKey,sKeyName,sValueName,vValue,lType,ComputerName)
EndProcedure

; ***************************************************************************************

Procedure AssociateFileEx(AF_Ext$,ext_description$,programm$,icon$,prgkey$,cmd_description$,cmd_key$)
   
   Protected cmd$, key$
   
   cmd$=Chr(34)+programm$+Chr(34)+" "+Chr(34)+"%1"+Chr(34)
   If GetVersion_() & $FF0000 ; Windows NT/XP
      Reg_CreateKeyValue(#HKEY_CLASSES_ROOT, "Applications\"+prgkey$+"\shell\"+cmd_description$+"\command","",cmd$,#REG_SZ,"")
      If ext_description$
         Key$=AF_Ext$+"_auto_file"
         Reg_CreateKeyValue(#HKEY_CLASSES_ROOT  ,"."+AF_Ext$           ,"",Key$            ,#REG_SZ,"")
         Reg_CreateKeyValue(#HKEY_CLASSES_ROOT  ,Key$               ,"",ext_description$,#REG_SZ,"")
         If icon$
            Reg_CreateKeyValue(#HKEY_CLASSES_ROOT,Key$+"\DefaultIcon","",icon$           ,#REG_SZ,"")
         EndIf
      EndIf
      Reg_CreateKeyValue(#HKEY_CURRENT_USER,"Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\."+AF_Ext$,"Application",prgkey$,#REG_SZ,"")
   Else ;Windows 9x
      Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE  ,"Software\Classes\."+AF_Ext$                     ,"",prgkey$         ,#REG_SZ,"")
      If ext_description$
         Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE,"Software\Classes\"+prgkey$                   ,"",ext_description$,#REG_SZ,"")
      EndIf
      If icon$
         Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE,"Software\Classes\"+prgkey$+"\DefaultIcon"    ,"",icon$           ,#REG_SZ,"")
      EndIf
      If cmd_description$<>cmd_key$
         Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE,"Software\Classes\"+prgkey$+"\shell\"+cmd_key$,"",cmd_description$,#REG_SZ,"")
      EndIf
      Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE  ,"Software\Classes\"+prgkey$+"\shell\"+cmd_key$+"\command","",cmd$,#REG_SZ,"")
   EndIf
EndProcedure

; ***************************************************************************************

Procedure Remove_AssociateFile(AF_Ext$,prgkey$)
   
   Protected key$
   
   If GetVersion_() & $FF0000 ; Windows NT/XP
      Reg_DeleteKeyWithAllSub(#HKEY_CLASSES_ROOT,"Applications\"+prgkey$,"")
      key$=AF_Ext$+"_auto_file"
      Reg_DeleteKeyWithAllSub(#HKEY_CLASSES_ROOT,"."+AF_Ext$,"")
      Reg_DeleteKeyWithAllSub(#HKEY_CLASSES_ROOT,key$,"")
      Reg_DeleteKeyWithAllSub(#HKEY_CURRENT_USER,"Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\."+AF_Ext$,"")
   Else ;Windows 9x
      Reg_DeleteKeyWithAllSub(#HKEY_LOCAL_MACHINE  ,"Software\Classes\."+AF_Ext$,"")
      Reg_DeleteKeyWithAllSub(#HKEY_LOCAL_MACHINE,"Software\Classes\"+prgkey$,"")
   EndIf
EndProcedure

; ***************************************************************************************

Procedure AssociateFile(AF_Ext$,ext_description$,programm$,icon$)
   AssociateFileEx(AF_Ext$,ext_description$,programm$,icon$,GetFilePart(programm$),"open","open")
EndProcedure
;#PB_Lit2Msg start

; ***************************************************************************************
Test

Code: Alles auswählen


IncludeFile "Registry.pbi"

Debug "Fehler Read"
Debug Reg_GetValue(#HKEY_CURRENT_USER, "Control Panel\Desktop", "Any")
If RegLastError
  Debug RegLastMessage
EndIf


Debug "Read Wallpaper"
Debug Reg_GetValue(#HKEY_CURRENT_USER, "Control Panel\Desktop", "Wallpaper")
If RegLastError
  Debug RegLastMessage
EndIf

Debug "Create Key"
Debug Reg_CreateKey(#HKEY_LOCAL_MACHINE, "Software\MyTestKey")
If RegLastError
  Debug RegLastMessage
EndIf

Debug "SetValue Text"
Debug Reg_SetValue(#HKEY_LOCAL_MACHINE, "Software\MyTestKey", "TextValue", "Hallo Welt", #REG_SZ)
If RegLastError
  Debug RegLastMessage
EndIf

Debug "SetValue DWORD"
Debug Reg_SetValue(#HKEY_LOCAL_MACHINE, "Software\MyTestKey", "DWordValue", Str(12345678), #REG_DWORD)
If RegLastError
  Debug RegLastMessage
EndIf

Debug "GetValue Text"
Debug Reg_GetValue(#HKEY_LOCAL_MACHINE, "Software\MyTestKey", "TextValue")
If RegLastError
  Debug RegLastMessage
EndIf

Debug "GetValue DWORD"
Debug Reg_GetValue(#HKEY_LOCAL_MACHINE, "Software\MyTestKey", "DWordValue")
If RegLastError
  Debug RegLastMessage
EndIf

Debug "List SubValue"
i = 0
Repeat
  result.s = Reg_ListSubValue(#HKEY_LOCAL_MACHINE, "Software\MyTestKey", i)
  If result = ""
    Break
  EndIf
  Debug Str(i) + " : " + Result
  i + 1
ForEver

Debug "List SubKey"
i = 0
Repeat
  result.s = Reg_ListSubKey(#HKEY_LOCAL_MACHINE, "Software", i)
  If result = ""
    Break
  EndIf
  Debug Str(i) + " : " + Result
  i + 1
ForEver

;Reg_DeleteKey(#HKEY_LOCAL_MACHINE, "Software\MyTestKey")
If RegLastError
  Debug RegLastMessage
EndIf
FF :wink:

Verfasst: 18.11.2007 17:55
von sibru
danke :allright: ...

hatte ich schon lange auf´m Zettel...

Gruss Siggi

Re: Registry.pbi (Überarbeitet)

Verfasst: 06.07.2010 22:30
von mk-soft
Kommt auf meine Todo liste :wink:

Re: Registry.pbi (Überarbeitet)

Verfasst: 30.10.2010 12:01
von mbuettner
Beim Kompillieren kommt folgende Meldung:
Zeile 41: Versuch einen String in eine Numerische Variable zu Schreiben

Code: Alles auswählen

RegLastMessage = FormatMessage(RegLastError)

Code: Alles auswählen

Procedure Reg_SetValue(topKey, sKeyName.s, sValueName.s, vValue.s, lType, ComputerName.s = "")
   
  Protected hKey.l, lhRemoteRegistry.l
  Protected r1.l, Result.l
  Protected lpData.s{256}
  Protected lpcbData.l, lValue.l
 
  RegLastError = 0
 
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError) ;Hier ist der Fehler
      ProcedureReturn #False
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey)
  EndIf
 
  If r1 = #ERROR_SUCCESS
    lpcbData = 255
    Select lType
      Case #REG_SZ
        r1 = RegSetValueEx_(hKey, sValueName, 0, #REG_SZ, @vValue, Len(vValue) + 1)
      Case #REG_DWORD
        lValue = Val(vValue)
        r1 = RegSetValueEx_(hKey, sValueName, 0, #REG_DWORD, @lValue, 4)
    EndSelect
    If r1 = #ERROR_SUCCESS
      Result = #True
    Else
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      Result = #False
    EndIf
  Else
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
    Result = #False
  EndIf
 
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
 
  ProcedureReturn Result
 
EndProcedure

Re: Registry.pbi (Überarbeitet)

Verfasst: 30.10.2010 12:46
von Vera
@ mbuettner

Hast Du dabei die komplette Registry.pbi verwendet oder nur eine Procedure daraus?
Ggf. fehlt Dir nur die vorausgehende Deklaration:

Code: Alles auswählen

Global RegLasterror.l
Global RegLastMessage.s

Re: Registry.pbi (Überarbeitet)

Verfasst: 30.10.2010 13:31
von ts-soft
mbuettner hat geschrieben:Beim Kompillieren kommt folgende Meldung:
Zeile 41: Versuch einen String in eine Numerische Variable zu Schreiben
Der Code der dies auslöst ist aber mit Sicherheit nicht in der Include zu suchen!

Der Testcode von Dir ist erforderlich, desweiteren welche Windows Version, bzw. welche
Compilereinstellungen ("Admin Rechte erforderlich").

Wenn so eine Include bisher bei jedem funktioniert, ist es doch wohl klar, das Du den Fehler
erstmal bei Dir suchen solltest und uns auch alle Informationen zukommen läßt!

Gruß
Thomas

Re: Registry.pbi (Überarbeitet)

Verfasst: 30.10.2010 17:53
von Falko
@MK-SOFT
Wäre bestimmt für viele interessant, wenn du da auch noch die fehlenden Registry-Funktionen einbauen würdest.
Besonders um Regzweige oder einen gesamten Registryschlüssel zu sichern. :allright:

http://msdn.microsoft.com/en-us/library ... 85%29.aspx

Code: Alles auswählen

GetSystemRegistryQuota --	Retrieves the current size of the registry and the maximum size that the registry is allowed to attain on the system.
RegCloseKey 	Closes a handle to the specified registry key.
RegConnectRegistry	Establishes a connection to a predefined registry handle on another computer.
RegCopyTree	Copies the specified registry key, along with its values and subkeys, to the specified destination key.
RegCreateKeyEx	Creates the specified registry key.
RegCreateKeyTransacted	Creates the specified registry key and associates it with a transaction.
RegDeleteKey	Deletes a subkey and its values.
RegDeleteKeyEx	Deletes a subkey and its values from the specified platform-specific view of the registry.
RegDeleteKeyTransacted	Deletes a subkey and its values from the specified platform-specific view of the registry as a transacted operation.
RegDeleteKeyValue	Removes the specified value from the specified registry key and subkey.
RegDeleteTree	Deletes the subkeys and values of the specified key recursively.
RegDeleteValue	Removes a named value from the specified registry key.
RegDisablePredefinedCache	Disables handle caching for the predefined registry handle for HKEY_CURRENT_USER for the current process.
RegDisablePredefinedCacheEx	Disables handle caching for all predefined registry handles for the current process.
RegDisableReflectionKey	Disables registry reflection for the specified key.
RegEnableReflectionKey	Enables registry reflection for the specified disabled key.
RegEnumKeyEx	Enumerates the subkeys of the specified open registry key.
RegEnumValue	Enumerates the values for the specified open registry key.
RegFlushKey	Writes all attributes of the specified open registry key into the registry.
RegGetKeySecurity	Retrieves a copy of the security descriptor protecting the specified open registry key.
RegGetValue	Retrieves the type and data for the specified registry value.
RegLoadKey	Creates a subkey under HKEY_USERS or HKEY_LOCAL_MACHINE and stores registration information from a specified file into that subkey.
RegLoadMUIString	Loads the specified string from the specified key and subkey.
RegNotifyChangeKeyValue	Notifies the caller about changes to the attributes or contents of a specified registry key.
RegOpenCurrentUser	Retrieves a handle to the HKEY_CURRENT_USER key for the user the current thread is impersonating.
RegOpenKeyEx	Opens the specified registry key.
RegOpenKeyTransacted	Opens the specified registry key and associates it with a transaction.
RegOpenUserClassesRoot	Retrieves a handle to the HKEY_CLASSES_ROOT key for the specified user.
RegOverridePredefKey	Maps a predefined registry key to a specified registry key.
RegQueryInfoKey	Retrieves information about the specified registry key.
RegQueryMultipleValues	Retrieves the type and data for a list of value names associated with an open registry key.
RegQueryReflectionKey	Determines whether reflection has been disabled or enabled for the specified key.
RegQueryValueEx	Retrieves the type and data for a specified value name associated with an open registry key.
RegReplaceKey	Replaces the file backing a registry key and all its subkeys with another file.
RegRestoreKey	Reads the registry information in a specified file and copies it over the specified key.
RegSaveKey	Saves the specified key and all of its subkeys and values to a new file.
RegSaveKeyEx	Saves the specified key and all of its subkeys and values to a new file. You can specify the format for the saved key or hive.
RegSetKeyValue	Sets the data for the specified value in the specified registry key and subkey.
RegSetKeySecurity	Sets the security of an open registry key.
RegSetValueEx	Sets the data and type of a specified value under a registry key.
RegUnLoadKey
Gruß Falko

Re: Registry.pbi (Überarbeitet)

Verfasst: 30.10.2010 18:18
von ts-soft
Weitere Funktionen wrappen, wobei da im allg. keine Vereinfachung möglich ist, halte ich
nicht für so wichtig, wichtiger wäre es, alle #KEY_ALL_ACCESS zu entfernnen und durch
die entsprechungen, welche nur die notwendigen Rechte anfordern, zu ersetzen.

In der jetzigen Form sind immer Adminrechte erforderlich, meist unnötigerweise.

Gruß
Thomas

Re: Registry.pbi (Überarbeitet)

Verfasst: 30.10.2010 18:27
von Falko
ts-soft hat geschrieben:Weitere Funktionen wrappen, wobei da im allg. keine Vereinfachung möglich ist, halte ich
nicht für so wichtig, wichtiger wäre es, alle #KEY_ALL_ACCESS zu entfernnen und durch
die entsprechungen, welche nur die notwendigen Rechte anfordern, zu ersetzen.

In der jetzigen Form sind immer Adminrechte erforderlich, meist unnötigerweise.

Gruß
Thomas
Da magst du wohl Recht haben, aber um speziell Registryzweige komplett zu speichern würde diese Funktion
RegSaveKey() sehr wohl eine Vereinfachung gegenüber einem Batch sein. Alles andere wäre, wie du schon
schreibst nicht notwendig.

Hier mal ein Beispiel um sich die Konten von Outlook zu speichern. Dabei werden alle Einstellungen in eine
Reg - Datei gespeichert und diese braucht man im Zielverzeichnis nur noch doppelklicken. So was wäre in diesem
Wrapper sehr schön, wenn MK-SOFT diese Funktion mit einbauen würde :)

Code: Alles auswählen

@echo off
set PFAD=%CD%
echo %CD%
echo %CD%\SaveOutlookKonto.reg
c:\windows\regedit.exe /e %CD%\SaveOutlookKonto.reg "HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676"
echo Die Datei SaveOutlookKonto.reg ist vorhanden und
echo muss nun auf den anderen Rechner kopiert werden,
echo und gestartet werden.
echo danach Outlook starten und bei abfrage die Kennwörter eingeben.
pause
exit
Achtung, dieser Code läuft korrekt unter Vista. Bei XP und kleiner muss die Variable %CD% entfernt werden, damit es
im aktuellen Verzeichnis gespeichert wird. Passwörter werden ab Outlook 2003 aus Sicherheitsgründe von MS vergessen und müssen von Hand erneut eingegeben werden.

Gruß, Falko

Re: Registry.pbi (Überarbeitet)

Verfasst: 30.10.2010 20:40
von ts-soft
Diese Version funktioniert bei Einträgen, die keine Adminrechte benötigen, auch ohne diese :mrgreen:
Registry.pbi

Code: Alles auswählen

;-TOP
; Kommentar     : Read and change the Registry / FileAssociate
; Author        : Unknown
; Second Author : mk-soft
; Datei         : Registry.pbi
; Version       : 1.01
; Erstellt      : ???
; Geändert      : 18.11.2007
;
; Compilermode  :
;
; ***************************************************************************************

;#PB_Lit2Msg stop

;EnableExplicit

; ***************************************************************************************

Global RegLasterror.l
Global RegLastMessage.s

; ***************************************************************************************

CompilerIf Defined(FormatMessage, #PB_Procedure) = #False
 
  Procedure.s FormatMessage(ErrorNumber.l)

    Protected *Buffer, len, result.s
   
    len = FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER|#FORMAT_MESSAGE_FROM_SYSTEM,0,ErrorNumber,0,@*Buffer,0,0)
    If len
      result = PeekS(*Buffer, len - 2)
      LocalFree_(*Buffer)
      ProcedureReturn result
    Else
      ProcedureReturn "Errorcode: " + Hex(ErrorNumber)
    EndIf
   
  EndProcedure

CompilerEndIf

; ***************************************************************************************

Procedure Reg_SetValue(topKey, sKeyName.s, sValueName.s, vValue.s, lType, ComputerName.s = "")
   
  Protected hKey.l, lhRemoteRegistry.l
  Protected r1.l, Result.l
  Protected lpData.s{256}
  Protected lpcbData.l, lValue.l
 
  RegLastError = 0
 
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_WRITE, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn #False
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_WRITE, @hKey)
  EndIf
 
  If r1 = #ERROR_SUCCESS
    lpcbData = 255
    Select lType
      Case #REG_SZ
        r1 = RegSetValueEx_(hKey, sValueName, 0, #REG_SZ, @vValue, Len(vValue) + 1)
      Case #REG_DWORD
        lValue = Val(vValue)
        r1 = RegSetValueEx_(hKey, sValueName, 0, #REG_DWORD, @lValue, 4)
    EndSelect
    If r1 = #ERROR_SUCCESS
      Result = #True
    Else
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      Result = #False
    EndIf
  Else
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
    Result = #False
  EndIf
 
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
 
  ProcedureReturn Result
 
EndProcedure

; ***************************************************************************************

Procedure.s Reg_GetValue(topKey, sKeyName.s, sValueName.s, ComputerName.s = "")
   
  Protected hKey.l, lhRemoteRegistry.l
  Protected r1.l, Result.l
  Protected lpData.s{256}, GetValue.s
  Protected lType.l, lpcbData.l, lpDataDWORD.l
 
  RegLastError = 0
  GetValue.s = ""
 
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
 
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_READ, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn ""
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_READ, @hKey)
  EndIf
 
  If r1 = #ERROR_SUCCESS
    lpcbData = 255
    r1 = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpData, @lpcbData)
    If r1 = #ERROR_SUCCESS
      Select lType
        Case #REG_SZ
          r1 = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpData, @lpcbData)
          If r1 = #ERROR_SUCCESS
            GetValue = Left(lpData, lpcbData - 1)
          Else
            GetValue = ""
          EndIf
        Case #REG_DWORD
          r1 = RegQueryValueEx_(hKey, sValueName, 0, @lType, @lpDataDWORD, @lpcbData)
          If r1 = #ERROR_SUCCESS
            GetValue = Str(lpDataDWORD)
          Else
            GetValue = ""
          EndIf
      EndSelect
      If r1 = #ERROR_SUCCESS
        Result = #True
      Else
        RegLastError = r1
        RegLastMessage = FormatMessage(RegLastError)
        Result = #False
      EndIf
    Else
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
    EndIf
  Else
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
  EndIf
 
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
 
  ProcedureReturn GetValue
 
EndProcedure

; ***************************************************************************************

Procedure.s Reg_ListSubKey(topKey, sKeyName.s, Index, ComputerName.s = "")

  Protected hKey.l, lhRemoteRegistry.l
  Protected r1.l, Result.l
  Protected lpName.s{256}, ListSubKey.s
  Protected lpcbName.l
  Protected lpftLastWriteTime.FILETIME
 
  RegLastError = 0
 
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
 
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_READ, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn ""
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_READ, @hKey)
  EndIf
 
  If r1 = #ERROR_SUCCESS
    lpcbName = 255
    r1 = RegEnumKeyEx_(hKey, Index, @lpName, @lpcbName, 0, 0, 0, @lpftLastWriteTime)
    If r1 = #ERROR_SUCCESS
      ListSubKey.s = Left(lpName, lpcbName)
    Else
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ListSubKey.s = ""
    EndIf
  Else
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
    ListSubKey.s = ""
  EndIf
 
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
 
  ProcedureReturn ListSubKey

EndProcedure

; ***************************************************************************************

Procedure Reg_DeleteValue(topKey, sKeyName.s, sValueName.s, ComputerName.s = "")
 
  Protected hKey.l, lhRemoteRegistry.l
  Protected r1.l, DeleteValue.l
 
  RegLastError = 0
 
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
 
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_WRITE, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn #False
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_WRITE, @hKey)
  EndIf
 
  If r1 = #ERROR_SUCCESS
    r1 = RegDeleteValue_(hKey, @sValueName)
    If r1 = #ERROR_SUCCESS
      DeleteValue = #True
    Else
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      DeleteValue = #False
    EndIf
  Else
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
    DeleteValue = #False
  EndIf
 
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
 
  ProcedureReturn DeleteValue
 
EndProcedure

; ***************************************************************************************

Procedure Reg_CreateKey(topKey, sKeyName.s, ComputerName.s = "")
 
  ; Result #REG_CREATED_NEW_KEY = 1
  ; Result #REG_OPENED_EXISTING_KEY = 2
 
  Protected hKey.l, lhRemoteRegistry.l
  Protected r1.l, CreateKey.l
  Protected lpSecurityAttributes.SECURITY_ATTRIBUTES
 
  RegLastError = 0
 
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
 
  If ComputerName = ""
    r1 = RegCreateKeyEx_(topKey, sKeyName, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_WRITE, @lpSecurityAttributes, @hKey, @CreateKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn #False
    EndIf
    r1 = RegCreateKeyEx_(lhRemoteRegistry, sKeyName, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_WRITE, @lpSecurityAttributes, @hKey, @CreateKey)
  EndIf
 
  If r1 = #ERROR_SUCCESS
    ;
  Else
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
  EndIf
 
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
 
  ProcedureReturn CreateKey

EndProcedure

; ***************************************************************************************

Procedure Reg_DeleteKey(topKey, sKeyName.s, ComputerName.s = "")
 
  Protected hKey.l, lhRemoteRegistry.l
  Protected r1.l, DeleteKey.l
 
  RegLastError = 0
 
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
 
  If ComputerName = ""
    r1 = RegDeleteKey_(topKey, @sKeyName)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn #False
    EndIf
    r1 = RegDeleteKey_(lhRemoteRegistry, @sKeyName)
  EndIf
 
  If r1 = #ERROR_SUCCESS
    DeleteKey = #True
  Else
    DeleteKey = #False
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
  EndIf
 
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
 
  ProcedureReturn DeleteKey

EndProcedure

; ***************************************************************************************

Procedure.s Reg_ListSubValue(topKey, sKeyName.s, Index, ComputerName.s = "")
 
  Protected hKey.l, lhRemoteRegistry.l
  Protected r1.l, Result.l
  Protected lpName.s{256}, ListSubValue.s
  Protected lpcbName.l
  Protected lpftLastWriteTime.FILETIME
 
  RegLastError = 0
 
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
 
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_READ, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn ""
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_READ, @hKey)
  EndIf
 
  If r1 = #ERROR_SUCCESS
    lpcbName = 255
    r1 = RegEnumValue_(hKey, Index, @lpName, @lpcbName, 0, 0, 0, 0)
    If r1 = #ERROR_SUCCESS
      ListSubValue = Left(lpName, lpcbName)
    Else
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ListSubValue.s = ""
    EndIf
  Else
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
    ListSubValue.s = ""
  EndIf
 
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
 
  ProcedureReturn ListSubValue
   
EndProcedure

; ***************************************************************************************

Procedure Reg_KeyExists(topKey, sKeyName.s, ComputerName.s = "")
   
  Protected hKey.l, lhRemoteRegistry.l
  Protected r1.l, KeyExists.l
 
  RegLastError = 0
 
  If Left(sKeyName, 1) = "\" : sKeyName = Right(sKeyName, Len(sKeyName) - 1) : EndIf
  If Right(sKeyName,1)="\" : sKeyName = Left(sKeyName, Len(sKeyName) - 1) : EndIf
 
  If ComputerName = ""
    r1 = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_READ, @hKey)
  Else
    r1 = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry)
    If r1 <> #ERROR_SUCCESS
      RegLastError = r1
      RegLastMessage = FormatMessage(RegLastError)
      ProcedureReturn #False
    EndIf
    r1 = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_READ, @hKey)
  EndIf
 
  If r1 = #ERROR_SUCCESS
    KeyExists = #True
  Else
    RegLastError = r1
    RegLastMessage = FormatMessage(RegLastError)
    KeyExists = #False
  EndIf
 
  ; Close Key
  RegCloseKey_(hKey)
  ; Close Remote
  If lhRemoteRegistry
    RegCloseKey_(lhRemoteRegistry)
  EndIf
 
  ProcedureReturn KeyExists
 
EndProcedure

; ***************************************************************************************

Procedure Reg_DeleteKeyWithAllSub(topKey,sKeyName.s,ComputerName.s = "")
   
   Protected i.l
   Protected a$="", b$
   
   Repeat
      b$=a$
      a$=Reg_ListSubKey(topKey,sKeyName,0,"")
      If a$<>""
         Reg_DeleteKeyWithAllSub(topKey,sKeyName+"\"+a$,"")
      EndIf
   Until a$=b$
   Reg_DeleteKey(topKey, sKeyName, ComputerName)
EndProcedure

; ***************************************************************************************

Procedure Reg_CreateKeyValue(topKey,sKeyName.s,sValueName.s,vValue.s,lType,ComputerName.s = "")
   Reg_CreateKey(topKey,sKeyName,ComputerName)
   ProcedureReturn Reg_SetValue(topKey,sKeyName,sValueName,vValue,lType,ComputerName)
EndProcedure

; ***************************************************************************************

Procedure AssociateFileEx(AF_Ext$,ext_description$,programm$,icon$,prgkey$,cmd_description$,cmd_key$)
   
   Protected cmd$, key$
   
   cmd$=Chr(34)+programm$+Chr(34)+" "+Chr(34)+"%1"+Chr(34)
   If GetVersion_() & $FF0000 ; Windows NT/XP
      Reg_CreateKeyValue(#HKEY_CLASSES_ROOT, "Applications\"+prgkey$+"\shell\"+cmd_description$+"\command","",cmd$,#REG_SZ,"")
      If ext_description$
         Key$=AF_Ext$+"_auto_file"
         Reg_CreateKeyValue(#HKEY_CLASSES_ROOT  ,"."+AF_Ext$           ,"",Key$            ,#REG_SZ,"")
         Reg_CreateKeyValue(#HKEY_CLASSES_ROOT  ,Key$               ,"",ext_description$,#REG_SZ,"")
         If icon$
            Reg_CreateKeyValue(#HKEY_CLASSES_ROOT,Key$+"\DefaultIcon","",icon$           ,#REG_SZ,"")
         EndIf
      EndIf
      Reg_CreateKeyValue(#HKEY_CURRENT_USER,"Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\."+AF_Ext$,"Application",prgkey$,#REG_SZ,"")
   Else ;Windows 9x
      Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE  ,"Software\Classes\."+AF_Ext$                     ,"",prgkey$         ,#REG_SZ,"")
      If ext_description$
         Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE,"Software\Classes\"+prgkey$                   ,"",ext_description$,#REG_SZ,"")
      EndIf
      If icon$
         Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE,"Software\Classes\"+prgkey$+"\DefaultIcon"    ,"",icon$           ,#REG_SZ,"")
      EndIf
      If cmd_description$<>cmd_key$
         Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE,"Software\Classes\"+prgkey$+"\shell\"+cmd_key$,"",cmd_description$,#REG_SZ,"")
      EndIf
      Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE  ,"Software\Classes\"+prgkey$+"\shell\"+cmd_key$+"\command","",cmd$,#REG_SZ,"")
   EndIf
EndProcedure

; ***************************************************************************************

Procedure Remove_AssociateFile(AF_Ext$,prgkey$)
   
   Protected key$
   
   If GetVersion_() & $FF0000 ; Windows NT/XP
      Reg_DeleteKeyWithAllSub(#HKEY_CLASSES_ROOT,"Applications\"+prgkey$,"")
      key$=AF_Ext$+"_auto_file"
      Reg_DeleteKeyWithAllSub(#HKEY_CLASSES_ROOT,"."+AF_Ext$,"")
      Reg_DeleteKeyWithAllSub(#HKEY_CLASSES_ROOT,key$,"")
      Reg_DeleteKeyWithAllSub(#HKEY_CURRENT_USER,"Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\."+AF_Ext$,"")
   Else ;Windows 9x
      Reg_DeleteKeyWithAllSub(#HKEY_LOCAL_MACHINE  ,"Software\Classes\."+AF_Ext$,"")
      Reg_DeleteKeyWithAllSub(#HKEY_LOCAL_MACHINE,"Software\Classes\"+prgkey$,"")
   EndIf
EndProcedure

; ***************************************************************************************

Procedure AssociateFile(AF_Ext$,ext_description$,programm$,icon$)
   AssociateFileEx(AF_Ext$,ext_description$,programm$,icon$,GetFilePart(programm$),"open","open")
EndProcedure
;#PB_Lit2Msg start

; ***************************************************************************************
Alle Zeiten sind UTC+02:00
Seite 1 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de