DosCommand problem + Inhalt wird zuspät ausgegeben

Xhead · Hält's aus hier Beiträge: 8

Hallo,

ich hab ein kleines Problem mit Doscommand (das hier: Link)
Und zwar möchte ich den Inhalt der dosbox auslesen. Gestartet wird xvid_encraw.exe oder x264.exe (beides sind cli progs fürs encoden)

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:

procedure TForm1.cmdNewLine(Sender: TObject; NewLine: string; OutputType: TOutputType);
begin
//Irgendwas mit NewLine machen.
Memo1.Lines.Add(NewLine);
//showmessage('neue zeile');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
a:string;
begin
//auch mit cmd /c davor versucht
a := 'xvid_encraw -i "bla.avi" -pass1 xvid.stats -size 1000 -max_key_interval 250 -quality 6 -vhqmode 4 -bvhq -zones 0,w,1.0,0OC -threads 2';
cmd.commandline:= a;
cmd.execute;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   cmd:= TDoscommand.Create(self);
   cmd.onNewLine := cmdNewLine;

end;

Das Problem ist nun, dass der Inhalt Zeile für Zeile erst ausgegeben wird, nachdem der encode fertig ist. Ich brauche den Inhalt für eine Progressbar und ein paar Statistikausgaben

Die Frage ist nun, benutze ich doscommand falsch oder ist das mit doscommand nicht möglich während des encodes den text auszulesen?

Einloggen, um Attachments anzusehen!

JayEff · Beiträge: 2971 Windows Vista Ultimate D7 Enterprise

nun das sind keine normalen textausgaben, da normale textausgaben im dosfenster zeile für zeile ausgegeben werden. bei einer progressbar ist das natürlich anders. du wirst vermtl. mit dieser console app nicht auf die art weiter kommen...

Edit: hmm eigentlich hab ich die nachricht wieder löschen wollen, nicht absenden - naja. Ich bin mir mit der Aussage nicht grad 100% sicher ^^

_________________
>+++[>+++[>++++++++<-]<-]<++++[>++++[>>>+++++++<<<-]<-]<<++
[>++[>++[>>++++<<-]<-]<-]>>>>>++++++++++++++++++.+++++++.>++.-.<<.>>--.<+++++..<+.

Xhead · Hält's aus hier Beiträge: 8

Zitat:

nun das sind keine normalen textausgaben, da normale textausgaben im dosfenster zeile für zeile ausgegeben werden. bei einer progressbar ist das natürlich anders. du wirst vermtl. mit dieser console app nicht auf die art weiter kommen...

Hmm sowas ähnliches hab ich mir schon gedacht....
Irgend eine Idee wie man das sonst noch auslesen kann?

JayEff · Beiträge: 2971 Windows Vista Ultimate D7 Enterprise

Ich würde beinah wetten, dass es die gibt.
Die Frage ist vielmehr, wie kompliziert ist es und lohnt sich der Aufwand? Auf den Code der Console Apps hast du sicherlich keinen Zugriff...? Ah, encoding Programme von XVid, wa?

_________________
>+++[>+++[>++++++++<-]<-]<++++[>++++[>>>+++++++<<<-]<-]<<++
[>++[>++[>>++++<<-]<-]<-]>>>>>++++++++++++++++++.+++++++.>++.-.<<.>>--.<+++++..<+.

Xhead · Hält's aus hier Beiträge: 8

Also falls das weiterhilft, hier kann man sich den sourcecode vom x264 anschauen, der verhält sich genauso wie die xvid cli bei der Ausgabe mit Doscommand. (Sieht auch optisch sehr ähnlich aus

)
trac.videolan.org/x2...rowser/trunk?rev=677

Und das programm MeGUI kann macht genau das was ich will, bezüglich der Progressbar
Davon habe ich grade auch den Sourcecode gefunden... Ist ne andere P-Sprache und die stelle mit dem auslesen hab ich noch nicht finden können.
megui.svn.sourceforg...svnroot/megui/trunk/

Narses · Verfasst: Di 25.09.07 22:09

Moin!

Soo entsetzlich schwer ist das nun auch wieder nicht, das Prinzip ist das gleiche, wie bei dir | more

Schau mal hier, im Prinzip müsstest du die Funktion nur in einem eigenen Thread starten (also den CommandlineEncoder aufrufen) und dann statt mit ReadPipeToString die ganze Pipe auf einmal in einen String zu lesen, immer wieder den gelesenen Teil als String z.B. per synchronisiertem Ereignis aus dem Thread an deine Applikation liefern. Dort kannst du dann die Ausgabe zerlegen und untersuchen. :idea:

Aber, ehrlich gesagt, ziemlich viel Aufwand...

Hat dieser Encoder nicht noch eine andere Schnittstelle, wo man den Fortschritt abgreifen kann? :nixweiss:

cu
Narses

_________________
There are 10 types of people - those who understand binary and those who don´t.

Xhead · Hält's aus hier Beiträge: 8

Zitat:

Hat dieser Encoder nicht noch eine andere Schnittstelle, wo man den Fortschritt abgreifen kann? :nixweiss:

Ist mir nicht bekannt... :nixweiss:

Das mit dem 2ten Thread sieht kompliziert aus, muss der encoder also quasi in einem extra Thread gestartet werden oder die funktion zum Auslesen?

Edit//

Ich hab vollgendes gefunden: www.hochstrasser.org/wiki/files/RedCon.zip
Damit könnte das doch gehen!?
Aber ich bekomme ne Fehlermeldung: (aus der redcon.pas)
[DCC Fehler] redcon.pas(195): E2033 Die Typen der tatsächlichen und formalen Var-Parameter müssen übereinstimmen

JayEff · Beiträge: 2971 Windows Vista Ultimate D7 Enterprise

Schätze, der Fehler ist in der Zeile 195 der redcon.pas. Mehr spuckt die Kristallkugel nicht aus, ist so undeutlich :gruebel:

_________________
>+++[>+++[>++++++++<-]<-]<++++[>++++[>>>+++++++<<<-]<-]<<++
[>++[>++[>>++++<<-]<-]<-]>>>>>++++++++++++++++++.+++++++.>++.-.<<.>>--.<+++++..<+.

Xhead · Hält's aus hier Beiträge: 8

Das der Fehler in Zeile 195 ist ist mir schon klar. hier mal meine Unit:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, doscommand, StdCtrls, redcon;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure OnConStdOut(Sender: TObject; s: String);
    procedure FormCreate(Sender: TObject);
    procedure cmdNewLine(Sender: TObject; NewLine: string; OutputType: TOutputType);
    procedure OnConRun(Sender: TOBject);
    procedure OnConStdErr(Sender: TObject; s: String);
    procedure FormDestroy(Sender: TObject);
    function CliRun(cmdline: string): integer;
//procedure cmdTerminated(Sender: TObject; ExitCode: Cardinal);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
     cmd: TDoscommand;
     fcon:TRedirectedConsole;

implementation

{$R *.dfm}

procedure TForm1.OnConStdOut(Sender: TObject; s: String);
begin
  memo1.Lines.Append(s);
end;

procedure TForm1.OnConRun(Sender: TOBject);
begin
  Application.ProcessMessages;
  Sleep(10);
end;

procedure TForm1.OnConStdErr(Sender: TObject; s: String);
begin
  memo1.Lines.Append(s);
end;

procedure TForm1.OnConRun(Sender: TOBject);
begin
  Application.ProcessMessages;
  Sleep(10);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
a:string;
sl: TStringList;
begin
  a             := 'xvid_encraw -i "bla.avi" -pass1 xvid.stats -size 1000 -max_key_interval 250 -quality 6 -vhqmode 4 -bvhq -zones 0,w,1.0,0OC -progress 50 -threads 2';

  fCon.OnStdOut := OnConStdOut;
  fCon.OnStdErr := OnConStdErr;
  fCon.OnRun := OnConRun;
  fCon.Run;
end;

procedure TForm1.FormCreate(Sender: TObject);

begin
   fCon.Free;
end;
end.

und die Redcon.pas

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:

unit RedCon;

(*
simple yet working console i/o redirection
(c) 2002-2004 bhoc@pentagroup.ch
freeware

there are two Data events (OnStdOut and OnStdErr) that return a string;
two other events just signal that the program is running or that it has ended.
the SendData() method will submit a string to an open application such as cmd.exe.

sample:

procedure TForm1.Button1Click(Sender: TObject);
begin
  fCon := TRedirectedConsole.Create(Edit1.Text);
  fCon.OnStdOut := OnConStdOut;
  fCon.OnStdErr := OnConStdErr;
  fCon.OnRun := OnConRun;
  fCon.OnEnd := OnConEnd;
  fCon.Run;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  fCon.Free;
end;

procedure TForm1.OnConStdOut(Sender: TObject; s: String);
begin
  memo1.Lines.Append(s);
end;

procedure TForm1.OnConStdErr(Sender: TObject; s: String);
begin
  memo2.Lines.Append(s);
end;

procedure TForm1.OnConRun(Sender: TOBject);
begin
  Application.ProcessMessages;
  Sleep(10);
end;

procedure TForm1.OnConEnd(Sender: TOBject);
begin
  MessageBox(Application.Handle, 'Program has ended', 'Program Ended', MB_OK or MB_ICONINFORMATION or MB_SETFOREGROUND);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  fCon.SendData(edit2.Text + #13#10);
end;

*)

interface

uses windows;

type
  TOnData = procedure(Sender: TObject; Data: String) of object;
  TOnRun = procedure(Sender: TObject) of object;
  TRedirectedConsole = Class(TObject)
  private
    fExitTimeOut: Integer;
    fStdInRead, fStdInWrite: THandle;
    fStdOutRead, fStdOutWrite: THandle;
    fStdErrRead, fStdErrWrite: THandle;
    fSA: TSecurityAttributes;
    fPI: TProcessInformation;
    fSI: TStartupInfo;
    fDestroying: Boolean;
    fCmdLine: String;
    fOnStdOut, fOnStdErr: TOnData;
    fOnRun, fOnEnd: TOnRun;
    fIsRunning: Boolean;
    fHidden: boolean;
    fMerge: boolean;
    fStdOut, fStdErr: String;
    function ReadHandle(h: THandle; var s: string): integer;
    Procedure EndProcess(hProc: THandle);
  protected
  public
    constructor Create(CommandLine: String);
    destructor Destroy; override;
    procedure Run;
    procedure Stop;
    procedure SendData(s: String);
    property ExitTimeOut: integer read fExitTimeout write fExitTimeout;
    property OnStdOut: TOnData read fOnStdOut write fOnStdOut;
    property OnStdErr: TOnData read fOnStdErr write fOnStdErr;
    property OnRun: TOnRun read fOnRun write fOnRun;
    property OnEnd: TOnRun read fOnEnd write fOnEnd;
    property MergeOutput: boolean read fMerge write fMerge;
    property IsRunning: boolean read fIsRunning;
    property HideWindow: boolean read fHidden write fHidden;
    property StdOut: string read fStdOut;
    property StdErr: string read fStdErr;
  end;

implementation

const BufSize = 1024;

constructor TRedirectedConsole.Create(CommandLine: String);
begin
  inherited Create;
  fCmdLine := CommandLine;
  fExitTimeOut := 5000;
  fIsRunning := False;
  fHidden := True;
  fMerge := False;
  fDestroying := False;
  FillChar(fSA, SizeOf(fSA), 0);
  fSA.nLength := SizeOf(fSA);
  fSA.lpSecurityDescriptor := nil;
  fSA.bInheritHandle := True;
  CreatePipe(fStdInRead, fStdInWrite, @fSA, BufSize);
  CreatePipe(fStdOutRead, fStdOutWrite, @fSA, BufSize);
  CreatePipe(fStdErrRead, fStdErrWrite, @fSA, BufSize);
end;

destructor TRedirectedConsole.Destroy;
begin
  fDestroying := True;
  fOnEnd := nil;
  fOnRun := nil;
  fOnStdOut := nil;
  fOnStdErr := nil;
  Stop;
  CloseHandle(fStdInWrite);
  CloseHandle(fStdOutRead);
  CloseHandle(fStdErrRead);
  inherited;
end;

function TRedirectedConsole.ReadHandle(h: THandle; var s: String): integer;
var
  BytesWaiting: Cardinal;
  Buf: Array[1..BufSize] of char;
{$IFDEF VER100}
  BytesRead: Integer;
{$ELSE}
  BytesRead: Cardinal;
{$ENDIF}
begin
  Result := 0;
  PeekNamedPipe(h, nil, 0, nil, @BytesWaiting, nil);
  if BytesWaiting > 0 then
  begin
    if BytesWaiting > BufSize then
      BytesWaiting := BufSize;
    ReadFile(h, Buf[1], BytesWaiting, BytesRead, nil);
    s := Copy(Buf, 1, BytesRead);
    Result := BytesRead;
  end;
end;

procedure TRedirectedConsole.SendData(s: String);
var
{$IFDEF VER100}
  BytesWritten: Integer;
{$ELSE}
  BytesWritten: Cardinal;
{$ENDIF}
begin
  if fIsRunning then
  begin
    WriteFile(fStdInWrite, s[1], Length(s), BytesWritten, nil);
  end;
end;

procedure TRedirectedConsole.Stop;
begin
  if fIsRunning then
    EndProcess(fPI.hProcess);
end;

procedure TRedirectedConsole.EndProcess(hProc: THandle);
var
  hLib: THandle;
  hRT: THandle;
  pExitProcess: pointer;
  iTI: Integer;
  bTerminated: Boolean;
begin
  bTerminated := False;
  hLib := LoadLibrary('KERNEL32');
  if hLib <> 0 then
  begin
    pExitProcess := GetProcAddress(hLib, 'ExitProcess');
    if pExitProcess <> nil then
    begin
      hRT := CreateRemoteThread(hProc, nil, 0, pExitProcess, nil, 0, iTI);
      if hRT <> 0 then
      begin
        bTerminated := (WaitForSingleObject(hRT, fExitTimeOut) = WAIT_OBJECT_0);
        CloseHandle(hRT);
      end;
    end;
    FreeLibrary(hLib);
  end;
  if not bTerminated then
  begin
    TerminateProcess(hProc, 0);
    WaitForSingleObject(hProc, fExitTimeOut);
  end;
  fIsRunning := False;
end;

procedure TRedirectedConsole.Run;
var
  s: String;
  hProcOld: THandle;
begin
  fStdOut := '';
  fStdErr := '';
  FillChar(fSI, SizeOf(fSI), 0);
  fSI.cb := SizeOf(fSI);
  if fHidden then
    fSI.wShowWindow := SW_HIDE
  else
    fSI.wShowWindow := SW_SHOWDEFAULT;
  fSI.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  fSI.hStdInput := fStdInRead;
  fSI.hStdOutput := fStdOutWrite;
  if fMerge then
    fSI.hStdError := fStdOutWrite
  else
    fSI.hStdError := fStdErrWrite;
  if CreateProcess(nil, PChar(fCmdLine), nil, nil, True, CREATE_NEW_PROCESS_GROUP or NORMAL_PRIORITY_CLASS, nil, nil, fSI, fPI) then
  begin
    hProcOld := fPI.hProcess;
    fIsRunning := True;
    CloseHandle(fStdOutWrite);
    CloseHandle(fStdErrWrite);
    CloseHandle(fStdInRead);
    CloseHandle(fPI.hThread);
    While ((WaitForSingleObject(fPI.hProcess, 10) = WAIT_TIMEOUT) and fIsRunning) do
    begin
      if fDestroying then
        exit;
      if ReadHandle(fStdOutRead, s) > 0 then
        if Assigned(fOnStdOut) then
          fOnStdOut(Self, s)
        else
          fStdOut := Concat(fStdOut, s);
      if ReadHandle(fStdErrRead, s) > 0 then
        if Assigned(fOnStdErr) then
          fOnStdErr(Self, s)
        else
          fStdErr := Concat(fStdErr, s);
      if Assigned(fOnRun) then
        fOnRun(Self);
    end;
    if fDestroying then
      exit;
    if ReadHandle(fStdOutRead, s) > 0 then
      if Assigned(fOnStdOut) then
        fOnStdOut(Self, s)
      else
        fStdOut := Concat(fStdOut, s);
    if ReadHandle(fStdErrRead, s) > 0 then
      if Assigned(fOnStdErr) then
        fOnStdErr(Self, s)
      else
        fStdErr := Concat(fStdErr, s);
    if (fPI.hProcess = hProcOld) then
      CloseHandle(fPI.hProcess);
    fIsRunning := False;
    if Assigned(fOnEnd) then
      fOnEnd(Self);
  end;
end;

end.

JayEff · Beiträge: 2971 Windows Vista Ultimate D7 Enterprise

in zeile 195 wird CreateRemoteThread(hProc, nil, 0, pExitProcess, nil, 0, iTI); aufgerufen. Schätze, hier liegt der Fehler? Laut Meldung stimmt die Parameterübergabe nicht. Dann schau doch mal, wie die Parameterübergabe eigentlich sein müsste, ich vermute, Suche im MSDN

CREATEREMOTETHREAD könnte dir weiterhelfen, aber zuerst versuche mal einen STRG-Klick auf die Funktion CreateRemoteThread in der IDE. Normalerweise wirst du dann auf die Unit verwiesen, in der die Funktion deklariert ist. Da aber CreateRemoteThread vermutlich eine API funktion ist, wird dir da die msdn mehr helfen können.

_________________
>+++[>+++[>++++++++<-]<-]<++++[>++++[>>>+++++++<<<-]<-]<<++
[>++[>++[>>++++<<-]<-]<-]>>>>>++++++++++++++++++.+++++++.>++.-.<<.>>--.<+++++..<+.

Xhead · Hält's aus hier Beiträge: 8

So da bin ich wieder. Habs mittlerweile geschafft die Infos von Xvid abzufangen. Man kann die Infos über den STDOUT Stream auslesen, aber nur wenn man den Parameter "-progress" bei xvid weglässt. Nur bekommt man dann für jeden Frame eine Ausgabe was eigentlich unnötig viel ist, naja egal...

Jetzt habe ich nur noch ein kleines Problem

Und zwar wartet DosCommand ja nicht bis die Anwendung fertig ist deshalb habe ich mir ne Schleife gebastelt (Zeile 19-25).
Aber die Scheife ist etwas kontraproduktiv, weil dadurch der Encodevorgang nach jedem Frame immer ganz kurz pausiert wird, was zur folge hat, dass man deutlich länger fürs encoding braucht.
Wenn ich sleep() entferne dann verbraucht mein Programm über 10% CPU Leistung.

Kann mir jemand einen Tipp geben, wie ich das besser konstruieren kann?
Und vielen Dank für die Hilfe davor.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:

procedure tform1.xvid_encode(secondpass:boolean);
begin
  cmd:= TDoscommand.Create(self);
  cmd.onNewLine    := cmdNewLine;
  progressbar.position:= 0;
  cmd_i:= 0; // =Frameposition (von der OnNewLine Prozedur, wird immer um 1 hochgezählt)
  
  if secondpass = False then
    begin
      cmd.CommandLine:= 'cmd /c tools\xvid_encraw\xvid_encraw.exe -i "'+AVS_name+'" -pass1 xvid.stats -size '+floattostr(XVID_size)+' -Threads 3 ';
      cmd.Priority:= IDLE_PRIORITY_CLASS;
    end
      else
    begin
      cmd.CommandLine:= 'tools\xvid_encraw\xvid_encraw.exe -i "'+AVS_name+'" -o "'+ExtractFilePath(AVS_name)+'OUTPUT.avi" -pass2 xvid.stats -size '+floattostr(XVID_size)+' -Threads 3';
      cmd.Priority:= IDLE_PRIORITY_CLASS;
    end;
  cmd.Execute;
  while cmd.active = true do
    begin
      application.ProcessMessages;
      sleep(150);
      progressbar.position:= cmd_i;
      application.ProcessMessages;
    end;
end;

BenBE · Verfasst: Sa 06.10.07 21:03

Setz doch einfach in OnNewLine ne Semaphore oder n Flag, was festlegt, ob er den Sleep ausführt (kein neuer Frame) oder nicht (neuer Frame (oder mehrere???) eingetroffen. Den Sleep auf 50 reduzieren und es sollte gehen.

Ob man mit WaitForSingleObject auf die Verfügbarkeit von Daten warten kann, weiß ich grad nicht; IIRC aber nicht direkt.

_________________

Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.

Narses · Verfasst: Sa 06.10.07 23:05

Moin!

Das ursprüngliche Problem ist ja nun gelöst. Bitte erstelle für die nächste Frage ein separates Topic, da die Diskussion mehrerer Fragen in einem Topic für gewöhnlich für Verwirrung und Durcheinander sorgt. Daher:

*geschlossen*

cu
Narses

_________________
There are 10 types of people - those who understand binary and those who don´t.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme