// Przykład jak Zapisywać, usuwać i odczytywać wartości z rejestru

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Registry,KeySpy, StdCtrls, ExtCtrls, ComCtrls, jpeg, Buttons;

type

TForm1 = class(TForm)

KeySpy1: TKeySpy;

SpeedButton1: TSpeedButton;

SpeedButton2: TSpeedButton;

Image2: TImage;

Addbtn: TSpeedButton;

Removebtn: TSpeedButton;

Panel1: TPanel;

ListBox1: TListBox;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

hidebtn: TSpeedButton;

refreshbtn: TSpeedButton;

Closebtn: TSpeedButton;

Label4: TLabel;

Label5: TLabel;

Label6: TLabel;

OpenDialog1: TOpenDialog;

Edit1: TEdit;

procedure KeySpy1Keyword(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure ClosebtnClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure AddbtnClick(Sender: TObject);

procedure RemovebtnClick(Sender: TObject);

procedure refreshbtnClick(Sender: TObject);

procedure ListBox1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

const //Ukrywa proces

RSPSIMPLESERVICE = 1;

RSPUNREGISTERSERVICE = 0;

function RegisterServiceProcess (dwProcessID, dwType: DWord) : DWord;

stdcall; external 'KERNEL32.DLL'; //Koniec ukrywania procesu

procedure TForm1.KeySpy1Keyword(Sender: TObject);

begin

if Visible=true then //Jezeli forma widoczna to ukryj

Visible:=false else //Jezeli nie widoczna pokaz

Visible:=true;

end;

//registry

//l=MyKey p=MyField w=MyValue

procedure RegWrite(l, p, w: string);

var

Reg: TRegistry;

begin

//Create the Object

Reg := TRegistry.Create;

with Reg do

begin

//Sets the destination for our requests

RootKey := HKEY_LOCAL_MACHINE;

//Check if we can open our key, if the key doesn't exist, we create it

if OpenKey(l, True) then

//We don't need to check if the field is available because the

//field is created by writing the value

WriteString(p, w)

else

//There is a big error if we gets an errormessage by

//opening/creating the key

ShowMessage('Error opening/creating key : ' + l);

CloseKey;

end;

function RegRead(l, p: string): string;

var

Reg: TRegistry;

begin

//Create the Object

Reg := TRegistry.Create;

with Reg do

begin

//Sets the destination for our requests

RootKey := HKEY_LOCAL_MACHINE;

//Check if whe can open our key, if the key dosn't exist, we create it

if OpenKey(l, True) then

begin

//Is our field availbe

if ValueExists(p) then

//Read the value from the field

Result := Readstring(p)

else

ShowMessage(p + ' does not exists under ' + l);

end

else

//There is a big error if we get an errormessage by

//opening/creating the key

ShowMessage('Error opening/creating key : ' + l);

CloseKey;

end;

procedure TForm1.FormActivate(Sender: TObject);

var

reg: TRegistry;

begin

// Application.Minimize; //te dwa ukrywaja forme

// ShowWindow(Application.Handle,SW_HIDE);

RegisterServiceProcess(GetCurrentProcessID, RSPSIMPLESERVICE); //Ukrywa proces pod Win98

(* reg := TRegistry.Create; // AUTOSTART

reg.RootKey := HKEY_LOCAL_MACHINE;

reg.LazyWrite := false;

reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',

false);

reg.WriteString('norun.exe', Application.ExeName);

reg.CloseKey;

reg.free; *) //autostart koniec.

end;

procedure TForm1.ClosebtnClick(Sender: TObject);

begin

application.Terminate;

end;

procedure TForm1.FormCreate(Sender: TObject);

var

Reg: TRegistry;

Val:TStringList;

I:Integer;

begin

SetWindowLong( Handle, //ukrycia menu min max,zamknij

GWL_STYLE,

GetWindowLong( Handle, GWL_STYLE )

and not WS_CAPTION );

ClientHeight := Height;

//Listowanie klucza:

Reg:=TRegistry.Create;

try

Val:=TStringList.Create;

try

Reg.RootKey:=HKEY_LOCAL_MACHINE; // Section to look for within the registry

if not Reg.OpenKey('Software\Norun\',False) then

ShowMessage('Error opening key')

else

begin

Reg.GetValueNames(Val);

for I:=0 to Val.Count-1 do

begin

listbox1.Items.Add(Val.Strings[I]) ;

(* albo razem z wartościami pola:

(Val.Strings[I]+' Value '+Reg.ReadString(Val.Strings[I])); *)

end;

finally

Val.Free;

end;

finally

Reg.Free;

end;

procedure TForm1.AddbtnClick(Sender: TObject);

begin

if Opendialog1.Execute then

RegWrite('SOFTWARE\Norun\', Opendialog1.FileName,Opendialog1.FileName);

end;

procedure TForm1.RemovebtnClick(Sender: TObject);

var

Reg: TRegistry;

Val:TStringList;

// n:Integer;

begin

//Listowanie klucza:

Reg:=TRegistry.Create;

try

Val:=TStringList.Create;

try

Reg.RootKey:=HKEY_LOCAL_MACHINE; // Section to look for within the registry

if not Reg.OpenKey('Software\Norun\',False) then

ShowMessage('Error opening key')

else

begin

Reg.GetValueNames(Val);

reg.DeleteValue(Edit1.Text);

(* Pole :Val.Strings[I]+' Value: '+Reg.ReadString(Val.Strings[I])); *)

end;

finally

Val.Free;

end;

finally

Reg.Free;

end;

procedure TForm1.refreshbtnClick(Sender: TObject);

var

Reg: TRegistry;

Val:TStringList;

I:Integer;

begin

Listbox1.Items.Clear;

Reg:=TRegistry.Create;

try

Val:=TStringList.Create;

try

Reg.RootKey:=HKEY_LOCAL_MACHINE; // Section to look for within the registry

if not Reg.OpenKey('Software\Norun\',False) then

ShowMessage('Error opening key')

else

begin

Reg.GetValueNames(Val);

for I:=0 to Val.Count-1 do

begin

listbox1.Items.Add(Val.Strings[I]) ;

end;

finally

Val.Free;

end;

finally

Reg.Free;

end;

procedure TForm1.ListBox1Click(Sender: TObject);

var

n:integer;

begin

n:=Listbox1.itemindex;

Edit1.Text:=Listbox1.Items.Strings[n];

end;

end.

//Kill process XP/2000/98/Me (ale chyba nie dla NT ?, jest jeszcze jeden algorytm dla NT

function KillTask(ExeFileName: string): Integer;

const

PROCESS_TERMINATE = $0001;

var

ContinueLoop: BOOL;

FSnapshotHandle: THandle;

FProcessEntry32: TProcessEntry32;

begin

Result := 0;

FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);

FProcessEntry32.dwSize := SizeOf(FProcessEntry32);

ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);

while Integer(ContinueLoop) <> 0 do

begin

if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =

UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) =

UpperCase(ExeFileName))) then

Result := Integer(TerminateProcess(

OpenProcess(PROCESS_TERMINATE,

BOOL(0),

FProcessEntry32.th32ProcessID),

0));

ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);

end;

CloseHandle(FSnapshotHandle);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

var

k: integer;

begin

k:=Listbox1.Count;

for k:=0 to k-1 do

killtask(Listbox1.Items.Strings[k]);

end;

end.