调取监控录像步骤 用Delphi编写系统进程监控程序

用Delphi编写系统进程监控程序  

本程序通过调用kernel dll中的几个API 函数 搜索并列出系统中除本进程外的所有进程的ID 对应的文件说明符 优先级 CPU占有率 线程数 相关进程信息等有关信息 并可中止所选进程 　　　　本程序运行时会在系统托盘区加入图标 不会出现在按Ctrl+Alt+Del出现的任务列表中 也不会在任务栏上显示任务按钮 在不活动或最小化时会自动隐藏 不会重复运行 若程序已经运行 再想运行时只会激活已经运行的程序 　　　　本程序避免程序反复运行的方法是比较独特的 因为笔者在试用网上介绍一些方法后 发现程序从最小化状态被激活时 单击窗口最小化按钮时 窗口却不能最小化 于是笔者采用了发送和处理自定义消息的方法 在程序运行时先枚举系统中已有窗口 若发现程序已经运行 就向该程序窗口发送自定义消息 然后结束 已经运行的程序接到自定义消息后显示出窗口 　　　　//工程文件procviewpro dpr　　program procviewpro;　　　　uses　　Forms windows messages main in procview pas {Form };　　　　{$R * RES}　　{　　//这是系统自动的　　begin　　Application Initialize;　　Application Title := 系统进程监控 ;　　Application CreateForm(TForm Form );　　Application Run;　　end 　　}　　　　var　　myhwnd:hwnd;　　　　begin　　myhwnd := FindWindow(nil 系统进程监控 ); // 查找窗口　　if myhwnd= then // 没有发现 继续运行　　begin　　Application Initialize;　　Application Title := 系统进程监控 ;　　Application CreateForm(TForm Form );　　Application Run;　　end　　else //发现窗口 发送鼠标单击系统托盘区消息以激活窗口　　postmessage(myhwnd WM_SYSTRAYMSG wm_lbuttondown);　　{　　//下面的方法的缺点是 若窗口原先为最小化状态 激活后单击窗口最小化按钮将不能最小化窗口　　showwindow(myhwnd sw_restore);　　FlashWindow(MYHWND TRUE);　　}　　end 　　　　{　　//下面是使用全局原子的方法避免程序反复运行　　const　　atomstr= procview ;　　　　var　　atom:integer;　　begin　　if globalfindatom(atomstr)= then　　begin　　atom:=globaladdatom(atomstr);　　with application do　　begin　　Initialize;　　Title := 系统进程监控 ;　　CreateForm(TForm Form );　　Run;　　end;　　globaldeleteatom(atom);　　end;　　end 　　}　　　　//单元文件procview pas　　unit procview;　　　　interface　　　　uses　　Windows Messages SysUtils Classes Graphics Controls Forms Dialogs 　　StdCtrls TLHelp Buttons ComCtrls ExtCtrls ShellAPI MyFlag;　　　　const　　PROCESS_TERMINATE= ;　　SYSTRAY_ID= ;　　WM_SYSTRAYMSG=WM_USER+ ;　　　　type　　TForm = class(TForm)　　lvSysProc: TListView;　　lblSysProc: TLabel;　　lblAboutProc: TLabel;　　lvAboutProc: TListView;　　lblCountSysProc: TLabel;　　lblCountAboutProc: TLabel;　　Panel : TPanel;　　btnDetermine: TButton;　　btnRefresh: TButton;　　lblOthers: TLabel;　　lblEmail: TLabel;　　MyFlag : TMyFlag;　　procedure btnRefreshClick(Sender: TObject);　　procedure btnDetermineClick(Sender: TObject);　　procedure lvSysProcClick(Sender: TObject);　　procedure FormCreate(Sender: TObject);　　procedure AppOnMinimize(Sender:TObject);　　procedure FormClose(Sender: TObject; var Action: TCloseAction);　　procedure FormDeactivate(Sender: TObject);　　procedure lblEmailClick(Sender: TObject);　　procedure FormResize(Sender: TObject);　　private　　{ Private declarations }　　fshandle:thandle;　　FormOldHeight FormOldWidth:Integer;　　procedure SysTrayOnClick(var message:TMessage);message WM_SYSTRAYMSG;　　public　　{ Public declarations }　　end;　　　　var　　Form : TForm ;　　idid: dword;　　fp :tprocessentry ;　　fm :tmoduleentry ;　　SysTrayIcon:TNotifyIconData;　　　　implementation　　　　{$R * DFM}　　　　function RegisterServiceProcess(dwProcessID dwType:integer):integer;stdcall;external KERNEL DLL ;　　　　procedure TForm btnRefreshClick(Sender: TObject);　　var　　clp:bool;　　newitem :Tlistitem;　　MyIcon:TIcon;　　　　IconIndex:word;　　ProcFile : array[ MAX_PATH] of char;　　　　begin　　MyIcon:=TIcon create;　　lvSysProc Items clear;　　lvSysProc SmallImages clear;　　fshandle:=CreateToolhelp Snapshot(th cs_snapprocess );　　fp dwsize:=sizeof(fp );　　clp:=process first(fshandle fp );　　IconIndex:= ;　　while integer(clp)<> do　　begin　　if fp th processid<>getcurrentprocessid then　　begin　　newitem :=ems add;　　{　　newitem caption:=fp szexefile;　　MyIcon Handle:=ExtractIcon(Form Handle fp szexefile );　　}　　　　StrCopy(ProcFile fp szExeFile);　　newitem caption:=ProcFile;　　MyIcon Handle:=ExtractAssociatedIcon(HINSTANCE ProcFile IconIndex);　　　　if MyIcon Handle<> then　　begin　　with lvSysProc do　　begin　　NewItem ImageIndex:=smallimages addicon(MyIcon);　　end;　　end;　　with newitem subitems do　　begin　　add(IntToHex(fp th processid ));　　Add(IntToHex(fp th ParentProcessID ));　　Add(IntToHex(fp pcPriClassBase ));　　Add(IntToHex(tUsage ));　　Add(IntToStr(tThreads));　　end;　　end;　　clp:=process next(fshandle fp );　　end;　　closehandle(fshandle);　　lblCountSysProc caption:=IntToStr(unt);　　MyIcon Free;　　end;　　　　procedure TForm btnDetermineClick(Sender: TObject);　　var　　processhndle:thandle;　　begin　　with lvSysProc do　　begin　　if selected then　　begin　　messagebox(form handle 请先选择要终止的进程! 操作提示 MB_OK+MB_ICONINFORMATION);　　end　　else　　begin　　if messagebox(form handle pchar( 终止 +itemfocused caption+ ? )　　 终止进程 mb_yesno+MB_ICONWARNING+MB_DEFBUTTON )=mryes then　　begin　　idid:=strtoint( $ +itemfocused subitems[ ]);　　processhndle:=openprocess(PROCESS_TERMINATE bool( ) idid);　　if integer(terminateprocess(processhndle ))= then　　messagebox(form handle pchar( 不能终止 +itemfocused caption+ ! )　　 操作失败 mb_ok+MB_ICONERROR)　　else　　begin　　Selected Delete;　　lvAboutProc Items Clear;　　lblCountSysProc caption:=inttostr(unt);　　lblCountAboutProc caption:= ;　　end　　end;　　end;　　end;　　end;　　　　procedure TForm lvSysProcClick(Sender: TObject);　　var　　newitem :Tlistitem;　　clp:bool;　　begin　　if lvSysProc selected<>nil then　　begin　　idid:=strtoint( $ +emfocused subitems[ ]);　　ems Clear;　　fshandle:=CreateToolhelp Snapshot(th cs_snapmodule idid);　　fm dwsize:=sizeof(fm );　　clp:=Module First(fshandle fm );　　while integer(clp)<> do　　begin　　newitem :=lvAboutProc Items add;　　with newitem do　　begin　　caption:=fm szexepath;　　with newitem subitems do　　begin　　add(IntToHex(fm th moduleid ));　　add(IntToHex(fm GlblcntUsage ));　　add(IntToHex(fm proccntUsage ));　　end;　　end;　　clp:=Module Next(fshandle fm );　　end;　　closehandle(fshandle);　　lblCountAboutProc Caption:=IntToStr(unt);　　end　　end;　　　　procedure TForm FormCreate(Sender: TObject);　　begin　　with application do　　begin　　showwindow(handle SW_HIDE); //隐藏任务栏上的任务按钮　　OnMinimize:=AppOnMinimize; //最小化时自动隐藏　　OnDeactivate:=FormDeactivate; //不活动时自动隐藏　　OnActivate:=btnRefreshClick;　　end;　　RegisterServiceProcess(GetcurrentProcessID ); //将程序注册为系统服务程序 lishixinzhi/Article/program/Delphi/201311/24680