delphi 监控其它进程

program Monitor;
 
// {$APPTYPE CONSOLE}
 
uses
  Winapi.Windows,
  System.SysUtils,
  ProcLib in 'ProcLib.pas';
 
var
  Mutex: HWND;
 
const
  c_AppName = 'server.exe';
 
begin
  Mutex := Winapi.Windows.CreateMutex(nil, False, 'Monitor');
  if (GetLastError = ERROR_ALREADY_EXISTS) or (Mutex = 0) then
    Exit;
 
  G_ExeFile := ExtractFilePath(ParamStr(0)) + c_AppName;
 
  while True do
  begin
    Sleep(2000);
    if ProcessRunning(c_AppName) then
      Continue;
 
    if G_ExeFile = '' then
      Continue;
 
    Exec(G_ExeFile);
  end;
 
end.
 
 
 
unit ProcLib;
 
interface
 
uses
  Winapi.Windows, System.SysUtils, Winapi.PsAPI,
  Winapi.TlHelp32, Winapi.ShellAPI;
 
function ProcessRunning(ExeName: string): Boolean;   

procedure Exec(FileName: string);                    

var
  G_ExeFile: string = '';
 
implementation
 
function ProcessFileName(PID: DWORD): string;
var
  Handle: THandle;
begin
  Result := '';
  Handle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
    False, PID);
  if Handle <> 0 then
    try
      SetLength(Result, MAX_PATH);
      if GetModuleFileNameEx(Handle, 0, PChar(Result), MAX_PATH) > 0 then
        SetLength(Result, StrLen(PChar(Result)))
      else
        Result := '';
    finally
      CloseHandle(Handle);
    end;
end;
 
function ProcessRunning(ExeName: string): Boolean;
var
  SnapProcHandle: THandle;
  NextProc: Boolean;
  ProcEntry: TProcessEntry32;
  ProcFileName: string;
begin
  Result := False;
  SnapProcHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if SnapProcHandle = INVALID_HANDLE_VALUE then
    Exit;
 
  try
    ProcEntry.dwSize := SizeOf(ProcEntry);
    NextProc := Process32First(SnapProcHandle, ProcEntry);
 
    while NextProc do
    begin
      if ProcEntry.th32ProcessID <> 0 then
      begin
        ProcFileName := ProcessFileName(ProcEntry.th32ProcessID);
        if ProcFileName = '' then
          ProcFileName := ProcEntry.szExeFile;
 
        if SameText(ExtractFileName(ProcFileName), ExeName) then
        begin
          Result := True;
          Break;
        end;
      end;
      NextProc := Process32Next(SnapProcHandle, ProcEntry);
    end;
  finally
    CloseHandle(SnapProcHandle);
  end;
end;
 
procedure Exec(FileName: string);
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  FillChar(StartupInfo, SizeOf(StartupInfo), #0);
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := SW_SHOWDEFAULT;
  if not CreateProcess(PChar(FileName), nil, nil, nil, False,
    CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil,
    PChar(ExtractFilePath(FileName)), StartupInfo, ProcessInfo) then
    Exit;
  WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
end;
 
end.