DOS Befehl ausführen, Bildschirmausgabe
Umleiten und in Delphi verwenden
Zunächst mal Quick & Dirty
Möchte man aus Delphi heraus eine
DOS- bzw. Konsolen-Anwendung starten und deren Ausgabe im
eigenen Programm ausgeben, so gibt es hierfür mehr oder weniger
komplizierte Prozeduren. Es gibt aber auch ne simple Qick&Dirty-Lösung.
Man führt den DOS-Befehl aus und leitet die Bildschirmausgabe in
eine Datei um. Nun kann man die erzeugte Datei z.B. in ein TMemo
laden. Allerdings muss man noch etwas beachten. Denn nachdem die
DOS-Anwendung
gestartet wurde, wird das eigene Programm munter fortgefahren und
nicht warten bis die Anwendung abgeschlossen und die Textdatei
erstellt wurde. Also wird das eigene Programm versuchen die
Textdatei zu laden, bevor diese erstellt bzw. deren Erstellung
abgeschlossen wurde. Es wird hier wohl in fast allen Fällen zu einer
Fehlermeldung kommen die in etwa so aussieht: "Die
Datei XYZ kann nicht geöffnet werden. Das System kann die
angegebene Datei nicht finden". Die Frage ist nun, wie kann
man Delphi dazu bewegen solange mit dem Fortfahren des
Programms zu warten, bis die externe Anwendung beendet ist. Und
jetzt kommt der Dirty-Teil: Man versucht einfach
immer und immer wieder die Textdatei zu laden, bis sie sich
letztlich läst. Das ganze könnte wie folgt aussehen:
Hinweis!: Solange man unter Delphi (Interpreter mode)
seine Anwendung testet, kommt es weiterhin zu der Fehlermeldung,
die aber in der fertig kompilierten EXE nicht mehr aufpopt, da
sie durch die Try-Except Routine unterdrückt wird.
Beispiel:
- ShellExecute erfordert
ShellAPI in uses!
|
var
warten: Integer; ShellExecute(Handle,
'open',PChar('CMD'),PansiChar('
/c
C:\Dosanwendung.exe > C:\test.txt'),nil,SW_SHOW);
// --- für NT/2k/XP
//
ShellExecute(Handle,'open', PChar('C:\Dosanwendung.exe'),PChar('
> C:\test.txt'),nil,SW_HIDE); --- für Win95/98
repeat
warten := 0;
try
Memo1.Lines.Loadfromfile('C:\Datei.txt');
except
begin
sleep(250);
// CPU-Entlastung
application.ProcessMessages;
// halte das Fenster aktuell
warten := 1;
end;
end;
until
warten
= 0;
|
Zugegeben, diese Lösung ist nicht
gerade ressourcenfreundlich und nervt die Festplatte bestimmt
ganz schön ab und birgt zudem
eine böse Falle. Kann aus irgendeinem Grund die Datei.txt nicht
erstellt, geschlossen oder geladen werden, so wird das Programm für immer
und ewig in der Repeat-Until-Schleife gefangen sein. Aber
hier lässt sich für solch einen Fall einen Zähler einbauen, der
nach einer gewissen Zeit, mit einer passenden Fehlermeldung aus
der Schleife aussteigt.
Und jetzt was genaueres
Da die oben erwähnte Methode eine
böse Falle bereit hält, hier mal was präziseres. Die Funktion
startet die übergebene Anwendung, wartet auf deren Ende und
liest dann die Ausgabe und den Fehlerkanal in eine TStringlist.
|
function
GetConsoleOutput(const Command: AnsiString; Output,
Errors: TStringList): Boolean;
var
StartupInfo: TStartupInfoA;
ProcessInfo: TProcessInformation;
SecurityAttr: TSecurityAttributes;
PipeOutputRead: THandle;
PipeOutputWrite: THandle;
PipeErrorsRead: THandle;
PipeErrorsWrite: THandle;
Succeed: Boolean;
Buffer: array [0..255]
of AnsiChar;
NumberOfBytesRead: DWORD;
Stream: TMemoryStream;
begin
//Initialisierung
ProcessInfo
FillChar(ProcessInfo, SizeOf(TProcessInformation),
0);
//Initialisierung
SecurityAttr
FillChar(SecurityAttr, SizeOf(TSecurityAttributes),
0);
SecurityAttr.nLength := SizeOf(SecurityAttr);
SecurityAttr.bInheritHandle := true;
SecurityAttr.lpSecurityDescriptor :=
nil;
//Pipes
erzeugen
CreatePipe(PipeOutputRead, PipeOutputWrite, @SecurityAttr,
0);
CreatePipe(PipeErrorsRead, PipeErrorsWrite, @SecurityAttr,
0);
//Initialisierung
StartupInfo
FillChar(StartupInfo, SizeOf(StartupInfo),
0);
StartupInfo.cb:=SizeOf(StartupInfo);
StartupInfo.hStdInput := 0;
StartupInfo.hStdOutput := PipeOutputWrite;
StartupInfo.hStdError := PipeErrorsWrite;
StartupInfo.wShowWindow := sw_Hide;
StartupInfo.dwFlags := STARTF_USESHOWWINDOW
or STARTF_USESTDHANDLES;
if CreateProcessA(nil,
PAnsiChar(command), nil,
nil, true,
CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or
NORMAL_PRIORITY_CLASS, nil,
nil,
StartupInfo, ProcessInfo) then
begin
result := true;
//Write-Pipes
schließen
CloseHandle(PipeOutputWrite);
CloseHandle(PipeErrorsWrite);
//Ausgabe
Read-Pipe auslesen
Stream := TMemoryStream.Create;
try
while true
do begin
succeed := ReadFile(PipeOutputRead, Buffer,
255, NumberOfBytesRead,
nil);
if not succeed
then break;
Stream.Write(Buffer, NumberOfBytesRead);
end;
Stream.Position := 0;
Output.LoadFromStream(Stream);
finally
Stream.Free;
end;
CloseHandle(PipeOutputRead);
//Fehler
Read-Pipe auslesen
Stream := TMemoryStream.Create;
try
while true
do begin
succeed := ReadFile(PipeErrorsRead, Buffer,
255, NumberOfBytesRead,
nil);
if not succeed then break;
Stream.Write(Buffer, NumberOfBytesRead);
end;
Stream.Position := 0;
Errors.LoadFromStream(Stream);
finally
Stream.Free;
end;
CloseHandle(PipeErrorsRead);
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
CloseHandle(ProcessInfo.hProcess);
end
else
begin
result := false;
CloseHandle(PipeOutputRead);
CloseHandle(PipeOutputWrite);
CloseHandle(PipeErrorsRead);
CloseHandle(PipeErrorsWrite);
end;
end; |
Der Aufruf dieser Funktion könnte
dann wie folgt aussehen:
|
var
OutPutList, ErrorList: TStringList;
...
OutPutList := TStringList.Create;
ErrorList := TStringList.Create;
GetConsoleOutput('cmd /c dir c:\',OutPutList,ErrorList);
// liest Inhaltsverzeichnis von Laufwerk
C:\
... mach was mit dem Inhalt der beiden
Stringlists
OutPutList.Free;
ErrorList.Free; |
|