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. |
[VB6] [Système] Récupérer le contenu d'une fenêtre DOS
Répondre avec citation
Envoyé par Rico
) sauf que l'exécution est lancée avec CreateProcess, et qu'il spécifie la redirection à CreateProcess, après avoir crée lui-même le fichier, au lieu de la mettre dans la ligne de commande.
Partager