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;

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;

NextProc := Process32Next(SnapProcHandle,ProcEntry);

end;

finally

CloseHandle(SnapProcHandle);

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.

推荐分享