CreateProcess, WaitForSingleObject, отключить ввод при вызове приложения
Я звоню в другую Программу, которая отображает только такую веб-страницу:
Проблема: если я создаю процесс с помощью кнопки, и пока открыт созданный процесс, я нажимаю флажок в форме вызова, закрываю созданный процесс, флажок отмечается.
Я попытался использовать DisableTaskWindows(0), как показано в функции.ShowModal. Но это не работает, как я ожидал. Пока он отключает форму. Но после того, как я включил его, похоже, что форма все равно обрабатывает событие click. Вроде как, если есть очередь сообщений или что-то.
Может кто-нибудь сказать мне, что я здесь делаю не так?
procedure TForm1.Button1Click(Sender: TObject);
var
StartupInfo : TStartupInfo;
ProcessInfo : TProcessInformation;
ProcessCreated : Boolean;
CommandLine : string;
WindowList: TTaskWindowList;
begin
WindowList := DisableTaskWindows(0);
CommandLine:='webmodule.exe';
uniqueString(CommandLine);
ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
StartupInfo.cb := SizeOf(StartupInfo);
ProcessCreated := CreateProcess(PChar(nil), PChar(CommandLine), nil, nil, false, 0, nil, nil, StartupInfo, ProcessInfo);
if ProcessCreated then
WaitForSingleObject(ProcessInfo.hProcess, INFINITE)
else
ShowMessage('Error : could not execute!');
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
EnableTaskWindows(WindowList);
end;
ОБНОВИТЬ
К сожалению, я не уверен, как использовать функцию RegisterWaitForSingleObject... Я пробовал это, но не работает. Может быть, мне не хватает CallBack? Но я понятия не имею, как его использовать.
if ProcessCreated then
begin
// WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
while (RegisterWaitForSingleObject(ProcessInfo.hProcess,ProcessInfo.hProcess,nil,nil,INFINITE,0) = false) do
begin
Form1.Color:=RGB(random(255),random(255),random(255));
Application.ProcessMessages;
end;
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
end
else
ShowMessage('Error : could not execute!');
ОБНОВЛЕНИЕ 2:
Я думаю, что, возможно, решил это, я удалил Enable Disable для формы. Вместо этого я делаю это после того, как я выполнил процесс.
while PeekMessage(Msg, 0, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE or PM_NOYIELD) do;
while PeekMessage(Msg, 0, WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE or PM_NOYIELD) do;
1 ответ
Проблема заключается в том, что вы блокируете основной цикл сообщений вашего приложения, ожидая завершения вызываемого процесса, поэтому вы не позволяете приложению обрабатывать пользовательский ввод до тех пор, пока этот процесс не завершится. Вы должны позволить своему приложению нормально обрабатывать сообщения, не блокировать их. Если вы отключите свою форму во время работы порожденного процесса, пользовательский ввод будет автоматически отклонен для вас.
Попробуйте что-то вроде этого:
procedure TForm1.Button1Click(Sender: TObject);
var
StartupInfo : TStartupInfo;
ProcessInfo : TProcessInformation;
CommandLine : string;
begin
CommandLine := 'webmodule.exe';
UniqueString(CommandLine);
ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
StartupInfo.cb := SizeOf(StartupInfo);
if not CreateProcess(PChar(nil), PChar(CommandLine), nil, nil, FALSE, 0, nil, nil, StartupInfo, ProcessInfo) then
begin
ShowMessage('Error : could not execute!');
Exit;
end;
CloseHandle(ProcessInfo.hThread);
Enabled := False;
repeat
case MsgWaitForMultipleObjects(1, ProcessInfo.hProcess, FALSE, INFINITE, QS_ALLINPUT) of
WAIT_OBJECT_0: Break;
WAIT_OBJECT_0+1: Application.ProcessMessages;
else
begin
ShowMessage('Error : could not wait!');
Break;
end;
end;
until False;
CloseHandle(ProcessInfo.hProcess);
Enabled := True;
end;
Или это:
type
TForm1 = class(ToFrm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
...
private
hWaitObj, hWaitProcess: THandle;
procedure WaitFinished;
...
end;
...
procedure WaitCallback(lpParameter: Pointer; WaitFired: Boolean); stdcall;
begin
TThread.Queue(nil, TForm1(lpParameter).WaitFinished);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
StartupInfo : TStartupInfo;
ProcessInfo : TProcessInformation;
CommandLine : string;
begin
CommandLine := 'webmodule.exe';
UniqueString(CommandLine);
ZeroMemory(@StartupInfo, SizeOf(StartupInfo));
StartupInfo.cb := SizeOf(StartupInfo);
if not CreateProcess(PChar(nil), PChar(CommandLine), nil, nil, FALSE, 0, nil, nil, StartupInfo, ProcessInfo) then
begin
ShowMessage('Error : could not execute!');
Exit;
end;
CloseHandle(ProcessInfo.hThread);
if not RegisterWaitForSingleObject(hWaitObj, ProcessInfo.hProcess, WaitCallback, Self, INFINITE, WT_EXECUTELONGFUNCTION or WT_EXECUTEONLYONCE) then
begin
CloseHandle(ProcessInfo.hProcess);
ShowMessage('Error : could not wait!');
Exit;
end;
hWaitProcess := ProcessInfo.hProcess;
Enabled := False;
end;
procedure TForm1.WaitFinished;
begin
UnregisterWait(hWaitObj);
CloseHandle(hWaitProcess);
Enabled := True;
end;