监控其它进程

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.

posted @ 2012-05-22 10:54  delphi中间件  阅读(509)  评论(0编辑  收藏  举报