| Код | uses
Windows, Classes, SysUtils, acConst;
resourcestring
warProcessFinally = 'Процесс принудительно завершен.';
type
eStartExecuteCommand = class(Exception);
type
tIdleProc = procedure (var KillProcess :Boolean);
tApMsg = procedure ();
function WaitExecuteCommand (const CmdLine :String;
const WorkDirectory :String;
const ShowMode :Integer =SW_SHOWNORMAL;
const IdleProc :tIdleProc =Nil;
const ProcessMsg :tApMsg =Nil
) :Cardinal;
implementation
function StartExecuteCommand (const CmdLine :String;
const WorkDirectory :String;
const ShowMode :Integer =SW_SHOWNORMAL
) :tHandle;
const
CreationFlags = CREATE_NEW_CONSOLE + NORMAL_PRIORITY_CLASS;
StartupFlags = STARTF_USESHOWWINDOW + CREATE_SEPARATE_WOW_VDM;
var
StartUpInfo :tStartUpInfo;
ProcessInfo :tProcessInformation;
pDir :pChar;
begin
{CreateProcess возвращает ошибку, если ему передать пустую строку в WorkDir,
в этом случае надо передавать Nil}
if Length(WorkDirectory) = 0 then
pDir := Nil
else
pDir := pChar(WorkDirectory);
FillChar(StartupInfo,Sizeof(StartupInfo),#0);
StartupInfo.cb := Sizeof(StartupInfo);
StartupInfo.dwFlags := StartupFlags;
StartupInfo.wShowWindow := ShowMode;
if not CreateProcess(Nil,pChar(CmdLine),Nil,Nil,false,CreationFlags,nil,
pDir,StartupInfo,ProcessInfo) then
raise eStartExecuteCommand.Create(SysErrorMessage(GetLastError()));
Result := ProcessInfo.hProcess;
end;
function WaitExecuteCommand (const CmdLine :String;
const WorkDirectory :String;
const ShowMode :Integer =SW_SHOWNORMAL;
const IdleProc :tIdleProc =Nil;
const ProcessMsg :tApMsg =Nil
) :Cardinal;
const
SuspendTime = 200; // время (в милисекундах) на которое вызывающий процесс
// приостанавливается в цикле ожидания
var
hProcess :tHandle;
KillProcess :Boolean;
ProcessKilled :Boolean;
begin
// запуск процесса
hProcess := StartExecuteCommand(CmdLine,WorkDirectory,ShowMode);
// процесс успешно запущен, ждём завершения
KillProcess := False;
ProcessKilled := False;
repeat
if Assigned(ProcessMsg) then ProcessMsg;
KillProcess := ProcessKilled;
if Assigned(IdleProc) then IdleProc(KillProcess);
if (KillProcess {or Application.Terminated}) and not ProcessKilled then begin
TerminateProcess(hProcess,ERROR_PROCESS_ABORTED);
ProcessKilled := True;
end;
until (WaitforSingleObject(hProcess,SuspendTime)<>WAIT_TIMEOUT);
if ProcessKilled then
raise eStartExecuteCommand.Create(warProcessFinally);
// узнаем код завершения процесса
if not GetExitCodeProcess(hProcess,Result) then
// Хм, Ошибка? Что-бы это могло быть?
raise eStartExecuteCommand.Create(SysErrorMessage(GetLastError()));
end; |
|