function ExecAndGetConsoleOutput (
const CommandLine,Parameter :
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+'
'+Parameter),
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
sl:TStringList;
begin
sl:=TStringList.create;
ExecAndGetConsoleOutput('
c:\winnt\system32\cmd.exe','
/C dir c:',sl);
Memo1.Lines:=sl;
sl.Free;
end;