用Delphi编写系统进程监控程序_软件运维

本程序通过调用kernel dll中的几个API 函数搜索并列出系统中除本进程外的所有进程的ID 对应的文件说明符优先级 CPU占有率线程数相关进程信息等有关信息并可中止所选进程本程序运行时会在系统托盘区加入图标不会出现在按Ctrl+Alt+Del出现的任务列表中也不会在任务栏上显示任务按钮在不活动或最小化时会自动隐藏不会重复运行若程序已经运行再想运行时只会激活已经运行的程序本程序避免程序反复运行的方法是比较独特的因为笔者在试用网上介绍一些方法后发现程序从最小化状态被激活时单击窗口最小化按钮时窗口却不能最小化于是笔者采用了发送和处理自定义消息的方法在程序运行时先枚举系统中已有窗口若发现程序已经运行就向该程序窗口发送自定义消息然后结束已经运行的程序接到自定义消息后显示出窗口 //工程文件procviewpro dprprogram procviewprousesForms windows messages main in procview pas {Form }{$R * RES}{//这是系统自动的beginApplication InitializeApplication Title := 系统进程监控 Application CreateForm(TForm Form )Application Runend }varmyhwnd:hwndbeginmyhwnd := FindWindow(nil 系统进程监控 )// 查找窗口if myhwnd= then // 没有发现继续运行beginApplication InitializeApplication Title := 系统进程监控 Application CreateForm(TForm Form )Application Runendelse //发现窗口发送鼠标单击系统托盘区消息以激活窗口postmessage(myhwnd WM_SYSTRAYMSG wm_lbuttondown){//下面的方法的缺点是若窗口原先为最小化状态激活后单击窗口最小化按钮将不能最小化窗口showwindow(myhwnd sw_restore)FlashWindow(MYHWND TRUE)}end {//下面是使用全局原子的方法避免程序反复运行constatomstr= procview varatom:integerbeginif globalfindatom(atomstr)= thenbeginatom:=globaladdatom(atomstr)with application dobeginInitializeTitle := 系统进程监控 CreateForm(TForm Form )Runendglobaldeleteatom(atom)endend }//单元文件procview pasunit procviewinterfaceusesWindows Messages SysUtils Classes Graphics Controls Forms Dialogs StdCtrls TLHelp Buttons ComCtrls ExtCtrls ShellAPI MyFlagconstPROCESS_TERMINATE= SYSTRAY_ID= WM_SYSTRAYMSG=WM_USER+ typeTForm = class(TForm)lvSysProc: TListViewlblSysProc: TLabellblAboutProc: TLabellvAboutProc: TListViewlblCountSysProc: TLabellblCountAboutProc: TLabelPanel : TPanelbtnDetermine: TButtonbtnRefresh: TButtonlblOthers: TLabellblEmail: TLabelMyFlag : TMyFlagprocedure btnRefreshClick(Sender: TObject)procedure btnDetermineClick(Sender: TObject)procedure lvSysProcClick(Sender: TObject)procedure FormCreate(Sender: TObject)procedure AppOnMinimize(Sender:TObject)procedure FormClose(Sender: TObjectvar Action: TCloseAction)procedure FormDeactivate(Sender: TObject)procedure lblEmailClick(Sender: TObject)procedure FormResize(Sender: TObject)private{ Private declarations }fshandle:thandleFormOldHeight FormOldWidth:Integerprocedure SysTrayOnClick(var message:TMessage)message WM_SYSTRAYMSGpublic{ Public declarations }endvarForm : TForm idid: dwordfp :tprocessentry fm :tmoduleentry SysTrayIcon:TNotifyIconDataimplementation{$R * DFM}function RegisterServiceProcess(dwProcessID dwType:integer):integerstdcallexternal KERNEL DLL procedure TForm btnRefreshClick(Sender: TObject)varclp:boolnewitem :TlistitemMyIcon:TIconIconIndex:wordProcFile : array[ MAX_PATH] of charbeginMyIcon:=TIcon createlvSysProc Items clearlvSysProc SmallImages clearfshandle:=CreateToolhelp Snapshot(th cs_snapprocess )fp dwsize:=sizeof(fp )clp:=process first(fshandle fp )IconIndex:= while integer(clp)<>dobeginif fp th processid<>getcurrentprocessid thenbeginnewitem :=ems add{newitem caption:=fp szexefileMyIcon Handle:=ExtractIcon(Form Handle fp szexefile )}StrCopy(ProcFile fp szExeFile)newitem caption:=ProcFileMyIcon Handle:=ExtractAssociatedIcon(HINSTANCE ProcFile IconIndex)if MyIcon Handle<>thenbeginwith lvSysProc dobeginNewItem ImageIndex:= *** allimages addicon(MyIcon)endendwith newitem subitems dobeginadd(IntToHex(fp th processid ))Add(IntToHex(fp th ParentProcessID ))Add(IntToHex(fp pcPriClassBase ))Add(IntToHex(tUsage ))Add(IntToStr(tThreads))endendclp:=process next(fshandle fp )endclosehandle(fshandle)lblCountSysProc caption:=IntToStr(unt)MyIcon Freeendprocedure TForm btnDetermineClick(Sender: TObject)varprocesshndle:thandlebeginwith lvSysProc dobeginif selected thenbeginmessagebox(form handle 请先选择要终止的进程! *** 作提示 MB_OK+MB_ICONINFORMATION)endelsebeginif messagebox(form handle pchar( 终止 +itemfocused caption+ ? ) 终止进程 mb_yesno+MB_ICONWARNING+MB_DEFBUTTON )=mryes thenbeginidid:=strtoint( $ +itemfocused subitems[ ])processhndle:=openprocess(PROCESS_TERMINATE bool( ) idid)if integer(terminateprocess(processhndle ))= thenmessagebox(form handle pchar( 不能终止 +itemfocused caption+ ! ) *** 作失败 mb_ok+MB_ICONERROR)elsebeginSelected DeletelvAboutProc Items ClearlblCountSysProc caption:=inttostr(unt)lblCountAboutProc caption:= endendendendendprocedure TForm lvSysProcClick(Sender: TObject)varnewitem :Tlistitemclp:boolbeginif lvSysProc selected<>nil thenbeginidid:=strtoint( $ +emfocused subitems[ ])ems Clearfshandle:=CreateToolhelp Snapshot(th cs_snapmodule idid)fm dwsize:=sizeof(fm )clp:=Module First(fshandle fm )while integer(clp)<>dobeginnewitem :=lvAboutProc Items addwith newitem dobegincaption:=fm szexepathwith newitem subitems dobeginadd(IntToHex(fm th moduleid ))add(IntToHex(fm GlblcntUsage ))add(IntToHex(fm proccntUsage ))endendclp:=Module Next(fshandle fm )endclosehandle(fshandle)lblCountAboutProc Caption:=IntToStr(unt)endendprocedure TForm FormCreate(Sender: TObject)beginwith application dobeginshowwindow(handle SW_HIDE)//隐藏任务栏上的任务按钮OnMinimize:=AppOnMinimize//最小化时自动隐藏OnDeactivate:=FormDeactivate//不活动时自动隐藏OnActivate:=btnRefreshClickendRegisterServiceProcess(GetcurrentProcessID )//将程序注册为系统服务程序 lishixinzhi/Article/program/Delphi/201311/24680

你想做破解啊？

没办法监控的，就算你监控到了又能怎么样？

比如你监控到是读取网卡MAC和硬盘物理序列号

硬件识别码是根据这两样生成的，算法由写的人来定，所以你不可能知道的

DELPHI的程序，如果没有加壳，可以用DEDE反编译的

大部分破解都是将判断语句剔除或修改

比如

if sn=getid then

采集的注册码正确，继续运行

else

begin

showmessage('未注册。。。。。。。')

退出程序

end

将这段剔除，或将=修改为<>都可以OK的，破解方法多种多样，防破解的也多种多样

想学破解，可以去看雪论坛看看，那里这方面高手N多

我的基本框架是这样的的

利用的消息循环，

begin

while(GetMessage(msg,0,0,0))do

begin

TranslateMessage(msg)

DispatchMessage(msg)

end

end.

如何加入消息队列，判断优盘的插入和拔出？？

网上有篇帖子是这样的，用的是有窗体的label，

《Delphi捕获U盘插入或者拔出》

Delphi捕获U盘插入或者拔出

在USB端口被热插后，系统会向所有程序发布WM_DEVICECHANGE消息，所以只要捕获此消息即可实现对U盘的监视。

1、新建工程

2、在form1上放一个Label

3、定义一个私有过程procedureWMDeviceChange(varMsg:TMessage)messageWM_DEVICECHANGE

unitUnit1

interface

uses

Windows,Messages,SysUtils,Variants,Classes,Graphics,Controls,Forms,

Dialogs,AppEvnts,ExtCtrls,StdCtrls

type

TForm1=class(TForm)

Label1:TLabel

private

{Privatedeclarations}

procedureWMDeviceChange(varMsg:TMessage)messageWM_DEVICECHANGE

public

{Publicdeclarations}

end

var

Form1:TForm1

implementation

{$R*.dfm}

procedureTForm1.WMDeviceChange(varMsg:TMessage)

var

myMsg:String

begin

CaseMsg.WParamof

32768:

begin

myMsg:='U盘插入'

Label1.Caption:=myMsg

end

32772:

begin

myMsg:='U盘拔出'

Label1.Caption:=myMsg

end

end.

我想讲两者结合起来，如何实现呢？？

请会的大侠给我点启示。