[Original] Use Delphi to compile system process monitoring programs

Source: Internet
Author: User

This program calls several API functions in kernel32.dll, search for and list the IDs of all processes except the current process, corresponding file specifiers, priority, CPU usage, number of threads, and related process information in the system, the selected process can be aborted.
When the program is running, an icon will be added to the system tray area, and will not appear in the task list displayed by pressing CTRL + ALT + DEL, or display the task button on the taskbar, hidden automatically when not active or minimized. It does not run repeatedly. If the program is already running, only the running program will be activated when you want to run it again.
This method is unique to avoid repeated program running. After I try some methods on the internet, I find that the window cannot be minimized when the program is activated from the minimization state and the window minimization button is clicked. Therefore, the author adopted the method of sending and processing custom messages. When the program is running, enumerate existing windows in the system. If the program is found to be running, send a custom message to the window and end. A window is displayed when a running program receives a custom message.

// Project file procviewpro. DPR
Program procviewpro;

Uses
Forms, windows, messages, main in 'procview. pa' {form1 };

{$ R *. Res}
{
// This is automatic.
Begin
Application. initialize;
Application. Title: = 'System Process Monitoring ';
Application. createform (tform1, form1 );
Application. Run;
End.
}

VaR
Myhwnd: hwnd;

Begin
Myhwnd: = findwindow (nil, 'System Process Monitoring '); // find the window
If myhwnd = 0 then // No, continue running
Begin
Application. initialize;
Application. Title: = 'System Process Monitoring ';
Application. createform (tform1, form1 );
Application. Run;
End
Else // discover window, send and click the system tray area message to activate the window
Postmessage (myhwnd, wm_javasraymsg, 0, wm_lbuttondown );
{
// The disadvantage of the following method is that if the window is in the minimized state, the window cannot be minimized when the window minimization button is clicked after the window is activated.
Showwindow (myhwnd, sw_restore );
Flashwindow (myhwnd, true );
}
End.

{
// The following uses the Global atomic method to avoid repeated program running.
Const
Atomstr = 'procview ';

VaR
Atom: integer;
Begin
If globalfindatom (atomstr) = 0 then
Begin
Atom: = globaladdatom (atomstr );
With application do
Begin
Initialize;
Title: = 'System Process Monitoring ';
Createform (tform1, form1 );
Run;
End;
Globaldeleteatom (atom );
End;
End.
}

// Unit file procview. Pas
Unit procview;

Interface

Uses
Windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
Stdctrls, tlhelp32, buttons, comctrls, extctrls, shellapi, myflag;

Const
Process_terminate = 0;
Required ray_id = 1;
Wm_javasraymsg = wm_user + 100;

Type
Tform1 = Class (tform)
Lvsysproc: tlistview;
Lblsysproc: tlabel;
Lblaboutproc: tlabel;
Lvaboutproc: tlistview;
Lblcountsysproc: tlabel;
Lblcountaboutproc: tlabel;
Panel1: tpanel;
Btndetermine: tbutton;
Btnrefresh: tbutton;
Lblothers: tlabel;
Lblemail: tlabel;
Myflag1: 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 venture RayOnclick(VAR message: tmessage); message wm_receivraymsg;
Public
{Public declarations}
End;

VaR
Form1: tform1;
Idid: DWORD;
Fp32: tprocessentry32;
Fm32: tmoduleentry32;
Categorrayicon: tpolicyicondata;

Implementation

{$ R *. DFM}

Function registerserviceprocess (dwprocessid, dwtype: integer): integer; stdcall; External 'kernel32. dll ';

Procedure tform1.btnrefreshclick (Sender: TObject);
VaR
CLP: bool;
Newitem1: tlistitem;
Myicon: ticon;

Iconindex: word;
Procfile: array [0 .. max_path] of char;

Begin
Myicon: = ticon. Create;
Lvsysproc. Items. Clear;
Lvsysproc. smallimages. Clear;
Fshandle: = createconlhelp32snapshot (th32cs_snapprocess, 0 );
Fp32.dwsize: = sizeof (fp32 );
CLP: = process32first (fshandle, fp32 );
Iconindex: = 0;
While INTEGER (CLP) <> 0 do
Begin
If fp32.th32processid <> getcurrentprocessid then
Begin
Newitem1: = lvsysproc. Items. Add;
{
Newitem1.caption: = fp32.szexefile;
Myicon. Handle: = extracticon (form1.handle, fp32.szexefile, 0 );
}

Strcopy (procfile, fp32.szexefile );
Newitem1.caption: = procfile;
Myicon. Handle: = extractassociatedicon (hinstance, procfile, iconindex );

If myicon. Handle <> 0 then
Begin
With lvsysproc do
Begin
Newitem1.imageindex: = smallimages. addicon (myicon );
End;
End;
With newitem1.subitems do
Begin
Add (inttohex (fp32.th32processid, 4 ));
Add (inttohex (fp32.th32parentprocessid, 4 ));
Add (inttohex (fp32.pcpriclassbase, 4 ));
Add (inttohex (fp32.cntusage, 4 ));
Add (inttostr (fp32.cntthreads ));
End;
End;
CLP: = process32next (fshandle, fp32 );
End;
Closehandle (fshandle );
Lblcountsysproc. Caption: = inttostr (lvsysproc. Items. Count );
Myicon. Free;
End;

Procedure tform1.btndetermineclick (Sender: TObject);
VaR
Processhndle: thandle;
Begin
With lvsysproc do
Begin
If selected = nil then
Begin
MessageBox (form1.handle, 'select the process to terminate first! ', 'Operation prompt', mb_ OK + mb_iconinformation );
End
Else
Begin
If MessageBox (form1.handle, pchar ('termination' + itemfocused. Caption + '? ')
, 'Terminate process', mb_yesno + mb_iconwarning + mb_defbutton2) = mryes then
Begin
Idid: = strtoint ('$' + itemfocused. subitems [0]);
Processhndle: = OpenProcess (process_terminate, bool (0), Idid );
If INTEGER (terminateprocess (processhndle, 0) = 0 then
MessageBox (form1.handle, pchar ('cannot terminate' + itemfocused. Caption + '! ')
, 'Operation failed', mb_ OK + mb_icOnerror)
Else
Begin
Selected. Delete;
Lvaboutproc. Items. Clear;
Lblcountsysproc. Caption: = inttostr (lvsysproc. Items. Count );
Lblcountaboutproc. Caption: = '';
End
End;
End;
End;
End;

Procedure tform1.lvsysprocclick (Sender: TObject);
VaR
Newitem2: tlistitem;
CLP: bool;
Begin
If lvsysproc. Selected <> nil then
Begin
Idid: = strtoint ('$' + lvsysproc. itemfocused. subitems [0]);
Lvaboutproc. Items. Clear;
Fshandle: = createconlhelp32snapshot (th32cs_snapmodule, Idid );
Fm32.dwsize: = sizeof (fm32 );
CLP: = module32first (fshandle, fm32 );
While INTEGER (CLP) <> 0 do
Begin
Newitem2: = lvaboutproc. Items. Add;
With newitem2 do
Begin
Caption: = fm32.szexepath;
With newitem2.subitems do
Begin
Add (inttohex (fm32.th32moduleid, 4 ));
Add (inttohex (fm32.glblcntusage, 4 ));
Add (inttohex (fm32.proccntusage, 4 ));
End;
End;
CLP: = module32next (fshandle, fm32 );
End;
Closehandle (fshandle );
Lblcountaboutproc. Caption: = inttostr (lvaboutproc. Items. Count );
End
End;

Procedure tform1.formcreate (Sender: TObject);
Begin
With application do
Begin
Showwindow (handle, sw_hide); // hide the task button on the taskbar
Onminimize: = apponminimize; // automatically hidden when minimized
Ondeactivate: = formdeactivate; // automatically hidden when no activity occurs
Onactivate: = btnrefreshclick;
End;
Registerserviceprocess (getcurrentprocessid, 1); // register the program as a system service program to avoid appearing in the task list
With your rayicon do
Begin
Cbsize: = sizeof (javasrayicon );
WND: = handle;
UID: = policray_id;
Uflags: = nif_icon or nif_message or nif_tip;
Ucallbackmessage: = wm_javasraymsg;
Hicon: = application. Icon. Handle;
Sztip: = 'System Process Monitoring ';
End;
Shell_policyicon (nim_add, @ javasrayicon); // Add the program icon to the system tray Area
With lvsysproc do
Begin
Smallimages: = timagelist. createsize (16, 16 );
Smallimages. Repeated images: = true;
End;
Formoldwidth: = self. width;
Formoldheight: = self. height;
End;

// Hide automatically when minimized
Procedure tform1.apponminimize (Sender: TObject);
Begin
Showwindow (application. Handle, sw_hide );
End;

// Respond to the mouse and click on the system tray area icon
Procedure tform1.javasrayOnclick(VAR message: tmessage );
Begin
With message do
Begin
If (lparam = wm_lbuttondown) or (lparam = wm_rbuttondown) then
Begin
Application. Restore;
Setforegroundwindow (handle );
Showwindow (application. Handle, sw_hide );
End;
End;
End;

Procedure tform1.formclose (Sender: TObject; Var action: tcloseaction );
Begin
Shell_policyicon (nim_delete, @ mongorayicon); // cancel the system tray icon
Registerserviceprocess (getcurrentprocessid, 0); // cancel registration of system service programs
Lvsysproc. smallimages. Free;
End;

// Hide automatically when no activity occurs
Procedure tform1.formdeactivate (Sender: TObject);
Begin
Application. Minimize;
End;

Procedure tform1.lblemailclick (Sender: TObject);
Begin
If ShellExecute (handle, 'open', pchar ('mailto: purpleendurer@163.com '), nil, nil, sw_show) <33 then
MessageBox (form1.handle, 'email software cannot be started! ',' I'm sorry ', mb_iconinformation + mb_ OK );
End;

// Adjust the position of each component when the form size changes
Procedure tform1.formresize (Sender: TObject);
Begin
With Panel1 do top: = Top + self. Height-formoldheight;
With lvsysproc do
Begin
Width: = width + self. Width-formoldwidth;
End;

With lvaboutproc do
Begin
Height: = height + self. Height-formoldheight;
Width: = width + self. Width-formoldwidth;
End;
Formoldwidth: = self. width;
Formoldheight: = self. height;
End;

End.

The above programs can be compiled and run properly in the Chinese versions of Delphi 2, Windows 95, Delphi 5, and Windows 97. If you have any questions, please email to: purpleendurer@163.com to discuss with me.

Postscript:
In the code above, registerserviceprocess () is an undisclosed API function of win 9X.

After learning masm32, I used masm32 to rewrite and improve this program.
Interested friendsYou canHttp://endurer.ys168.comDownload the "System Process Monitoring" program from the tools directory

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.