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;                    

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.                    

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.                    

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;