zurückschreiben kann. Als Beispiele ist hier eine Outlooksicherung der Konten,
wobei zwar die Passwörter mit gespeichert werden, aber wohl durch MS verhindert werden
erneut in die Registry zu kopiert zu werden. Diese müsste man dann von Hand manuell eingeben.
Bei diesem Beispiel ist es wichtig, das man in Compileroptionen auf Administrator-Modus ...
einstellt. Sonst wird nichts gespeichert.
Warnung! Mit diesen Funktionen sollte derjenige arbeiten, der weißl, was man
in die Registry ändert. Ansonsten würde bei Unwissenheit Windows nicht mehr starten.
Also bitte mit Vorsicht diese Funktionen (besonders das speichern) benutzen.
Code: Alles auswählen
; PureBasic Visual Designer v3.95 build 1485 (PB4Code)
;VBA-Beispiel aus: http://www.ex-designz.net/apidetail.asp?api_id=552
;Umgewandelt aus dem VBA-Beispiel und hinzunahme zweier Proceduren
; GetLastError und EnablePrivilege aus dem englischen Forum von Falko Lünsmann
; Sichern und zurückschreiben der Outlookkonten (Einstellungen und Passwörter)
;
;- Window Constants
;
#SE_BACKUP_NAME = "SeBackupPrivilege"
File$=GetCurrentDirectory()+"OutlookKonten.bac"
key$="Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676"
#SE_RESTORE_NAME = "SeRestorePrivilege"; Important for what we're trying to accomplish
#REG_FORCE_RESTORE = 8 ; Almost as import, will allow you to restore over a key while it's open!
Enumeration
#Window_0
EndEnumeration
;- Gadget Constants
;
Enumeration
#Button_0
#Button_1
EndEnumeration
Procedure Open_Window_0()
If OpenWindow(#Window_0, 220, 0, 383, 104, "Outlook Backup ", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
ButtonGadget(#Button_0, 30, 30, 140, 50, "Outlook-Konten sichern")
ButtonGadget(#Button_1, 190, 30, 180, 50, "Outlook-Konten zurück schreiben")
EndIf
EndProcedure
Procedure.s GetLastError(Err.l)
Protected buffer.l=0,ferr.l,errormsg$=""
ferr=FormatMessage_(#FORMAT_MESSAGE_ALLOCATE_BUFFER|#FORMAT_MESSAGE_FROM_SYSTEM,0,Err,GetUserDefaultLangID_(),@buffer,0,0)
If buffer<>0
errormsg$=PeekS(buffer)
LocalFree_(buffer)
errormsg$=RemoveString(errormsg$,Chr(13)+Chr(10))
EndIf
ProcedureReturn errormsg$
EndProcedure
Procedure.l EnablePrivilege(Privilege.s,Enable.l=1)
Protected Res.l
Protected hToken.l, hProcess.l
Protected tTP.TOKEN_PRIVILEGES, tTPOld.TOKEN_PRIVILEGES, lTpOld.l
Protected Success.l
Res = LookupPrivilegeValue_(0, Privilege, @tLUID.LUID)
If Res
hProcess = GetCurrentProcess_()
If hProcess
Res = OpenProcessToken_(hProcess, #TOKEN_ADJUST_PRIVILEGES | #TOKEN_QUERY, @hToken)
If Res
With tTP
\PrivilegeCount = 1
If Enable
\Privileges[0]\Attributes = #SE_PRIVILEGE_ENABLED
Else
\Privileges[0]\Attributes = 0
EndIf
\Privileges[0]\Luid\LowPart = tLUID\LowPart
\Privileges[0]\Luid\HighPart = tLUID\HighPart
EndWith
Res = AdjustTokenPrivileges_(hToken, 0, @tTP, SizeOf(tTP), @tTPOld, @lTpOld)
If Res
Success=1
EndIf
CloseHandle_(hToken)
EndIf
EndIf
EndIf
If Success
If Enable
Debug Privilege+" enabled"
Else
Debug Privilege+" disabled"
EndIf
Else
Err=GetLastError_()
If Enable
Debug Privilege+" not enabled ("+GetLastError(Err)+")"
Else
Debug Privilege+" not disabled ("+GetLastError(Err)+")"
EndIf
EndIf
ProcedureReturn Success
EndProcedure
Procedure.l RestoreKey(sKeyName.s,sFileName.s,lPedifinedKey.l)
Protected Result.l
If EnablePrivilege(#SE_RESTORE_NAME) = #False
Goto raus2
EndIf
Protected hKey.l,lRetVal.l
RegOpenKeyEx_(lPredefinedKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey) ; Must open key to save it
;The file it's restoring from was created using the RegSaveKey function
RegRestoreKey_(hKey,sFileName,#REG_FORCE_RESTORE)
RegCloseKey_(hKey)
raus2:
ProcedureReturn
EndProcedure
Procedure.l SaveKey(sKeyName.s, sFileName.s, lPredefinedKey.l)
Protected Result.l
If EnablePrivilege(#SE_BACKUP_NAME) = #False
Goto raus
EndIf
Protected hKey.l,lRetVal.l
Error.l=RegOpenKeyEx_(lPredefinedKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey) ; Must open key to save it
Debug GetLastError(Error)
;Don't forget To "KILL" any existing files before trying To save the registry key!
If GetFilePart(sFileName)<>""
Debug GetFilePart(sFileName)
DeleteFile("OutlookKonten.reg")
RegSaveKey_(hKey, sFileName, #Null)
EndIf
RegSaveKey_(hKey, sFileName,#Null)
RegCloseKey_(hKey); Don't want To keep the key ope. It causes problems.
raus:
ProcedureReturn
EndProcedure
Open_Window_0()
Repeat ; Start of the event loop
Event = WaitWindowEvent() ; This line waits until an event is received from Windows
WindowID = EventWindow() ; The Window where the event is generated, can be used in the gadget procedures
GadgetID = EventGadget() ; Is it a gadget event?
EventType = EventType() ; The event type
;You can place code here, and use the result as parameters for the procedures
If Event = #PB_Event_Gadget
If GadgetID = #Button_0
Error=SaveKey(key$,File$,#HKEY_CURRENT_USER)
GetLastError(Error)
MessageRequester("ErrorLevel",GetLastError(Error))
ElseIf GadgetID = #Button_1
Error=RestoreKey(key$,File$,#HKEY_CURRENT_USER)
MessageRequester("ErrorLevel",GetLastError(Error))
EndIf
EndIf
Until Event = #PB_Event_CloseWindow ; End of the event loop
End
;
