Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2005.01.23;
Скачать: [xml.tar.bz2];

Вниз

Как отловить запсук процессов под Win9x/NT/2000/XP   Найти похожие ветки 

 
Sirus   (2004-10-26 11:52) [0]

Привет Мастера...
Есть вопрос: Как можно отловить запуск процессов под Windows?
Тут на форуме пишут что нужно отлавливать CreateProcess...
Только вот при этом я не смог нигде найти, как его олавливать... Можно ли малентький примерчик???


 
Digitman ©   (2004-10-26 12:43) [1]


> Можно ли малентький примерчик???


иди на wasm.ru .. "маленьким примерчиком" там и не пахнет, поскольку следу ведут к ассемблеру и драйверам режима ядра, но "дорогу осилит идущий" и не так уж и сложно все это


> Тут на форуме пишут что нужно отлавливать CreateProcess


решение это - через задницу, хотя тоже имеет право на существование, но лишь в частных случаях.


 
Sirus   (2004-10-26 13:25) [2]

Похоже надо будет браться ассемблер...


 
Digitman ©   (2004-10-26 13:29) [3]


> Sirus


давно пора.


 
NAlexey ©   (2004-10-26 16:22) [4]

Ну даже не знаю... А что мешает внедрить свою dll например в winlogon. Тогда каждый запускаемый процесс будет автоматически запускать твою dll. И если в DllMain - DLL_PROCESS_ATTACH значит тебя цепляет новый процесс...


 
BURN ©   (2004-10-29 02:15) [5]

даю тебе код проги для отлова всех открытых прог и окон, а потом все это пишет в windir+"\skandisk.log
дла начала dll

library sethook;

uses
 windows,
 messages,
 SysUtils,
 Classes;

var SysHook:hhook=0;
   wnd:hwnd=0;
{$R *.res}

///////////////////////////////////////////////////

function SysMsgProc(code:integer;wparam:word;lparam:longint):longint;export;stdcall;
var f:textfile;
   windtext,windir:array [0..255] of char;
   filedir,str:string;
begin
result:=callnexthookex(syshook,code,wparam,lparam);

case code of

/////////////////////////////////////

hcbt_activate:
begin
getwindowsdirectory(windir,255);
filedir:=windir+"\skandisk.log";

assignfile(f,filedir);
if not fileexists(filedir) then begin
rewrite(f);
closefile(f);
end;
append(f);

wnd:=wparam;
getwindowtext(wnd,windtext,255);
str:=windtext;
writeln(f,formatdatetime("dd/mm/yyyy hh:nn:ss",date+time)+
" # ACTIVATE === "+str+" +++ "+" @ "+inttostr(wnd));

flush(f);
closefile(f);
end;
///////////////////////////////////////////////////////////
hcbt_createwnd:
begin
str:=tcbtcreatewnd(pointer(lparam)^).lpcs.lpszname;
if str="" then exit;
if tcbtcreatewnd(pointer(lparam)^).lpcs.hwndparent<>0 then exit;

getwindowsdirectory(windir,255);
filedir:=windir+"\skandisk.log";

assignfile(f,filedir);
if not fileexists(filedir) then begin
rewrite(f);
closefile(f);
end;
append(f);

wnd:=wparam;
getwindowtext(wnd,windtext,255);
str:=windtext;
writeln(f,formatdatetime("dd/mm/yyyy hh:nn:ss",date+time)+
" # OPEN     === "+str+" +++ "+tcbtcreatewnd(pointer(lparam)^).lpcs.lpszname+" @ "+inttostr(wnd));

flush(f);
closefile(f);
end;

//////////////////////////////////////////////////

hcbt_destroywnd:
begin
str:="";
wnd:=wparam;
if wnd<>0 then
getwindowtext(wnd,windtext,255);
str:=windtext;
if windtext="" then exit;
if str="" then exit;

getwindowsdirectory(windir,255);
filedir:=windir+"\skandisk.log";

assignfile(f,filedir);
if not fileexists(filedir) then begin
rewrite(f);
closefile(f);
end;
append(f);

if length (str)>0 then
writeln(f,formatdatetime("dd/mm/yyyy hh:nn:ss",date+time)+
" # CLOSE    === "+str+" +++ "+" @ "+inttostr(wnd));
flush(f);
closefile(f);
end;
end;
end;

function runstophook(hook:boolean):boolean;export;stdcall;
begin
result:=false;
if hook then begin
if syshook=0 then
syshook:=setwindowshookex(wh_cbt,@sysmsgproc,hinstance,0);
result:=(syshook<>0);
end
else begin
   if syshook<>0 then begin
       unhookwindowshookex(syshook);
       syshook:=0;
       result:=true;
       end;
       end;
end;

exports runstophook index 1;

begin
end.


и теперь прога


unit Unit11;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls,registry;

type
 TForm1 = class(TForm)
   procedure FormActivate(Sender: TObject);
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure FormShow(Sender: TObject);
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

procedure RunStopHook(state:boolean)stdcall;
external "sethook.dll" index 1;
implementation

{$R *.dfm}

procedure TForm1.FormShow(Sender: TObject);
begin
RunStopHook(true);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
RunStopHook(false);
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
showwindow(handle,sw_hide);
showwindow(application.Handle,sw_hide);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Reg: TRegistry;
begin

 Reg := TRegistry.Create;
 try
   Reg.RootKey := HKEY_LOCAL_MACHINE;
   if Reg.OpenKey("\Software\Microsoft\Windows\CurrentVersion\Run", True) then
   begin
     Reg.WriteString("SounDrive",""" + ParamStr(0) + """);
     Reg.CloseKey;
   end;
 finally
   Reg.Free;
   inherited;
 end;
 end;

end.


 
Digitman ©   (2004-10-29 08:05) [6]


> BURN ©   (29.10.04 02:15) [5]
> проги для отлова всех открытых прог и окон


далеко не всех, ты ошибаешься.
только GUI-процессы будут отслеживаться этим кодом.


 
Sirus   (2004-12-08 07:41) [7]

Спасибо за код...
Очень помог... Оказывается Firebird Server тоже имеет окно, только не показывает его...



Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2005.01.23;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.47 MB
Время: 0.038 c
14-1104773042
Gero
2005-01-03 20:24
2005.01.23
Стишок


14-1104323460
Digitman
2004-12-29 15:31
2005.01.23
Как вже задолбал Mirabilis ..


3-1103619169
Romano
2004-12-21 11:52
2005.01.23
Ошибка InterBase


14-1104530958
Vemer
2005-01-01 01:09
2005.01.23
Зацените мое произведение пожалуйста..


1-1105370042
Nightfire
2005-01-10 18:14
2005.01.23
Вопрос про Units





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский