本文整理自网络,侵删。
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;
interfaceuses 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 deletedirectory 删除目录下所有文件包括子文件夹下所有文件
Delphi 获取动态创建的image与scrollbox的相对位置
更多相关阅读请进入《Delphi》频道 >>