Delphi一个待完成的实例

一个待完成的实例
第五课  一个待完成的实例
---------------------------------------


主要是结合前边我们学过的只是完成一个简单的实例程序


学习目的：使用Delphi创建框口应用程序

程序的目的：
列出系统中所有的进程
可以关闭进程
设定刷新进程列表的时间
新建程序任务

by clin003 at 20070528 from:http://blog.csdn.net/clin003
----------------
接着来看我的演示

//需要引用的单元
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ImgList, StdCtrls, ExtCtrls, Tlhelp32,Clipbrd,
   ShellAPI, JPEG;

//声明的全局变量
var
  Form1: TForm1;
  Proc   :TPROCESSENTRY32 ;
  Snap   :THandle;
 
 
下边是程序中要用到的关键数据类型和一些函数原型。

首先看执行程序的函数
//执行程序
function tform1.ShellRun(sPath: string; sParam: string = ''): Cardinal;
var
  lpStartupInfo: TStartupInfo;
  lpProcessInformation: TProcessInformation;
begin
  if sParam <> '' then sPath := sPath + ' ' + sParam;
  FillChar(lpStartupInfo, SizeOf(TStartupInfo), 0);
  FillChar(lpProcessInformation, SizeOf(TProcessInformation), 0);
  if CreateProcess(nil, PChar(sPath), nil, nil, True,
    CREATE_NEW_PROCESS_GROUP or NORMAL_PRIORITY_CLASS, nil, nil,
    lpStartupInfo, lpProcessInformation) then
    Result := lpProcessInformation.dwProcessId
  else Result := 0;   //如果程序执行成功返回程序信息否则返回0
end;




数据类型：
TStartupInfo 存储程序启动时需要的参数信息
TProcessInformation 存储程序激活运行的进程信息
函数原型：
下边这个过程填充空间的函数原型：
procedure _FillChar(var Dest; count: Integer; Value: Char);//这里有个var无类型参数。。
将Dest填充为count个value字符。
///
创建进程的程序函数原型：
function CreateProcess(lpApplicationName: PChar; lpCommandLine: PChar;
  lpProcessAttributes, lpThreadAttributes: PSecurityAttributes;
  bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer;
  lpCurrentDirectory: PChar; const lpStartupInfo: TStartupInfo;
  var lpProcessInformation: TProcessInformation): BOOL; stdcall;
 
可以对照我们调用的方式和函数原型知道哪些参数是需要的那些可以是nil（空）的。

-----------------------------------------------------------------------------------
检查进程是否在运行的函数
//检查进程是否已经运行
function tform1.ExistsProcess(ProcessID: THandle): Boolean;
var
  FSnapshotHandle: THandle;
  lppe: TProcessEntry32;
  Ret: Boolean;
begin
  Result:= False;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if FSnapshotHandle <= 0 then Exit;
  try
    lppe.dwSize := SizeOf(PROCESSENTRY32);
    Ret := Process32First(FSnapshotHandle, lppe);
    while Ret do
    begin
      if lppe.th32ProcessID = ProcessID then
      begin
        Result := True;
        Break;
      end;
      Ret := Process32Next(FSnapshotHandle, lppe);
    end;
  finally
    CloseHandle(FSnapshotHandle);
  end;
end;
///

数据类型：{
THandle 是一个LongWord类型，存储一个句柄（或者说指针）
PROCESSENTRY32 是一个记录类型，存储程序的信息
Boolean 这个就不用说啦}
函数原型：
{函数CreateToolhelp32Snapshot()创建系统信息的快照句柄}
function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle;

{函数Process32First()从快照句柄中取得进程列表，重复调用 Process32Next直到函数返回 FALSE 为止。这样将遍历快照中进程列表。
两个参数，它们分别是快照句柄和一个   PROCESSENTRY32 结构。}
function Process32First(hSnapshot: THandle; var lppe: TProcessEntry32): BOOL;

{
注意：在调用 Process32First() 之前，一定要记住将 PROCESSENTRY32  结构的 dwSize 成员设置成 sizeof(PROCESSENTRY32)。
}

------------------------------------------
终止进程的函数——本实例核心函数一
终止进程过程

function TForm1.KillTask(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 := Integer(TerminateProcess(OpenProcess(
              PROCESS_TERMINATE, BOOL(0),
              FProcessEntry32.th32ProcessID), 0));
    ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);
  end;
end;

//
数据类型：
PROCESS_TERMINATE消息常量，使进程终止。


函数原型：
{函数ExtractFileName   函数   返回文件名 }
function ExtractFileName(const FileName: string): string; 

{
函数UpperCase 将小写字母转换成大写字母
}
function UpperCase(const S: string): string;

{函数OpenProcess打开一个进程,可以获得该进程的句柄}
function OpenProcess(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwProcessId: DWORD): THandle; stdcall;


---------------------------------------------
///刷新进程列表过程//

procedure TForm1.TaskRefresh;
begin
   task.Items.Clear;
   Snap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS,0);
   Proc.dwSize := SizeOf(TProcessEntry32);
   Process32First(Snap,Proc);
   repeat
     Task.Items.Add(proc.szExeFile);
   until (not Process32Next(Snap,Proc));
     Task.Selected[0]:=True;
     Task.Hint:=task.Items.Strings[Task.ItemIndex];
end;
//
函数：
Items.Add向tlistbox中添加项目。

附加：程序的其他部分代码——————————————————————————————————————
//框口创建后就刷新一次进程列表目的是得到进程列表
procedure TForm1.FormCreate(Sender: TObject);
begin
TaskRefresh;
end;

//关闭程序退出
procedure TForm1.Button1Click(Sender: TObject);
begin
close;
end;


//刷新进程列表
procedure TForm1.Button4Click(Sender: TObject);
begin
 TaskRefresh;
end;


/终止进程
procedure TForm1.Button3Click(Sender: TObject);
begin
  killtask(task.Items[task.itemindex]) ;
  task.Items.Delete(task.ItemIndex);
end;

//始终按钮时间事件，定时刷新进程列表
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if trackbar1.Position <> 0  then
  TaskRefresh;
end;


//检测滑块移动位置事件。
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  timer1.Interval:=trackbar1.Position*1000;
  label3.Caption:=inttostr(trackbar1.Position)+'秒'
end;


通过点击图标打开一个网址
procedure TForm1.Image1Click(Sender: TObject);
begin
   ShellExecute(Handle,'Open','http://www.3800hk.com',nil,nil,SW_SHOWNORMAL);
end;


选择一个进程，然后把文件名写入edit1中
procedure TForm1.Button2Click(Sender: TObject);

begin
   OpenDialog1.Filter := '程序文件|*.exe;*.dll;*.scr|所有文件|*.*';
if OpenDialog1.Execute then
     Edit1.Text := OpenDialog1.FileName;
end;


执行一个进程
procedure TForm1.Button5Click(Sender: TObject);
var
  ExcuteFileName:String;
  ProcessHandle: THandle;
begin
 
  if Edit1.Text <> '' then
     begin
       ExcuteFileName := Trim(Edit1.Text);
       ProcessHandle := ShellRun(ExcuteFileName,'');
      if ExistsProcess(ProcessHandle) then
           ShowMessage('ExistsProcess');
     end
  else
    ShowMessage('Application Error');
  TaskRefresh;
end;





附：===========================================================================
使用 ToolHelp32 库枚举进程

　　ToolHelp32 库函数在 KERNEL32.dll 中，它们都是标准的 API 函数。但是 Windows NT 4.0 不提供这些函。
　　ToolHelp32 库中有各种各样的函数可以用来枚举系统中的进程、线程以及获取内存和模块信息。其中枚举进程 只需用如下三个的函数：CreateToolhelp32Snapshot()、Process32First()和 Process32Next()。
　　使用 ToolHelp32 函数的第一步是用 CreateToolhelp32Snapshot() 函数创建系统信息“快照”。这个函数可以让你选择存储在快照中的信息类型。如果你只是对进程信息感兴趣，那么只要包含 TH32CS_SNAPPROCESS 标志即可。 CreateToolhelp32Snapshot() 函数返回一个 HANDLE，完成调用之后，必须将此 HANDLE 传给 CloseHandle()。
　　接下来是调用一次 Process32First 函数，从快照中获取进程列表，然后重复调用 Process32Next，直到函数返回 FALSE 为止。这样将遍历快照中进程列表。这两个函数都带两个参数，它们分别是快照句柄和一个   PROCESSENTRY32 结构。
　　调用完 Process32First 或 Process32Next 之后，PROCESSENTRY32 中将包含系统中某个进程的关键信息。其中进程 ID 就存储在此结构的 th32ProcessID。此 ID 可以被传给 OpenProcess() API 以获得该进程的句柄。对应的可执行文件名及其存放路径存放在 szExeFile  结构成员中。在该结构中还可以找到其它一些有用的信息。
　　注意：在调用 Process32First() 之前，一定要记住将 PROCESSENTRY32  结构的 dwSize 成员设置成 sizeof(PROCESSENTRY32)。




完善进程管理程序

by clin003 at 20070528 from:http://blog.csdn.net/clin003


目的：
1：添加开机启动功能
2：自动执行最后一次执行的程序

下边是时用到的函数------------
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,Tlhelp32, ComCtrls, StdCtrls, Buttons,Clipbrd, ExtCtrls,
  ShellAPI, JPEG, Registry, IniFiles;

procedure TForm1.ReadIni(Sender: TObject);
const
  IniFileName='test.ini';       //Ini文件名=WinPath+'test.ini'
var
  IniFile:TIniFile;
begin
  IniFile:=TIniFile.Create(ExtractFilePath(Application.ExeName)+IniFileName);
  //IniFile:=TIniFile.Create(IniFileName);//从系统Windows文件夹下读test.ini
  with IniFile do
  begin
    CheckBox1.Checked := ReadBool('SystemSet','AutoRun',True);
    ExcuteFileNameEdit.Text := ReadString('SystemSet','ExcuteFileName','');
  end;
end;

procedure TForm1.WriteIni(Sender: TObject);
const
  IniFileName='test.ini';       //Ini文件名=WinPath+'test.ini'
var
  IniFile:TIniFile;
begin
  IniFile:=TIniFile.Create(ExtractFilePath(Application.ExeName)+IniFileName);
  //IniFile:=TIniFile.Create(IniFileName);//从系统Windows文件夹下读test.ini
  with IniFile do
  begin
    WriteBool('SystemSet','AutoRun',CheckBox1.Checked);
    WriteString('SystemSet','ExcuteFileName',ExcuteFileNameEdit.Text);
  end;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
var RegF : TRegistry;
begin
  RegF:=TRegistry.Create;
  RegF.RootKey:=HKEY_LOCAL_MACHINE;
  try
    RegF.OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Run',True);
    //设置开机是否自动运行
    if CheckBox1.Checked then
    begin
      RegF.DeleteValue('test');
      RegF.WriteString('test',Application.ExeName);
    end
    else
      RegF.DeleteValue('test');
  except
    with Application do
    MessageBox('程序内部错误',PChar(Title),MB_OK+MB_ICONERROR);
  end;
   RegF.CloseKey;
   RegF.Free;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  ReadIni(Sender);
  if Edit1.Text <> '' then
     Button4.Enabled := True;
  if Button4.Enabled then
     Button4Click(Sender);
end;