花式摩卡咖啡:delphi 结束进程

来源:百度文库 编辑:九乡新闻网 时间:2024/04/29 11:31:41

在网上搜了一下delphi结束进程的代码,发现当要结束的进程名是当前的进程并且该程序开了多个的话,会因为当前进程在结束其他进程前把自己关掉而不能结束所有同名的进程,所以修改了一下:

注:TProcessEntry32 需要引用单元 uses TLHelp32;

function killProcess(iProcessName:string):boolean;
var
  HandleSnap:THandle;//用于获得进程列表
  killHandle:THandle;
  processEntry:TProcessEntry32;//用于查找进程
  found:boolean;
  count:integer;
  selfProcessID:cardinal;

begin
  HandleSnap:=CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);//获得系统进程列表
  processEntry.dwSize:=sizeof(TProcessEntry32);/在调用Process32First API之前,需要初始化lppe记录的大小

  selfProcessID:=getCurrentProcessID();//获得当前Delphi应用程序的进程ID

  count:=0;
  found:=process32First(HandleSnap,processEntry);//将进程列表的第一个进程信息读入记录中
  while(found)do
  begin
    if((uppercase(extractFileName(processEntry.szExeFile))=upperCase(iProcessName))
      or(uppercase(processEntry.szExeFile)=upperCase(iProcessName)))then
    begin
      if(processEntry.th32ProcessID<>selfProcessID)then//如果进程是当前进程,则不结束
      begin
        killHandle:=OpenProcess(PROCESS_TERMINATE, False, processEntry.th32ProcessID);
        TerminateProcess(killHandle,0);
      end;
      inc(count);
    end;
    found:=process32Next(HandleSnap,processEntry);//将进程列表的下一个进程信息读入记录中
  end;

  closeHandle(handleSnap);

  //搜索完所有进程后,如果要结束的进程名与当前应用程序的名字一样,则结束当前进程
  if(uppercase(iProcessName)=uppercase(extractFileName(application.ExeName)))then
  begin
    killHandle:=OpenProcess(PROCESS_TERMINATE, False, selfProcessID);
    TerminateProcess(killHandle,0);
  end;
end;

 

本文来自CSDN博客,转载请标明出处:http://blog.csdn.net/cnmmbd/archive/2009/02/07/3866266.aspx