Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Sonstige Fragen zu Delphi (https://www.delphipraxis.net/19-sonstige-fragen-zu-delphi/)
-   -   Delphi Programmfortschritt zwischendurch zeigen? (https://www.delphipraxis.net/14478-programmfortschritt-zwischendurch-zeigen.html)

Uncle Cracker 9. Jan 2004 23:20


Programmfortschritt zwischendurch zeigen?
 
Ich habe folgenden Quelltext gefunden, um ein DOS-Programm zustarten und anzeigen zulassen, was im DOS-Fenster passiert:

Delphi-Quellcode:
{....}
  private
    function RunCaptured(const _dirName, _exeName, _cmdLine: string): Boolean;

{....}

function TForm1.RunCaptured(const _dirName, _exeName, _cmdLine: string): Boolean;
var
  start: TStartupInfo;
  procInfo: TProcessInformation;
  tmpName: string;
  tmp: Windows.THandle;
  tmpSec: TSecurityAttributes;
  res: TStringList;
  return: Cardinal;
begin
  Result := False;
  try
    { Setze ein Temporäres File }
    { Set a temporary file }
    tmpName := 'Test.tmp';
    FillChar(tmpSec, SizeOf(tmpSec), #0);
    tmpSec.nLength := SizeOf(tmpSec);
    tmpSec.bInheritHandle := True;
    tmp := Windows.CreateFile(PChar(tmpName),
           Generic_Write, File_Share_Write,
           @tmpSec, Create_Always, File_Attribute_Normal, 0);
    try
      FillChar(start, SizeOf(start), #0);
      start.cb         := SizeOf(start);
      start.hStdOutput := tmp;
      start.dwFlags    := StartF_UseStdHandles or StartF_UseShowWindow;
      start.wShowWindow := SW_Minimize;
      { Starte das Programm }
      { Start the program }
      if CreateProcess(nil, PChar(_exeName + ' ' + _cmdLine), nil, nil, True,
                       0, nil, PChar(_dirName), start, procInfo) then
      begin
        SetPriorityClass(procInfo.hProcess, Idle_Priority_Class);
        WaitForSingleObject(procInfo.hProcess, Infinite);
        GetExitCodeProcess(procInfo.hProcess, return);
        Result := (return = 0);
        CloseHandle(procInfo.hThread);
        CloseHandle(procInfo.hProcess);
        Windows.CloseHandle(tmp);
        { Die Ausgaben hinzufügen }
        { Add the output }
        res := TStringList.Create;
        try
          res.LoadFromFile(tmpName);
          Memo1.Lines.AddStrings(res);
        finally
          res.Free;
        end;
        Windows.DeleteFile(PChar(tmpName));
      end
      else
      begin
        Application.MessageBox(PChar(SysErrorMessage(GetLastError())),
          'RunCaptured Error', MB_OK);
      end;
    except
      Windows.CloseHandle(tmp);
      Windows.DeleteFile(PChar(tmpName));
      raise;
    end;
  finally
  end;
end;

// Beispiel:

procedure TForm1.Button1Click(Sender: TObject);
begin
  RunCaptured('C:\', 'cmd.exe', '/c dir');
end;

Nun meine Frage:

Leider zeigt diese Funktion nur am Ende an, was im DOS-Fenster passiert ist, jedoch nicht, was zwischen durch alles gemacht wurde, d.h. dass das mein Programm sich so lange aufhängt, bis das DOS-Programm beendet wurde. Das hat den Nachteil bei Programmen die mehr machen, dass sich mein Programm dann mal über eine Minute aufhängt.

Gibt es vielleicht eine Möglichkeit zwischendurch sich den Fortschritt des DOS-Programmes anzeigen zulassen, damit das Programm sich nicht mehr so lange aufhängt, sondern auch gezeigt wird, was so alles passiert.

Vielleicht kann man mir jemand helfen, da er sowas schon mal gemacht hat.


:love: Danke UC

Luckie 10. Jan 2004 03:34

Re: Programmfortschritt zwischendurch zeigen?
 
Mit dem Code wird es kaum gehen, da es zum Schluß die Ausgaeb in eine Datei schreibt, welche dann in das Memo geladen wird. Man müsste mit Pipes die ausgabe direkt umleiten. Frag aber nicht wie genau, habe ich auch noch nie gemacht.

http://msdn.microsoft.com/library/de...bout_pipes.asp

SirThornberry 10. Jan 2004 09:22

Re: Programmfortschritt zwischendurch zeigen?
 
guck mal ob du aus der funktion was machen kannst
Delphi-Quellcode:
procedure TForm1.GetPipeOutput(Befehl: String; Parameter: String; Output: TStringlist; Input: TStringlist);
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  SecurityAttr: TSecurityAttributes;
  PipeOutputRead: THandle;
  PipeInputRead: THandle;
  PipeOutputWrite: THandle;
  Buffer: Array[0..255] of Char;
  count: Integer;
  NumberOfBytesRead: DWORD;
  Stream: TMemoryStream;
begin
 Application.Title := input.Text;
 WriteFile(PipeInputRead, input.Text[1], length(input.Text), NumberOfBytesRead, nil);

 FillChar(SecurityAttr, SizeOf(TSecurityAttributes), 0);
 SecurityAttr.nLength := SizeOf(SecurityAttr);
 SecurityAttr.bInheritHandle := true;
 SecurityAttr.lpSecurityDescriptor := nil;
 CreatePipe(PipeOutputRead, PipeOutputWrite, @SecurityAttr, 0);

 //Initialisierung StartupInfo
 FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
 StartupInfo.cb:=SizeOf(StartupInfo);
 StartupInfo.hStdInput := PipeInputRead;
 StartupInfo.hStdOutput := PipeOutputWrite;
 StartupInfo.wShowWindow := sw_hide;
 StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;

 if CreateProcess(nil, PChar(Befehl + ' ' + Parameter), nil, nil, true,
  CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil,
  StartupInfo, ProcessInfo) then
 begin
  Stream := TMemoryStream.Create; count := 0;
  repeat
   buffer := '';
   ReadFile(PipeOutputRead, Buffer, 255, NumberOfBytesRead, nil);
   Stream.Write(Buffer, NumberOfBytesRead);
   count := count + 1;
  until count * 255 > stream.size;
  Stream.Position := 0;
  output.LoadFromStream(Stream);
  Stream.Free;
  CloseHandle(PipeOutputRead);
 end;
end;
[Edit1]Fehler im Quelltext behoben[/Edit1]
[Edit2]Irgendwie ist hier noch der Wurm drin aber sollte Helfen um das mit den Pipes zu verdeutlichen[/Edit2]


Alle Zeitangaben in WEZ +1. Es ist jetzt 15:28 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz