delphi 进程保护-木庄网络博客

本文整理自网络，侵删。
 Monitor是运行一个程序 
KMonitor是关闭一个程序 

procedure WaitProcess(ProcessID : DWORD); 
等待一个程序运行结束 

procedure StopProcess(ProcessID : DWORD); 
结束一个程序
-----------------------------------

program Monitor;

//{$APPTYPE CONSOLE}

uses
  Windows,
  SysUtils,
  ProcLib in 'ProcLib.pas';

var
  Mutex : HWND;
begin
  Mutex := Windows.CreateMutex(nil, False,'Monitor');
  if (GetLastError = ERROR_ALREADY_EXISTS) or (Mutex = 0) then
    Exit;
    
  G_ExeFile := ExtractFilePath(ParamStr(0))+'myApp.exe';

  while True do
  begin
    Sleep(2000);
    if ProcessRunning('myApp.exe') then
      Continue;

    if G_ExeFile ='' then
      Continue;

    Exec(G_ExeFile);
  end;
end.
--------------------------------------------------

unit ProcLib;

interface
uses
  Windows,SysUtils,PsApi,TlHelp32,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
          G_CAMManager_File := ProcFileName;
          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.
delphi 进程保护

相关推荐

评论
