监控其它进程

╰+哭是因爲堅強的太久メ 2022-03-29 07:18 234阅读 0赞

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.