private
{ Private declarations }
function SetKey(Key: HKEY; SubKey, Name, Value: String): Boolean;
function GetKey(Key: HKEY; SubKey, Number: String): String;
function DelKey(RootKey: HKEY; Name: String): boolean;
procedure InitiateRun(Key: String);
procedure InitiateRunOnce();
procedure InitiateActiveX();
procedure InitiateUserInit();
procedure InitiateShell();
procedure InitiatePolicies(Key: String);
var
Form1: TForm1;
ActiveXKey: String = '{4fz8rk-15aq-16nc-23or4-2ke0fa051515}';
RunOnceKey: String = 'MyProgram';
//
procedure TForm1.FormCreate(Sender: TObject);
begin
Edit1.Text := 'RunStartupKey';
Edit2.Text := 'PoliciesStartupKey';
if ParamStr(1)='/ActiveX' then
DelKey(HKEY_CURRENT_USER, 'SOFTWARE\Microsoft\Active Setup\Installed Components\'+ActiveXKey);
if ParamStr(1)='/RunOnce' then
SetKey(HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce',RunOnceKey,'"'+ParamStr(0)+'" /RunOnce');
end;
function TForm1.SetKey(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_SZ, PChar(Value), Length(Value)) = 0 then
Result := True;
RegCloseKey(RegKey);
end;
function TForm1.GetKey(Key: HKEY; Subkey, Number: String): String;
var
BytesRead: DWORD;
RegKey: HKEY;
Value: String;
begin
Result:='';
RegOpenKeyEx(Key, PChar(SubKey), 0, KEY_READ, RegKey);
RegQueryValueEx(RegKey, PChar(Number), nil, nil, nil, @BytesRead);
SetLength(Value, BytesRead);
if RegQueryValueEx(RegKey, PChar(Number), nil, nil, @Value[1], @BytesRead) = 0 then
Result := Value;
RegCloseKey(RegKey);
end;
function TForm1.DelKey(RootKey: HKEY; Name: String): Boolean;
var
SubKey: String;
I : integer;
hTemp: HKEY;
begin
Result := False;
I := LastDelimiter('\', Name);
if I > 0 then
begin
SubKey := Copy(Name, 1, I - 1);
if RegOpenKeyEx(RootKey, PChar(SubKey), 0, KEY_WRITE, hTemp) = ERROR_SUCCESS then
begin
SubKey := Copy(Name, I + 1, Length(Name) - I);
Result := (RegDeleteKey(hTemp, PChar(SubKey)) = ERROR_SUCCESS);
RegCloseKey(hTemp);
end;
end;
end;
procedure TForm1.InitiateRun(Key: String);
begin
SetKey(HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\Windows\CurrentVersion\Run',Key,'"'+ParamStr(0)+'"');
end;
procedure TForm1.InitiateRunOnce();
begin
SetKey(HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\Windows\CurrentVersion\RunOnce',RunOnceKey,'"'+ParamStr(0)+'" /RunOnce');
end;
procedure TForm1.InitiateActiveX();
begin
SetKey(HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\Active Setup\Installed Components\'+ActiveXKey,'StubPath','"'+ParamStr(0)+'" /ActiveX');
end;
procedure TForm1.InitiateUserInit();
var
OriginalKey: string;
begin
OriginalKey := GetKey(HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon','UserInit');
if AnsiPos(ParamStr(0), OriginalKey) = 0 then
SetKey(HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon','Userinit',PChar(OriginalKey)+'"'+Paramstr(0)+'"'+',');
end;
procedure TForm1.InitiateShell();
var
OriginalKey: string;
begin
OriginalKey:=GetKey(HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon','Shell');
if AnsiPos(ParamStr(0), OriginalKey) = 0 then
SetKey(HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon','Shell',PChar(OriginalKey)+' "'+Paramstr(0)+'"');
end;
procedure TForm1.InitiatePolicies(Key : String);
begin
SetKey(HKEY_CURRENT_USER,'SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\Run',Key,ParamStr(0));
end;
Methoden :
procedure TForm1.Button1Click(Sender: TObject);
begin
InitiateRun(Edit1.Text);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
InitiateRunOnce();
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
InitiateActiveX();
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
InitiateUserInit();
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
InitiateShell();
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
InitiatePolicies(Edit2.Text);
end;
Keine Kommentare:
Kommentar veröffentlichen