unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, uallHook, uallProcess, uallUtil, uallKernel;
type
TfrmMain =
class(TForm)
lbl1: TLabel;
tmrSearchCondor: TTimer;
mmo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure tmrSearchCondorTimer(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private-Deklarationen }
fCondorPID : DWord;
fInjected : Boolean;
fDontWork : Boolean;
procedure SearchCondor;
procedure InjectMyFunctions;
procedure UnloadMyFunctions;
function GetDebugPrivileges : Boolean;
procedure WriteText(s :
string);
procedure WMNOTIFYCD(
var Msg: TWMCopyData);
message WM_COPYDATA;
public
{ Public-Deklarationen }
end;
var
frmMain: TfrmMain;
ChangeWindowMessageFilter:
function (msg : Cardinal; dwFlag : Word) : BOOL;
stdcall;
implementation
{$R *.dfm}
type Tmydata =
packed record
datacount: integer;
ind: boolean;
end;
const cCondorApplication = '
notepad.exe';
cinjComFuntionsDLL = '
injComFunctions.dll';
var myData : TMydata;
procedure TfrmMain.WMNOTIFYCD(
var Msg: TWMCopyData);
begin
if Msg.CopyDataStruct^.cbData = sizeof(TMydata)
then
begin
CopyMemory(@myData,Msg.CopyDataStruct^.lpData,sizeof(TMyData));
WriteText(IntToStr(mydata.datacount))
end;
end;
procedure TfrmMain.WriteText(s :
string);
begin
mmo1.Lines.Add(DateTimeToStr(now) + '
:> ' + s);
end;
procedure TfrmMain.InjectMyFunctions;
begin
if not fInjected
then begin
if InjectLibrary(fCondorPID, PChar(GetExeDirectory + cinjComFuntionsDLL))
then fInjected := True;
end;
end;
procedure TfrmMain.UnloadMyFunctions;
begin
if fInjected
then begin
UnloadLibrary(fCondorPID, PChar(GetExeDirectory + cinjComFuntionsDLL));
fInjected := False;
end;
end;
procedure TfrmMain.SearchCondor;
begin
fCondorPID := FindProcess(cCondorApplication);
if fCondorPID <> 0
then begin
lbl1.Caption := '
Notepad is running!';
InjectMyFunctions;
end else begin
lbl1.Caption := '
Notepad isn''
t running!';
end;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
UnloadMyFunctions;
end;
function TfrmMain.GetDebugPrivileges : Boolean;
begin
Result := False;
if not SetDebugPrivilege(SE_PRIVILEGE_ENABLED)
then begin
Application.MessageBox('
No Debug rights!', '
Error', MB_OK);
end else begin
Result := True;
end;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
@ChangeWindowMessageFilter := GetProcAddress(LoadLibrary('
user32.dll'), '
ChangeWindowMessageFilter');
ChangeWindowMessageFilter(WM_COPYDATA, 1);
fInjected := False;
fDontWork :=
not GetDebugPrivileges;
tmrSearchCondor.Enabled :=
not fDontWork;
end;
procedure TfrmMain.tmrSearchCondorTimer(Sender: TObject);
begin
tmrSearchCondor.Enabled := False;
SearchCondor;
tmrSearchCondor.Enabled := True;
end;
end.