I use to get to dos output using delphi.
What causes the code from http://delphi.about.com/cs/adptips2001/a/bltip0201_2.htm won't work with delphi2009 on vista? but it works on D7 in XP. i dont know what part to be modified to make it work.
DelphiDabbler has a solution, although I have not personally tested it:
function GetDosOutput(CommandLine: string; Work: string = 'C:\'): string;
var
SA: TSecurityAttributes;
SI: TStartupInfo;
PI: TProcessInformation;
StdOutPipeRead, StdOutPipeWrite: THandle;
WasOK: Boolean;
Buffer: array[0..255] of AnsiChar;
BytesRead: Cardinal;
WorkDir: string;
Handle: Boolean;
begin
Result := '';
with SA do begin
nLength := SizeOf(SA);
bInheritHandle := True;
lpSecurityDescriptor := nil;
end;
CreatePipe(StdOutPipeRead, StdOutPipeWrite, #SA, 0);
try
with SI do
begin
FillChar(SI, SizeOf(SI), 0);
cb := SizeOf(SI);
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
wShowWindow := SW_HIDE;
hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
hStdOutput := StdOutPipeWrite;
hStdError := StdOutPipeWrite;
end;
WorkDir := Work;
Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
nil, nil, True, 0, nil,
PChar(WorkDir), SI, PI);
CloseHandle(StdOutPipeWrite);
if Handle then
try
repeat
WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
if BytesRead > 0 then
begin
Buffer[BytesRead] := #0;
Result := Result + Buffer;
end;
until not WasOK or (BytesRead = 0);
WaitForSingleObject(PI.hProcess, INFINITE);
finally
CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);
end;
finally
CloseHandle(StdOutPipeRead);
end;
end;
There is also a solution on Torry:
http://www.swissdelphicenter.ch/torry/showcode.php?id=683
Related
I am a Delphi developer in our company. We need a function which launches a command-line executable and get its return value.
The code I wrote, and all the examples I found on the Internet, do this via CreateProcess(), but my boss rejected this and told me that there MUST be a solution doing this via ShellExecute(). I can't find any example on the Internet doing this with ShellExecute(). All of them use CreateProcess().
Below are 3 methods I delivered to my boss. He did not like ShellExecute_AndGetReturnValue(). It's named "ShellExecute", but it does not use ShellExecute().
All of these 3 methods are working fine. But the first one is not using ShellExecute(). Instead it is using CreateProcess().
So, is it possible to solve/change the ShellExecute_AndGetReturnValue() method so that it will use ShellExecute() instead of CreateProcess()? All examples I found, all of them, use CreateProcess().
function ShellExecute_AndGetReturnValue(FileName : string; Params : string = ''; Show : Integer = SW_HIDE; WorkingDir : string = '') : string;
const
READ_BUFFER_SIZE = 2048;
var
Security: TSecurityAttributes;
readableEndOfPipe, writeableEndOfPipe, readableErrorEndOfPipe, writeableErrorEndOfPipe: THandle;
start: TStartUpInfo;
ProcessInfo: TProcessInformation;
Buffer: PAnsiChar;
BytesRead: DWORD;
AppRunning: DWORD;
ResultStdOutput : string;
ResultErrOutput : string;
lpDirectory : PAnsiChar;
CmdLine : string;
begin
Result := '';
Security.nLength := SizeOf(TSecurityAttributes);
Security.bInheritHandle := True;
Security.lpSecurityDescriptor := nil;
if CreatePipe(readableEndOfPipe, writeableEndOfPipe, #Security, 0) then
begin
Buffer := AllocMem(READ_BUFFER_SIZE + 1);
FillChar(Start, Sizeof(Start), #0);
FillChar(ProcessInfo, SizeOf(ProcessInfo), #0);
start.cb := SizeOf(start);
start.dwFlags := start.dwFlags or STARTF_USESTDHANDLES;
start.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
start.hStdOutput := writeableEndOfPipe;
CreatePipe(readableErrorEndOfPipe, writeableErrorEndOfPipe, #Security, 0);
start.hStdError := writeableErrorEndOfPipe;
start.hStdError := writeableEndOfPipe;
start.dwFlags := start.dwFlags + STARTF_USESHOWWINDOW;
start.wShowWindow := Show;
UniqueString(FileName);
CmdLine := '"' + FileName + '" ' + Params;
if WorkingDir <> '' then
begin
lpDirectory := PAnsiChar(WorkingDir);
end else
begin
lpDirectory := PAnsiChar(ExtractFilePath(FileName));
end;
if CreateProcess(nil, PChar(CmdLine), nil, nil, True, NORMAL_PRIORITY_CLASS, nil, lpDirectory, start, ProcessInfo) then
begin
repeat
Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);
Application.ProcessMessages;
until (Apprunning <> WAIT_TIMEOUT);
ResultStdOutput := '';
ResultErrOutput := '';
//Must Close write Handles before reading (if the console application does not output anything)
CloseHandle(writeableEndOfPipe);
CloseHandle(writeableErrorEndOfPipe);
repeat
BytesRead := 0;
ReadFile(readableEndOfPipe, Buffer[0], READ_BUFFER_SIZE, BytesRead, nil);
Buffer[BytesRead]:= #0;
OemToAnsi(Buffer,Buffer);
ResultStdOutput := ResultStdOutput + String(Buffer);
until (BytesRead < READ_BUFFER_SIZE);
if start.hStdOutput <> start.hStdError then
begin
BytesRead := 0;
ReadFile(readableErrorEndOfPipe, Buffer[0], READ_BUFFER_SIZE, BytesRead, nil);
Buffer[BytesRead]:= #0;
OemToAnsi(Buffer,Buffer);
ResultErrOutput := ResultErrOutput + String(Buffer);
end;
end;
Result := ResultStdOutput;
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(readableEndOfPipe);
CloseHandle(readableErrorEndOfPipe);
end;
end;
procedure ShellExecute_NoWait(FileName : string; Params : string = ''; Action : string = 'open'; Show : Integer = SW_SHOWNORMAL; WorkingDir : string = '');
var
exInfo: TShellExecuteInfo;
Ph: DWORD;
begin
FillChar(exInfo, SizeOf(exInfo), 0);
with exInfo do
begin
cbSize := SizeOf(exInfo);
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
Wnd := GetActiveWindow();
lpVerb := PAnsiChar(Action);
lpParameters := PChar(Params);
lpFile := PChar(FileName);
nShow := Show;
if WorkingDir <> '' then
begin
lpDirectory := PAnsiChar(WorkingDir);
end else
begin
lpDirectory := PAnsiChar(ExtractFilePath(FileName));
end;
end;
if ShellExecuteEx(#exInfo) then
begin
Ph := exInfo.HProcess;
CloseHandle(Ph);
end;
end;
procedure ShellExecute_AndWait(FileName : string; Params : string = ''; Action : string = 'open'; Show : Integer = SW_SHOWNORMAL; WorkingDir : string = '');
var
exInfo: TShellExecuteInfo;
Ph: DWORD;
begin
FillChar(exInfo, SizeOf(exInfo), 0);
with exInfo do
begin
cbSize := SizeOf(exInfo);
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
Wnd := GetActiveWindow();
lpVerb := PAnsiChar(Action);
lpParameters := PChar(Params);
lpFile := PChar(FileName);
nShow := Show;
if WorkingDir <> '' then
begin
lpDirectory := PAnsiChar(WorkingDir);
end else
begin
lpDirectory := PAnsiChar(ExtractFilePath(FileName));
end;
end;
if ShellExecuteEx(#exInfo) then
begin
Ph := exInfo.HProcess;
while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do
begin
Application.ProcessMessages;
end;
CloseHandle(Ph);
end;
end;
Task from your boss is not fully correct. Problem is that the generic solution of ShellExecute – is not start cmd.exe, this command starts an application that is linked to this type of file and starts it. So, to make it work like you want – it needs a lot of work.
One more thing – do you need to get the result of work of your program or console output of your program?
Here is modified part of sources from jcl library to return return code:
function PCharOrNil(const S: string): PChar;
begin
Result := Pointer(S);
end;
// memory initialization
procedure ResetMemory(out P; Size: Longint);
begin
if Size > 0 then
begin
Byte(P) := 0;
FillChar(P, Size, 0);
end;
end;
function ShellExecAndWait(const FileName: string; const Parameters: string;
const Verb: string; CmdShow: Integer; const Directory: string): cardinal;
var
Sei: TShellExecuteInfo;
Res: LongBool;
Msg: tagMSG;
ShellResult : boolean;
begin
ResetMemory(Sei, SizeOf(Sei));
Sei.cbSize := SizeOf(Sei);
Sei.fMask := SEE_MASK_DOENVSUBST or SEE_MASK_FLAG_NO_UI or SEE_MASK_NOCLOSEPROCESS or
SEE_MASK_FLAG_DDEWAIT or SEE_MASK_NOASYNC;
Sei.lpFile := PChar(FileName);
Sei.lpParameters := PCharOrNil(Parameters);
Sei.lpVerb := PCharOrNil(Verb);
Sei.nShow := CmdShow;
Sei.lpDirectory := PCharOrNil(Directory);
{$TYPEDADDRESS ON}
ShellResult := ShellExecuteEx(#Sei);
{$IFNDEF TYPEDADDRESS_ON}
{$TYPEDADDRESS OFF}
{$ENDIF ~TYPEDADDRESS_ON}
if ShellResult then begin
WaitForInputIdle(Sei.hProcess, INFINITE);
while WaitForSingleObject(Sei.hProcess, 10) = WAIT_TIMEOUT do
repeat
Msg.hwnd := 0;
Res := PeekMessage(Msg, Sei.Wnd, 0, 0, PM_REMOVE);
if Res then
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
until not Res;
if not GetExitCodeProcess(Sei.hProcess, Result) then
raise Exception.Create('GetExitCodeProcess fail');
CloseHandle(Sei.hProcess);
end else begin
raise Exception.Create('ShellExecuteEx fail');
end;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
xResult : cardinal;
begin
xResult := ShellExecAndWait('ping.exe', '', '', 1, ''); //xResult = 1
xResult := ShellExecAndWait('ping.exe', '8.8.8.8', '', 1, ''); //xResult = 0
end;
If you need to specify input/output pipes (to control stdin and stdout of the called process) then ShellExecute cannot be used. It simply does not support specifying these. Neither does ShellExecuteEx.
So the only option you have if you must use ShellExecute is to ShellExecute the command processor (CMD.EXE) and ask it to perform the redirection of input and output. This will limit your redirection source and target to physical files on the disk, as that's the way CMD.EXE allows redirection (>StdOut <StdIn).
Othwewise, your approach with CreateProcess is the way forward. What does your boss give as reason that you must use ShellExecute?
If you don't need redirection support, you can use ShellExecuteEx and then after a successful execution, you can obtain the Handle to the running process in Info.hProcess (Info is the TShellExecuteInfo structure passed to ShellExecuteEx).
This value can then be used in GetExitCodeProcess to determine if the process is still running, or if it has terminated (and you have thus retrieved the "Return Value", if I have correctly understood your use of this expression - it's actually called an "ExitCode", or - in batch files - an "ERRORLEVEL").
Incomplete code:
FUNCTION ShellExecuteAndWait(....) : DWORD;
.
.
VAR Info : TShellExecuteInfo;
.
.
Info.fMask:=Info.fMask OR SEE_MASK_NOCLOSEPROCESS;
IF NOT ShellExecuteEx(Info) THEN EXIT($FFFF8000);
IF Info.hProcess=0 THEN EXIT($FFFF0000);
REPEAT
IF NOT GetExitCodeProcess(Info.hProcess,Result) THEN EXIT($FFFFFFFF)
UNTIL Result<>STILL_ACTIVE
.
.
The above code should demonstrate how to do this...
I'm using the following procedure to put the result of DOS commands in a TMemo:
procedure RunDosInMemo(DosApp: String; AMemo: TMemo);
const
ReadBuffer = 2400;
var
Security : TSecurityAttributes;
ReadPipe, WritePipe : THandle;
start : TStartUpInfo;
ProcessInfo : TProcessInformation;
Buffer : Pchar;
BytesRead : DWord;
Apprunning : DWord;
begin
With Security do begin
nlength := SizeOf(TSecurityAttributes) ;
binherithandle := true;
lpsecuritydescriptor := nil;
end;
if Createpipe (ReadPipe, WritePipe,#Security, 0) then begin
Buffer := AllocMem(ReadBuffer + 1);
FillChar(Start, Sizeof(Start), #0);
start.cb := SizeOf(start) ;
start.hStdOutput := WritePipe;
start.hStdInput := ReadPipe;
start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;
if CreateProcess(nil,
PChar(DosApp),
#Security,
#Security,
true,
NORMAL_PRIORITY_CLASS,
nil,
nil,
start,
ProcessInfo)
then
begin
repeat
Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 200);
Application.ProcessMessages;
until (Apprunning <> WAIT_TIMEOUT);
repeat
BytesRead := 0;
ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil);
Buffer[BytesRead] := #0;
OemToAnsi(Buffer, Buffer);
AMemo.Text := AMemo.text + String(Buffer);
until (BytesRead < ReadBuffer);
end;
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ReadPipe);
CloseHandle(WritePipe);
end;
end;
Then I use it with a copy of netsh.exe to get a list of wireless signals and MAC addresses like this:
RunDosInMemo('C:\Edge LR\netsh.exe wlan show networks mode=Bssid', Memo3);
But it shows only the first 9 wireless signals from the list. When I run it on the console directly, it shows the full list with all wireless signals and specs.
Does anyone have an idea how to solve this?
If you read the following MSDN documentation, you will see that you are missing some very important steps:
Creating a Child Process with Redirected Input and Output
Most notably, you are using the parent process's read end of the pipe for the child process's STDIN, which is wrong. And you are letting the child process inherit that read end of the pipe, which is also wrong.
You also need to close the write end of the pipe after the child process has inherited it, before you then start reading from the pipe. Otherwise, the child process will not fully exit and signal the handle returned by CreateProcess(). By closing the write end, you ensure the process can fully terminate, and that ReadFile() will fail with an ERROR_BROKEN_PIPE error when the child process closes its end of the pipe and there is no more data to be read.
Try something more like this:
procedure RunDosInMemo(DosApp: String; AMemo: TMemo);
const
ReadBuffer = 2400;
var
Security : TSecurityAttributes;
ReadPipe, WritePipe : THandle;
start : TStartUpInfo;
ProcessInfo : TProcessInformation;
Buffer : array of AnsiChar;
Str: AnsiString;
BytesRead : DWord;
AppRunning : DWord;
begin
with Security do begin
nLength := SizeOf(TSecurityAttributes);
bInherithandle := true;
lpSecurityDescriptor := nil;
end;
if not CreatePipe(ReadPipe, WritePipe, #Security, 0) then RaiseLastOSError;
try
if not SetHandleInformation(ReadPipe, HANDLE_FLAG_INHERIT, 0) then RaiseLastOSError;
SetLength(Buffer, ReadBuffer);
FillChar(Start, Sizeof(Start), 0);
start.cb := SizeOf(start);
start.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
start.hStdOutput := WritePipe;
start.hStdError := WritePipe;
start.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;
if not CreateProcess(nil,
PChar(DosApp),
#Security,
#Security,
true,
NORMAL_PRIORITY_CLASS,
nil,
nil,
start,
ProcessInfo) then RaiseLastOSError;
try
CloseHandle(WritePipe);
WritePipe := 0;
repeat
AppRunning := MsgWaitForMultipleObjects(1, ProcessInfo.hProcess, False, 200, QS_ALLINPUT);
if AppRunning = (WAIT_OBJECT_0 + 1) then Application.ProcessMessages;
until (AppRunning <> WAIT_TIMEOUT);
repeat
BytesRead := 0;
if not ReadFile(ReadPipe, Buffer[0], ReadBuffer, BytesRead, nil) then
begin
if GetLastError() <> ERROR_BROKEN_PIPE then RaiseLastOSError;
Break;
end;
if BytesRead = 0 then Break;
SetString(Str, #Buffer[0], BytesRead);
AMemo.SelStart := AMemo.GetTextLen;
AMemo.SelLength := 0;
AMemo.SelText := String(Str);
until False;
finally
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
end;
finally
CloseHandle(ReadPipe);
if WritePipe <> 0 then CloseHandle(WritePipe);
end;
end;
You could do:
uses
JCLSysUtils;
procedure TForm1.HandleOutput( const Text: string );
begin
AMemo.Lines.Add( Text );
end;
procedure TForm1.Button1Click( Sender: TObject );
begin
AMemo.Clear;
JCLSysUtils.Execute( 'C:\Edge LR\netsh.exe wlan show networks mode=Bssid',
HandleOutput );
end;
I get from other statckoverflow post the function listed below.
I have a encoding problem with accented chars to show the result in a TMemo.
for sample if I use:
Memo1.Text := GetDosOutput('Help DIR');
My Memo1.Text shows:
"Exibe uma lista de arquivos e subdiret¢rios em um diret¢rio.
DIR [unidade:][caminho][arquivo] [/A[[:]atributos]] [/B] [/C] [/D] [/L] [/N]
[/O[[:]ordem_de_classifica‡Æo]] [/P] [/Q] [/R] [/S] [/T[[:]campo_de_tempo]]
[/W] [/X] [/4]
.......
"
Please, How do I convert the result string of the function to shows correctly in TMemo?
I tried
Memo1.Text := UnicodeString(GetDosOutput('Help DIR'));
but, no look.
function GetDosOutput(CommandLine: string; Work: string = 'C:\'): string;
var
SA: TSecurityAttributes;
SI: TStartupInfo;
PI: TProcessInformation;
StdOutPipeRead, StdOutPipeWrite: THandle;
WasOK: Boolean;
Buffer: array[0..255] of AnsiChar;
BytesRead: Cardinal;
WorkDir: string;
Handle: Boolean;
begin
Result := '';
with SA do begin
nLength := SizeOf(SA);
bInheritHandle := True;
lpSecurityDescriptor := nil;
end;
CreatePipe(StdOutPipeRead, StdOutPipeWrite, #SA, 0);
try
with SI do
begin
FillChar(SI, SizeOf(SI), 0);
cb := SizeOf(SI);
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
wShowWindow := SW_HIDE;
hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
hStdOutput := StdOutPipeWrite;
hStdError := StdOutPipeWrite;
end;
WorkDir := Work;
Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
nil, nil, True, 0, nil,
PChar(WorkDir), SI, PI);
CloseHandle(StdOutPipeWrite);
if Handle then
try
repeat
WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
if BytesRead > 0 then
begin
Buffer[BytesRead] := #0;
Result :=Result + Buffer;
end;
until not WasOK or (BytesRead = 0);
WaitForSingleObject(PI.hProcess, INFINITE);
finally
CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);
end;
finally
CloseHandle(StdOutPipeRead);
end;
end;
From J.. suggestion, I created the StrOemToAnsi function showing below using
OemToCharBuffA.
To test I did:
procedure Tfm_nh_maindicom.Button1Click(Sender: TObject);
var s:string;
function StrOemToAnsi(const aStr : AnsiString) : AnsiString;
var
Len : Integer;
begin
if aStr = '' then Exit;
Len := Length(aStr);
SetLength(Result, Len);
OemToCharBuffA(PAnsiChar(aStr), PAnsiChar(Result), Len);
end;
begin
S:=GetDosOutput('Help DIR');
Memo1.Text:=StrOemToAnsi(s);
end;
And the result in Memo1 was:
"Exibe uma lista de arquivos e subdiretórios em um diretório.
DIR [unidade:][caminho][arquivo] [/A[[:]atributos]] [/B] [/C] [/D] [/L] [/N]
[/O[[:]ordem_de_classificação]] [/P] [/Q] [/R] [/S] [/T[[:]campo_de_tempo]]
[/W] [/X] [/4]
....
"
The code below works for Delphi XE, but the 2400 buffersize is pretty ugly.
Anyone have some suggestions on cleaning this routine up ?? And making the 2400 limit disappear (without defining a 64000 buffer).
Thanks
procedure TForm1.Button1Click(Sender: TObject);
begin
CaptureConsoleOutput('c:\windows\system32\ipconfig','',Memo1);
end;
procedure TForm1.CaptureConsoleOutput(const ACommand, AParameters: String; AMemo: TMemo);
const
CReadBuffer = 2400;
var
saSecurity: TSecurityAttributes;
hRead: THandle;
hWrite: THandle;
suiStartup: TStartupInfo;
piProcess: TProcessInformation;
pBuffer: array[0..CReadBuffer] of AnsiChar;
dRead: DWord;
dRunning: DWord;
begin
saSecurity.nLength := SizeOf(TSecurityAttributes);
saSecurity.bInheritHandle := True;
saSecurity.lpSecurityDescriptor := nil;
if CreatePipe(hRead, hWrite, #saSecurity, 0) then
begin
FillChar(suiStartup, SizeOf(TStartupInfo), #0);
suiStartup.cb := SizeOf(TStartupInfo);
suiStartup.hStdInput := hRead;
suiStartup.hStdOutput := hWrite;
suiStartup.hStdError := hWrite;
suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
suiStartup.wShowWindow := SW_HIDE;
if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), #saSecurity,
#saSecurity, True, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup, piProcess)
then
begin
repeat
dRunning := WaitForSingleObject(piProcess.hProcess, 100);
Application.ProcessMessages();
repeat
dRead := 0;
ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
pBuffer[dRead] := #0;
OemToAnsi(pBuffer, pBuffer);
AMemo.Lines.Add(String(pBuffer));
until (dRead < CReadBuffer);
until (dRunning <> WAIT_TIMEOUT);
CloseHandle(piProcess.hProcess);
CloseHandle(piProcess.hThread);
end;
CloseHandle(hRead);
CloseHandle(hWrite);
end;
end;
I've got some code that does this. I've hacked out various irrelevant bits, so this may not compile as is. But you should get the idea:
procedure ReadStdout(hstdout: THandle; out stdout: string);
var
Buffer: AnsiString;
FileSize: DWORD;
NumberOfBytesRead: DWORD;
begin
FileSize := SetFilePointer(hstdout, 0, nil, FILE_END);
if FileSize>0 then begin
SetLength(Buffer, FileSize);
SetFilePointer(hstdout, 0, nil, FILE_BEGIN);
ReadFile(hstdout, Buffer[1], FileSize, NumberOfBytesRead, nil);
//should really check that NumberOfBytesRead=FileSize
stdout := Buffer;
end else begin
stdout := '';
end;
end;
function CreateFileHandle(const FileName: string): THandle;
var
SecurityAttributes: TSecurityAttributes;
begin
ZeroMemory(#SecurityAttributes, SizeOf(SecurityAttributes));
SecurityAttributes.nLength := SizeOf(SecurityAttributes);
SecurityAttributes.lpSecurityDescriptor := nil;
SecurityAttributes.bInheritHandle := True;
Result := CreateFile(
PChar(FileName),
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
#SecurityAttributes,
CREATE_ALWAYS,
FILE_ATTRIBUTE_NORMAL or FILE_FLAG_WRITE_THROUGH,
0
);
end;
procedure Execute(const ExecutableFileName, DataFileName, TempFolder: string);
var
hstdin, hstdout: THandle;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
ExitCode: DWORD;
stdout: string;
begin
hstdin := CreateFileHandle(TempFolder+'stdin');
hstdout := CreateFileHandle(TempFolder+'stdout');
Try
ZeroMemory(#StartupInfo, SizeOf(StartupInfo));
StartupInfo.cb := SizeOf(StartupInfo);
StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
StartupInfo.wShowWindow := SW_HIDE;
StartupInfo.hStdInput := hstdin;
StartupInfo.hStdError := hstdout;
if CreateProcess(
PChar(ExecutableFileName),
'',
nil,
nil,
True,
CREATE_NO_WINDOW or NORMAL_PRIORITY_CLASS,
nil,
PChar(TempFolder),
StartupInfo,
ProcessInfo
) then begin
Try
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
GetExitCodeProcess(ProcessInfo.hProcess, ExitCode);
ReadStdout(hstdout, stdout);
Finally
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
End;
end else begin
//error;
end;
Finally
CloseHandle(hstdout);
CloseHandle(hstdin);
End;
end;
You'll want to clean up the temp files at some point.
I need to execute a Windows "find" command from a Delphi software. I've tried to use the ShellExecute command, but it doesn't seem to work. In C, I'd use the system procedure, but here... I don't know. I'd like to do something like this:
System('find "320" in.txt > out.txt');
Edit : Thanks for the answer :)
I was trying to run 'Find' as an executable, not as argument for cmd.exe.
An example using ShellExecute():
procedure TForm1.Button1Click(Sender: TObject);
begin
ShellExecute(0, nil, 'cmd.exe', '/C find "320" in.txt > out.txt', nil, SW_HIDE);
Sleep(1000);
Memo1.Lines.LoadFromFile('out.txt');
end;
Note that using CreateProcess() instead of ShellExecute() allows for much better control of the process.
Ideally you would also call this in a secondary thread, and call WaitForSingleObject() on the process handle to wait for the process to complete. The Sleep() in the example is just a hack to wait some time for the program started by ShellExecute() to finish - ShellExecute() will not do that. If it did you couldn't for example simply open a notepad instance for editing a file, ShellExecute() would block your parent app until the editor was closed.
Variant 1 (using the "advanced" CreateProcess):
This will run a 'DOS' program and retrieve its output:
function GetDosOutput(CommandLine: string; Work: string = 'C:\'): string; { Run a DOS program and retrieve its output dynamically while it is running. }
var
SecAtrrs: TSecurityAttributes;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
StdOutPipeRead, StdOutPipeWrite: THandle;
WasOK: Boolean;
pCommandLine: array[0..255] of AnsiChar;
BytesRead: Cardinal;
WorkDir: string;
Handle: Boolean;
begin
Result := '';
with SecAtrrs do begin
nLength := SizeOf(SecAtrrs);
bInheritHandle := True;
lpSecurityDescriptor := nil;
end;
CreatePipe(StdOutPipeRead, StdOutPipeWrite, #SecAtrrs, 0);
try
with StartupInfo do
begin
FillChar(StartupInfo, SizeOf(StartupInfo), 0);
cb := SizeOf(StartupInfo);
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
wShowWindow := SW_HIDE;
hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
hStdOutput := StdOutPipeWrite;
hStdError := StdOutPipeWrite;
end;
WorkDir := Work;
Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
nil, nil, True, 0, nil,
PChar(WorkDir), StartupInfo, ProcessInfo);
CloseHandle(StdOutPipeWrite);
if Handle then
try
repeat
WasOK := windows.ReadFile(StdOutPipeRead, pCommandLine, 255, BytesRead, nil);
if BytesRead > 0 then
begin
pCommandLine[BytesRead] := #0;
Result := Result + pCommandLine;
end;
until not WasOK or (BytesRead = 0);
WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
finally
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);
end;
finally
CloseHandle(StdOutPipeRead);
end;
end;
Variant 2:
Capture console output in [Realtime] and how it in a TMemo:
procedure CaptureConsoleOutput(const ACommand, AParameters: String; AMemo: TMemo);
const
CReadBuffer = 2400;
var
saSecurity: TSecurityAttributes;
hRead: THandle;
hWrite: THandle;
suiStartup: TStartupInfo;
piProcess: TProcessInformation;
pBuffer: array[0..CReadBuffer] of AnsiChar; <----- update
dRead: DWord;
dRunning: DWord;
begin
saSecurity.nLength := SizeOf(TSecurityAttributes);
saSecurity.bInheritHandle := True;
saSecurity.lpSecurityDescriptor := nil;
if CreatePipe(hRead, hWrite, #saSecurity, 0) then
begin
FillChar(suiStartup, SizeOf(TStartupInfo), #0);
suiStartup.cb := SizeOf(TStartupInfo);
suiStartup.hStdInput := hRead;
suiStartup.hStdOutput := hWrite;
suiStartup.hStdError := hWrite;
suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
suiStartup.wShowWindow := SW_HIDE;
if CreateProcess(nil, PChar(ACommand + ' ' + AParameters), #saSecurity,
#saSecurity, True, NORMAL_PRIORITY_CLASS, nil, nil, suiStartup, piProcess)
then
begin
repeat
dRunning := WaitForSingleObject(piProcess.hProcess, 100);
Application.ProcessMessages();
repeat
dRead := 0;
ReadFile(hRead, pBuffer[0], CReadBuffer, dRead, nil);
pBuffer[dRead] := #0;
OemToAnsi(pBuffer, pBuffer);
AMemo.Lines.Add(String(pBuffer));
until (dRead < CReadBuffer);
until (dRunning <> WAIT_TIMEOUT);
CloseHandle(piProcess.hProcess);
CloseHandle(piProcess.hThread);
end;
CloseHandle(hRead);
CloseHandle(hWrite);
end;
end;
Source: delphi.wikia.com