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
| nit Unit1;
//Lancer une application Dos et rediriger sa sortie standard vers l'application appelante
//Marchioni Valérian - loub1@caramail.com - ICQ#: 30687888
//20/03/2002
//Sources : Bryan Ashby sur borland.public.delphi.winapi
//ATTENTION: Ne gère pas les paramètres passés dans la ligne de commande
//(pour ca, il faut écrire quelques routines qui traitent la ligne de commande pour en séparer le chemin et les paramètres)
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Memo1: TMemo;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function ExecAndGetConsoleOutput (const CommandLine : string;
var Output : TStringList) : boolean;
var
Sa : TSecurityAttributes;
StartInfo : TStartupInfo;
ProcInfo : TProcessInformation;
StdOutFile,
AppProc,
AppThread : LongWord;
RootDir,
WorkDir,
StdOutFn : string;
begin
Result := FileExists(ExtractFilePath (CommandLine) +
ExtractFileName (CommandLine));
if Result then
begin
StdOutFile := INVALID_HANDLE_VALUE;
AppProc := INVALID_HANDLE_VALUE;
AppThread := INVALID_HANDLE_VALUE;
try
RootDir := ExtractFilePath (ParamStr(0));
WorkDir := ExtractFilePath (CommandLine);
if not (FileSearch (ExtractFileName (CommandLine), WorkDir) <> '')
then
WorkDir := RootDir;
FillChar (Sa, SizeOf(Sa), #0);
Sa.nLength := SizeOf (Sa);
Sa.lpSecurityDescriptor := nil;
Sa.bInheritHandle := TRUE;
StdOutFn := RootDir + '_tmpoutp.tmp';
StdOutFile := CreateFile (PChar(StdOutFn), GENERIC_READ or
GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, @Sa, CREATE_ALWAYS,
FILE_ATTRIBUTE_TEMPORARY or FILE_FLAG_WRITE_THROUGH, 0);
if StdOutFile <> INVALID_HANDLE_VALUE then
begin
FillChar (StartInfo, SizeOf(StartInfo), #0);
with StartInfo do
begin
cb := SizeOf (StartInfo);
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
wShowWindow := SW_HIDE;
hStdInput := GetStdHandle (STD_INPUT_HANDLE);
hStdError := StdOutFile;
hStdOutput := stdOutFile;
end;
if CreateProcess (nil, PChar(CommandLine), nil, nil, TRUE, 0, nil,
PChar(WorkDir), StartInfo, ProcInfo) then
begin
WaitForSingleObject (ProcInfo.hProcess, INFINITE);
AppProc := ProcInfo.hProcess;
AppThread := ProcInfo.hThread;
CloseHandle (StdOutFile);
StdOutFile := INVALID_HANDLE_VALUE;
Output.Clear;
Output.LoadFromFile (StdOutFn);
end;
end;
finally
if StdOutFile <> INVALID_HANDLE_VALUE then
CloseHandle (StdOutFile);
if AppProc <> INVALID_HANDLE_VALUE then
CloseHandle (AppProc);
if AppThread <> INVALID_HANDLE_VALUE then
CloseHandle (AppThread);
if FileExists (StdOutFn) then
SysUtils.DeleteFile (StdOutFn);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var sortie:TStringList;
begin
sortie:=TStringList.Create;
Sortie.clear;
Memo1.Lines.Clear;
if ExecAndGetConsoleOutput(edit1.Text,Sortie)
then memo1.Lines.Assign(sortie)
else memo1.Lines.add('Erreur');
sortie.free;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
close
end;
end. |
Partager