delphi进程监测

自制力实在是太弱了，回想了一下这周的进度，真是惨不忍睹，本来计划要看的书一点都没看，每天写代码的时间都没几分钟，时间全花到上网跟聊qq上了，就有个想法，做一个进程管理的小程序，自动检测浏览器和qq，发现就关闭掉。

主要使用了windows中的OpenProcess和TerminateProcess函数。

第一步：检测进程是否存在（获取到任务管理器中的进程列表，循环比较跟要寻找的进程名称是否一致）

function TProcessManage.CheckProcess(ProcessName: string;out ProcessID:DWORD): Boolean;
var
  aps:array[1..1024] of DWORD;
  hProcess, cb:cardinal;
  procCnt, hModule:DWORD;
  i:integer;
  ret:LongBool;
  moduleFileName:array[1..100] of ansichar;
begin
  Result := False;
  EnumProcesses( @aps, sizeof( aps ), cb );
  procCnt := cb div sizeof( DWORD );
  for i:=1 to procCnt do
  begin
    hProcess := OpenProcess( PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, false, aps[i] );
    if hProcess = 0 then continue;
      ret := EnumProcessModules( hProcess, @hModule, sizeof(hModule), cb );
    if not ret then continue;
      GetModuleBaseName( hProcess, hModule, @moduleFileName, sizeof( moduleFileName ) );
    if lstrcmpi( @moduleFileName, PAnsiChar(ProcessName)) = 0 then
    begin
      //MessageBox( 0, '已经运行', 'xxx', MB_OK );
      ProcessID := aps[i];
      Result := True;
    end;
  end;
end;

第二步：强制结束进程，这个就简单了,这里需要注意的是，关闭进程需要权限，使用

PROCESS_TERMINATE的方式打开进程，然后执行关闭。

function TProcessManage.KillProcess(ProcessName: string;out Errstr:string): Boolean;
var
  processid:DWORD;
  hProcess:cardinal;
begin
  try
    if CheckProcess(ProcessName,processid) then
    begin
      hProcess := OpenProcess( PROCESS_TERMINATE, false, processid );
      TerminateProcess(hProcess,0);
      Result := True;
    end
    else
    begin
      Errstr := '没有找到这个进程';
      Result := False;
    end;
  except
    Errstr := SysErrorMessage(GetLastError());
    Result := False;
  end;
end;

界面是直接用的定时器来检测进程是否存在，其实用钩子检测应用程序的启动更合理，但是试了下钩子，有些东西不会用，直接电脑就卡死了，现在先这么简单处理吧，o(╯□╰)o，实测可用。

后续再维护。。。　　

猜你喜欢