Witam, napisałem sobie globalnego hook'a na komponencie madhook który ma kontrolować jakie programy są uruchamiane i czy im na to pozwolić. i mam problem bo czasami (zbyt często) występuje błąd explorer.exe że wykonał nieodpowiednią operacje lub że odwołuje sie do pamięci coś tam...
oto kod tego programu:
library Project2;
{$R *.RES}
uses
forms,stdctrls,extctrls,Controls,Graphics,
SysUtils,
Classes,
Windows,
madCodeHook, DCPcrypt2, DCPmd5;
// ***************************************************************
type tform1=class(tform)
procedure a(sender:tobject);
procedure b(sender:tobject);
procedure c(sender:tobject);
procedure d(sender:tobject);
end;
var
label1:tlabel;
form1,form2:tform;
form:tform1;
memo:tmemo;
button1,button2,button3,button4:tbutton;
radio1,radio2,radio3:tradiobutton;
panel:tpanel;
dane:integer;
procedure tform1.a (Sender: TObject);
begin
if not((radio1.Checked)or(radio2.Checked)) then
messageboxw(0,'Musisz wybrac cały program albo tylko argumenty','?',MB_ok) else begin
dane:=1;
form1.close;
end;end;
procedure tform1.b (Sender: TObject);
begin
if not((radio1.Checked)or(radio2.Checked)) then
messageboxw(0,'Musisz wybrac cały program albo tylko argumenty','?',MB_ok) else begin
dane:=2;
form1.close;
end;end;
procedure tform1.c (Sender: TObject);
begin
if not((radio1.Checked)or(radio2.Checked)) then
messageboxw(0,'Musisz wybrac cały program albo tylko argumenty','?',MB_ok) else begin
dane:=3;
form1.close;
end;end;
procedure tform1.d (Sender: TObject);
begin
if not((radio1.Checked)or(radio2.Checked)) then
messageboxw(0,'Musisz wybrac cały program albo tylko argumenty','?',MB_ok) else begin
dane:=4;
form1.close;
end; end;
function IsAllowed(appNameA, cmdLineA: pchar; appNameW, cmdLineW: PWideChar) : boolean;
var arrChA : array [0..MAX_PATH] of char;
arrChW : array [0..500] of wideChar;
pc : pchar;
x1024:array [0..1024] of char;
x2048,x:array [0..2048] of char;
question,xn ,xn2,czyt: array [0..500] of char;
i1, i2,a ,c,j : integer;
f,f2:textfile;
b:integer;
g:char;
data: OFSTRUCT;
plik:HFILE;
traq:boolean;
md5: tdcp_md5 ;
ove:Overlapped ;
znam:boolean;
rez:integer;
dane2,i:integer;
ptext, tx,sin,sout,sout2,x2,x1:string;
pcol:tcolor;
begin
if not AmSystemProcess then begin
ptext:='Nieznany program';
pcol:=clblack;
znam:=false;
dane:=0;
form1:=tform.Create(nil);
form1.Height:=300;
form1.width:=450;
form1.Position:=poScreenCenter ;
form1.BorderStyle :=bsToolWindow ;
form1.BorderIcons:=[];
form2:=tform.Create(nil);
form2.Height:=300;
form2.width:=450;
form2.Position:=poScreenCenter ;
form2.BorderStyle :=bsToolWindow ;
form2.BorderIcons:=[];
md5:=tdcp_md5.Create(form2);
md5.Init;
if GetVersion and $80000000 = 0 then begin
GetModuleFileNameW(0, arrChW, MAX_PATH);
WideToAnsi(arrChW, arrChA);
end else
GetModuleFileNameA(0, arrChA, MAX_PATH);
i2 := 0;
for i1 := lstrlena(arrChA) - 1 downto 0 do
if arrChA[i1] = '\' then begin
i2 := i1 + 1;
break;
end;
lstrcpya(question, 'Program ');
lstrcata(question, @arrChA[i2]);
lstrcata(question, ' próbuje uruchomic' + #$D#$A + #$D#$A);
try
if cmdLineA <> nil then begin
pc := pointer(LocalAlloc(LPTR, lstrlena(cmdLineA) + 1));
lstrcpya(pc, cmdLineA);
end else
if cmdLineW <> nil then begin
pc := pointer(LocalAlloc(LPTR, lstrlenW(cmdLineW) + 1));
WideToAnsi(cmdLineW, pc)
end else
if appNameA <> nil then begin
pc := pointer(LocalAlloc(LPTR, lstrlenA(appNameA) + 1));
lstrcpyA(pc, appNameA);
end else begin
pc := pointer(LocalAlloc(LPTR, lstrlenW(appNameW) + 1));
WideToAnsi(appNameW, pc);
end;
if lstrlenA(pc) > MAX_PATH then
pc[MAX_PATH] := #0;
lstrcata(question, pc);
except
lstrcata(question, '???');
end;
begin
WideToAnsi(appNameW, xn);
end;
lstrcata(question, #$D#$A);
plik:= windows.OpenFile(xn,data,OF_READ);
b:= windows.GetFileSize(plik,nil);
if b > -1 then begin
lstrcata(question,'Rozmiar: ');
lstrcatA(question, pchar(inttostr(B)));
lstrcatA(question,' bajtów (');
lstrcatA(question, pchar(inttostr(B div 1024)));
lstrcatA(question,' KB)');
end else
begin
lstrcatA(question,'Nieznany rozmiar');
sin:=pc;
md5.Updatestr(sin);
md5.final(xn);
sout:=xn;
md5.Burn;
md5.Init;
sout2:='';
for j:=1 to length(sout) do begin
sout2:=sout2+inttohex(integer(sout[j]),2);
end;
xn:='c:\';
lstrcata(xn,pchar(sout2));
lstrcata(xn,'.appf');
lstrcata(question,pchar( #$D#$A+'Hash nazwy(md5): '+sout2));
end;
_lclose(plik);
if sysutils.fileexists(''+xn+'.appf')<>true then
begin
assignfile(f,xn+'.appf');
rewrite(f);
closefile(f);
end else begin
ove.Offset:=0;
ove.OffsetHigh:=0;
assignfile(f,xn+'.appf');
reset(f);
while not eof (f) do begin
readln(f,tx);
if ((tx='*') or (tx=pc)) then begin
readln(f,tx);//hash
begin
sout2:='---HASH---';
ove.Offset:=0;
ove.Offsethigh:=0;
plik:=windows.OpenFile((xn),data,OF_READ );
// if windows.ReadFileEx(plik,@x1024,1024,@ove,nil)=true then
if windows.ReadFileEx(plik,@x,2048,@ove,nil) =true
then
begin
_lclose(plik);
md5.Update(x,sizeof(x));
md5.Final(x);
x1:=x;
x2:='';
for i:= 1 to length(x1) do
x2:=x2+inttohex(integer(x1[i]),2);
md5.Burn;
md5.Init;
traq:=x2=tx;
end else traq:=true
end;
if traq then begin
readln(f,tx);//size
if inttostr(b)=tx then begin
readln(f,tx);
if pos('+',tx)>0 then
begin
znam:=true;
result:=true;
end
else
if pos('-',tx)>0 then
begin
znam:=true;
result:=false;
end
end else begin ptext:='UWAGA: program'+#$D#$A+'zmienił rozmiar'; pcol:=clred; lstrcatA(question,pchar(#$D#$A+'Program zmienił rozmiar, stary rozmiar: '+tx)); end;
end else begin ptext:='UWAGA: program'+#$D#$A+'zmienił hash'; pcol:=clred; lstrcatA(question,pchar(#$D#$A+'Program zmienił hash')); end;
end;
end;
closefile(f);
// MessageBox(0,'after reset','DEBUG',MB_OK);
// lstrcpyA(xn2,pchar(inttostr(filesize(f))));
// MessageBox(0,'after fs','DEBUG',MB_OK);
// MessageBox(0,'after close','DEBUG',MB_OK);
// lstrcatA(question, #$D#$A + 'Rozmiar: ');
// lstrcatA(question, xn2);
// lstrcatA(question, #$D#$A + #$D#$A +'Uruchomic?');
end;
button1:=tbutton.Create(form1);
button2:=tbutton.Create(form1);
button3:=tbutton.Create(form1);
button4:=tbutton.Create(form1);
button1.Parent:=form1;
button2.Parent:=form1;
button3.Parent:=form1;
button4.Parent:=form1;
button1.Caption:='Uruchom 1x';
button2.Caption:='Zablokuj 1x';
button3.Caption:='Uruchamiaj zawsze';
button4.Caption:='Blokuj zawsze';
button1.width:=102;
button2.width:=102;
button3.width:=102;
button4.width:=102;
button1.top:=(form1.height-button1.height)-40;
button2.top:=(form1.height-button1.height)-40;
button3.top:=(form1.height-button1.height)-40;
button4.top:=(form1.height-button1.height)-40;
button2.Left:= button1.Width+10+button1.left;
button3.Left:= button2.Width+10+button2.left;
button4.Left:= button3.Width+10+button3.left;
//radio
radio1:=tradiobutton.Create(form1);
radio2:=tradiobutton.Create(form1);
radio3:=tradiobutton.Create(form1);
radio1.Parent:=form1;
radio2.Parent:=form1;
radio3.Parent:=form1;
radio1.Caption:='Cały program';
radio2.Caption:='Program + te argumenty';
radio3.Caption:='---UNKNOWN---';
//radio2.hide;
radio3.Hide;
radio1.width:=102;
//radio1.Checked:=true;
radio2.width:=152;
radio3.width:=102;
radio1.left:=40;
radio2.left:=40;
radio3.left:=40;
radio1.top:=120;
radio2.top:= radio1.height+10+radio1.top;
radio3.top:= radio2.height+10+radio2.top;
panel:=tpanel.create(form1);
panel.Parent:=form1;
panel.Align :=alTop ;
panel.Height:=panel.Height+20;
panel.Color:=clNavy;
panel.Font.Color:=clwhite;
panel.Caption:='Applications FIREWALL 0.3 beta';
memo:=tmemo.Create(form1);
memo.Parent:=form1;
memo.Top:=10+panel.Height;
label1:=tlabel.Create(form1);
label1.Parent:=form1;
label1.Top:=15+panel.Height;
label1.left:=1;
label1.Font.Size:=15;
label1.Caption:=ptext;
label1.Font.Color:=pcol;
memo.left:= 40+152;
memo.height:=120;
memo.width:=250;
memo.ReadOnly:=true;
memo.text:=question;
memo.ScrollBars:=ssVertical ;
button1.OnClick:=form.a;
button2.OnClick:=form.b;
button3.OnClick:=form.c;
button4.OnClick:=form.d;
if not znam then
form1.Showmodal;
dane2:=0;
if radio1.Checked then
dane2:=1;
if radio2.Checked then
dane2:=2;
//koniec;
button1.Destroy;
button1:=nil;
button2.Destroy;
button2:=nil;
button3.Destroy;
button3:=nil;
button4.Destroy;
button4:=nil;
radio1.Destroy;
radio1:=nil;
radio2.Destroy;
radio2:=nil;
radio3.Destroy;
radio3:=nil;
panel.Destroy;
panel:=nil;
form1.Destroy;
form1:=nil;
if not znam then
if ((dane=3) or (dane=4)) then
begin
begin
assignfile(f,xn+'.appf');
append(f);
c:=1;
if dane2=1 then writeln(f,'*') else
if dane2=2 then writeln(f,(pc));
sout2:='---HASH---';
ove.Offset:=0;
ove.Offsethigh:=0;
plik:=windows.OpenFile((xn),data,OF_READ );
if windows.ReadFileEx(plik,@x,2048,@ove,nil) =true then
begin
_lclose(plik);
md5.Update(x,sizeof(x));
md5.Final(x);
x1:=x;
x2:='';
for i:= 1 to length(x1) do
x2:=x2+inttohex(integer(x1[i]),2);
md5.Burn;
md5.Init;
end;
writeln(f,x2);
writeln(f,inttostr(b));
if dane = 3 then
g:='+' else g:='-' ;
ove.Offset:=0;
writeln(f,g);
closefile(f);
end; end;
if not znam then
result:=((dane= 1)or(dane=3));
LocalFree(dword(pc));
form2.Destroy;
form2:=nil;
end else
result := true;
end;
// ***************************************************************
var
CreateProcessHookProc:function (applicationName : pchar;
commandLine : pchar;
processAttr : PSecurityAttributes;
threadAttr : PSecurityAttributes;
inheritHandles : bool;
creationFlags : dword;
environment : pointer;
currentDirectory : pchar;
const startupInfo : TStartupInfo;
var processInfo : TProcessInformation) : bool; stdcall;
CreateProcessANext : function (appName, cmdLine: pchar;
processAttr, threadAttr: PSecurityAttributes;
inheritHandles: bool; creationFlags: dword;
environment: pointer; currentDir: pchar;
const startupInfo: TStartupInfo;
var processInfo: TProcessInformation) : bool; stdcall;
CreateProcessWNext : function (appName, cmdLine: pwidechar;
processAttr, threadAttr: PSecurityAttributes;
inheritHandles: bool; creationFlags: dword;
environment: pointer; currentDir: pwidechar;
const startupInfo: TStartupInfo;
var processInfo: TProcessInformation) : bool; stdcall;
WinExecNext : function (cmdLine: pchar; show: dword) : dword; stdcall;
function CreateProcessACallback(appName, cmdLine: pchar;
processAttr, threadAttr: PSecurityAttributes;
inheritHandles: bool; creationFlags: dword;
environment: pointer; currentDir: pchar;
const startupInfo: TStartupInfo;
var processInfo: TProcessInformation) : bool; stdcall;
begin
if not IsAllowed(appName, cmdLine, nil, nil) then begin
result := false;
SetLastError(ERROR_ACCESS_DENIED);
end else begin
if GetVersion and $80000000 <> 0 then begin
result := CreateProcessHookProc(appName, cmdLine, processAttr, threadAttr,
inheritHandles, creationFlags,
environment, currentDir,
startupInfo, processInfo);
RenewHook(@ CreateProcessHookProc);
end else begin
result := CreateProcessANext(appName, cmdLine, processAttr, threadAttr,
inheritHandles, creationFlags,
environment, currentDir,
startupInfo, processInfo);
RenewHook(@CreateProcessANext);
end; end;
end;
function CreateProcessWCallback(appName, cmdLine: pwidechar;
processAttr, threadAttr: PSecurityAttributes;
inheritHandles: bool; creationFlags: dword;
environment: pointer; currentDir: pwidechar;
const startupInfo: TStartupInfo;
var processInfo: TProcessInformation) : bool; stdcall;
begin
if not IsAllowed(nil, nil, appName, cmdLine) then begin
result := false;
SetLastError(ERROR_ACCESS_DENIED);
end else begin
result := CreateProcessWNext(appName, cmdLine, processAttr, threadAttr,
inheritHandles, creationFlags,
environment, currentDir,
startupInfo, processInfo);
RenewHook(@CreateProcessWNext);
end;
end;
function WinExecCallback(cmdLine: pchar; show: dword) : dword; stdcall;
begin
if not IsAllowed(nil, cmdLine, nil, nil) then
result := ERROR_ACCESS_DENIED
else begin
result := WinExecNext(cmdLine, show);
RenewHook(@WinExecNext);
end;
end;
// ***************************************************************
begin
if GetVersion and $80000000 <> 0 then begin
Messagebox(0,'AsF: Ten program działa tylko w systemach NT i XP','ERROR',MB_OK);
end else begin
HookAPI('kernel32.dll', 'CreateProcessA', @CreateProcessACallback, @CreateProcessANext);
HookAPI('kernel32.dll', 'CreateProcessW', @CreateProcessWCallback, @CreateProcessWNext);
HookAPI('kernel32.dll', 'WinExec', @WinExecCallback, @WinExecNext );
end;
end.
kompilowane w delphi 5 standart, testowane w Win XP pro + sp2