TThread выполняет что-либо пока работает запущенная им программа

[Человек_Борща]

Всем привет!
Вернусь к вам со своим бараном=)

Собственно:
поток TThread запускает програму используя функцию CreateProcess и ждёт когда та отживёт своё:

WaitForSingleObject(ProcessInform.hprocess,Inifinite);

Проблема:
Изменить работу потока таким образом, чтобы пака работает программа поток что-то выполнял. К примеру: Сверял время с системным, и завершил программу в указанное время, а затем и сам закрылся.

Собственно перечитал много чего=) Много где советовали использовать результаты WaitForSingleObject. Делаю:

procedure TTThread.Execute;
var
  Reasson: DWORD;
  PrcI: TProcessInformation;
  SI: TStartupInfo;

begin
  ZeroMemory(@SI, SizeOf(SI));
  Si.cb := SizeOf(SI);
  CreateProcess(PAnsiChar(MainForm.AppEdit.Text), nil, nil, nil, False, 0, nil, nil, SI, PrcI);
  repeat
    Reasson := WaitForSingleObject(PrcI.hProcess, 100);
    if Reasson = WAIT_OBJECT_0 then
    begin
      if TimeToStr(Now) = MainForm.TimeEdit.Text then
      begin
        TerminateProcess(PrcI.dwProcessId, 0);
        Break;
        Terminate;
      end;
    end;
  until Reasson <> Wait_TIMEOUT;
end;

Но результата НОЛЬ.
Может время не привельно сверяю? Может ещё что-то?

Нарвался на статью "Синхронизация процессов при работе с Windows (статья)" в DRKB прочитал и перечитал, и понял что я чего-то не понимаю, а именно "Что такое сигнальное состояние?".

Выкладываю проект, может там ошибка..

[wm_leviathan]

примерно так

procedure TMainForm.Something;
begin
Form1.Edit1.Text:= InttoStr(Answer);
CopyFile('c:\3\123.exe', 'd:\1\123.exe');
end;
//------
procedure TThreadCopy.Execute;
var
begin
CopyFile(mainForm.Source+'\'+ThreadMonFile.NewF , mainForm.Dest+'\'+ThreadMonFile.NewF);
Synchronize(MainForm.Something);
end;

Проблема:
Изменить работу потока таким образом, чтобы пака работает программа поток что-то выполнял. К примеру: Сверял время с системным, и завершил программу в указанное время, а затем и сам закрылся.

Пока работает программа поток и так выполняет а именно он то запускает и следит за запущенной прогой. тогда вам надо чтобы не поток запускал и следил а сама программа. либо пусть тогда поток запускает а программа в это время следит. чуть чуть изменил ваш пример:
поток открывает и следит в то время как главная форма делает ShowMessage.
почему то не дает сделать вложение

procedure TMainForm.LaunchBtnClick(Sender: TObject);
begin
  Thr := TTThread.Create(True);
  Thr.FreeOnTerminate := True;
  Thr.Priority := tpNormal;
  Thr.Resume;
  hello;
end;
procedure TMainForm.Hello;
var i:integer;
begin
  for i:=0 to 15 do
  showmessage('Привет');
end;

[maxionans]

Ты напутал с обработкой значений, возвращаемых функцией WaitForSingleObject. Вот так будет правильно:

procedure TTThread.Execute;
var
  Reasson: DWORD;
  PrcI: TProcessInformation;
  SI: TStartupInfo;

begin
  ZeroMemory(@SI, SizeOf(SI));
  Si.cb := SizeOf(SI);
  CreateProcess(PAnsiChar(MainForm.AppEdit.Text), nil, nil, nil, False, 0, nil, nil, SI, PrcI);
  repeat
    Reasson := WaitForSingleObject(PrcI.hProcess, 100);
    if Reasson = WAIT_TIMEOUT then
    begin
      if TimeToStr(Now) = MainForm.TimeEdit.Text then
      begin
        TerminateProcess(PrcI.dwProcessId, 0);
        Break;
        Terminate; <<< это зачем? код в теле цикла после Break не выполняется  
      end;
    end;
  until Reasson <> WAIT_TIMEOUT;
end;

Жирным отмечены места, на которые следует обратить внимание.

[Человек_Борща]

Мне необходимо чтобы поток запускал и ждал завершения того что запустил. А пока он ждёт завершения то, он сверяет системное время с заданным, и в заданное время он убивает то что запустил.

maxionans
Попровал согласно вашему замечанию.

Но :

      if TimeToStr(Now) = MainForm.TimeEdit.Text then
      begin
        TerminateProcess(PrcI.dwProcessId, 0);
        Break;
      end;

не сработатывает. Почему?

[maxionans]

для начала нужно проверить, входит ли выполнение кода в условное ветвление "if Reasson = WAIT_TIMEOUT then". Если входит, тогда искать проблему в сравнении "TimeToStr(Now) = MainForm.TimeEdit.Text". Вообще, лучше TimeEdit заменить на TDateTimePicker и сравнивать как "if CompareTime( Now, DateTimePicker.Time ) >= 0 then".

[Человек_Борща]

условие

if Reasson = WAIT_TIMEOUT then

Проходит.
Далее если указанное время уже прошло или сейчас есть. То прыгает в :

TerminateProcess(PrcI.dwProcessId, 0);

Затем на Break.
Затем END; тела TThread.execute;
Потом идёт в:

function GetCurrentThreadId; external kernel32 name 'GetCurrentThreadId';

Затем, через пару прыжков по Windows.pas:

function WaitForSingleObject; external kernel32 name 'WaitForSingleObject';

Затем лезет в класс Tthread и пытвается уничтожить поток зная что
TmyThread.FreeOnTerminate:=TRUE;

Затем AccessViolation с обращением к нулям.

И всё при условии что TerminateProcess так и небыло выполнено! Запущенная программа продолжает работать!

Я в недоумении...

[maxionans]

У тебя в TerminateProcess передаётся идентификатор процесса, но туда нужен его хендл: TerminateProcess( PrcI.hProcess ). И не забудь закрывать хендлы процесса перед выходом из потока: CloseHandle( PrcI.hProcess ) и CloseHandle( PrcI.hThread ). А с Access Violation отдельно разбираться надо.

[Человек_Борща]

Ура, работает!

procedure TTThread.Execute;
var
  Reasson: DWORD;
  PrcI: TProcessInformation;
  SI: TStartupInfo;

begin
  ZeroMemory(@SI, SizeOf(SI));
  Si.cb := SizeOf(SI);
  CreateProcess(PAnsiChar(MainForm.AppEdit.Text), nil, nil, nil, False, 0, nil, nil, SI, PrcI);
  repeat
    Reasson := WaitForSingleObject(PrcI.hProcess, 100);
     if Reasson = WAIT_TIMEOUT then
    begin
      if CompareTime(Now, MainForm.TimeEdit.Time ) >= 0 then
      begin
        TerminateProcess(PrcI.hProcess, 0);
        CloseHandle(PrcI.hProcess);
        CloseHandle(PrcI.hThread);
        Break;
      end;
    end;
  until Reasson <> Wait_TIMEOUT;
end;

Вопрос решён!
maxionans отдельное большое спасибо и +