Thread mit Timeout

[Astat]

Hallo Reinhard Kern.

Zitat von Reinhard Kern:

..,schön und gut, aber das muss man dann in einem anderen thread aufrufen - wenn man Wait.. aufruft, wartet der thread ja nur. WaitForSingleObjectUndTuInzwischenWas gibt es meines Wissens nicht.

Naja etwas kreativität sollte man schon hineinfliessen lassen.

Anbei ein Ansatz wie soetwas realisiert werden kann.

Delphi-Quellcode:

function StartPEFile(szFileName: PChar; Visibility: integer; szWorkDir: PChar;
  dwTimeOut: DWORD = 10000): integer;
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
begin
  Result := -1;
  FillChar(StartupInfo, Sizeof(StartupInfo), 0);
  StartupInfo.cb := Sizeof(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;

  if CreateProcess(
     nil,                           { pointer to command line string }
     szFileName,
     nil,                           { pointer to process security attributes }
     nil,                           { pointer to thread security attributes}
     false,                         { handle inheritance flag }
     CREATE_NEW_CONSOLE or          { creation flags }
     NORMAL_PRIORITY_CLASS,
     nil,                           { pointer to new environment block}
     szWorkDir,                     { pointer to current directory name }
     StartupInfo,                   { pointer to STARTUPINFO }
     ProcessInfo)                   { pointer to PROCESS_INF }
  then begin
    //-- Max Timeot warten bis Application MSQ gestartet hat.
    if WaitforInputIdle(ProcessInfo.hProcess, dwTimeOut) = 0 then
      //-- Ist en Errorcode vorhanden?
      GetExitCodeProcess(ProcessInfo.hProcess, DWORD(Result))
    else
       Result := -1;
    //-- ProcessInfo Struct kann auch global zwischengespeichert werden,
    //-- um nachträglich wieder auf die Application zuzuggreifen, bzw. zu steuern
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ProcessInfo.hProcess);
  end;
end;

function StarterThread(ptrData: Pointer): Integer;
begin
  if StartPEFile(PChar('c:\myProg.exe'), SW_SHOWNORMAl, nil) <> 0 then
    RaiseLastWin32Error;
end;

var
  _hStartThread, _dwServerThreadID: DWORD;
begin
  //-- Programm Asynchron Starten (StarterThread)
  //-- Eventuelle Startparameter können über Heap oder Stack ünergeben werden
  //-- Achtung Stackvariablen sind nach verlassen der Procedure nicht mehr gültig.
  //-- _hStartThread kann wenn notwendig auch eine Globale Threadliste usw. sein.
  //-- Damit ist es möglich nachträglich den Thread zu steuern
  _hStartThread := BeginThread(nil, 0, StarterThread, nil, 0 ,_dwServerThreadID);
end.

lg. Astat