Здоровеньки булы, -=[-B0rMaN-]=-!
3 мая 2004 г., понедельник, 20:56:28 (GMT+05:00), пришел ко мне
почтальон Почкин и всучил письмо с пометкой "Delphi Registry",
в котором сообщалось следующее:
B> Reg := TRegistry.Create;
B> try
B> Reg.RootKey := HKEY_CURRENT_USER;
B> if Reg.SaveKey('Software','d:\1') then ShowMessage('OK!');
B> finally
B> Reg.Free;
B> inherited;
B> end;
SaveKey - лажа полная, IMHO будет работать только в win9x/Me (и то я
не уверен, а проверять лень) в NT-хах работать не будет по определению.
Сразу определюсь:
а) файл в который будет сохраняться ключ - это не тот
который получается сохранением в regedit;
б) Если ключ открыт - сохранит, но загрузить не сможет (а открытым
держать ключ может кто угодно)
в) В NT-хах (NT 4.0, Win2000, WinXP) нужно сидеть либо под админом,
либо под системой, либо под оператором архива. В Win9x/Me - не
пробовал.
Если пункт а) тебя не устраивает юзай следующее:
Save.bat:
regedit /e Save.reg HKEY_CURRENT_USER\SoftWare\Borland
Если пункты а) и в) не проблема, то держи код:
function GetErrorMessage(ErrorCode: integer): string;
const BUFFER_SIZE = 1024;
var lpMsgBuf: Pchar;
LangID: DWORD;
begin
lpMsgBuf := AllocMem(BUFFER_SIZE);
LangID := GetUserDefaultLangID;
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS,
nil, ErrorCode, LangID, lpMsgBuf, BUFFER_SIZE, nil);
Result := StrPas(lpMsgBuf);
FreeMem(lpMsgBuf);
end;
function GetBackupPrivileges: DWORD; stdcall;
var hToken: THandle;
tp: _TOKEN_PRIVILEGES;
returnLength: Cardinal;
begin
if OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken)
then
if LookupPrivilegeValue(nil, 'SeBackupPrivilege', tp.Privileges[0].Luid)
then
begin
tp.PrivilegeCount := 1;
tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges(hToken, false, tp, 0, nil, returnLength)
end;
Result := GetLastError;
end;
function SaveKey(RootKey: HKEY; Key: String; FileName: string): DWORD;
var regKey: HKEY;
begin
if FileExists(FileName) then DeleteFile(FileName);
Result := RegOpenKeyEx(RootKey, PChar(Key), 0, KEY_ALL_ACCESS, regKey);
if Result = ERROR_SUCCESS then
try
Result := GetBackupPrivileges;
if Result = ERROR_SUCCESS
then Result := RegSaveKey(regKey, PChar(FileName), nil);
finally
RegCloseKey(regKey);
end;
end;
function GetRestorePrivileges: DWORD; stdcall;
var hToken: THandle;
tp: _TOKEN_PRIVILEGES;
returnLength: Cardinal;
begin
if OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken)
then
if LookupPrivilegeValue(nil, 'SeRestorePrivilege', tp.Privileges[0].Luid)
then
begin
tp.PrivilegeCount := 1;
tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges(hToken, false, tp, 0, nil, returnLength)
end;
Result := GetLastError;
end;
function LoadKey(RootKey: HKEY; Key: String; FileName: string): DWORD;
var regKey: HKEY;
begin
Result := RegOpenKeyEx(RootKey, PChar(Key), 0, KEY_ALL_ACCESS, regKey);
if Result = ERROR_FILE_NOT_FOUND then
Result := RegCreateKey(RootKey, PChar(Key), regKey);
if Result = ERROR_SUCCESS then
try
Result := GetRestorePrivileges;
if Result = ERROR_SUCCESS
then Result := RegRestoreKey(regKey, PChar(FileName), 0);
finally
RegCloseKey(regKey);
end;
end;
procedure TForm1.SaveButtonClick(Sender: TObject);
begin
// ShowMessage(GetErrorMessage(SaveKey(HKEY_CURRENT_USER, 'Software\1', 'd:\reg')));
ShowMessage(
GetErrorMessage(
SaveKey(
HKEY_CURRENT_USER,
'Software\Borland\Delphi',
ExtractFilePath(Paramstr(0))+'reg'
)
)
);
end;
procedure TForm1.LoadButtonClick(Sender: TObject);
begin
// ShowMessage(GetErrorMessage(LoadKey(HKEY_CURRENT_USER, 'Software\1', 'd:\reg')));
ShowMessage(
GetErrorMessage(
LoadKey(
HKEY_CURRENT_USER,
'Software\Borland\Delphi',
ExtractFilePath(Paramstr(0))+'reg'
)
)
);
end;
