方法一:
//1,声明变量
var
CreateOk: Boolean;
hReadPipe, hWritePipe, hWriteFile, hReadFile: THandle;
processinfo: PROCESS_INFORMATION;
function SendCmdToShell(const CmdStr: String):tstrings;
//2,初始化
procedure TForm0.iniClick(Sender: TObject);
var
Pipeattr: SECURITY_ATTRIBUTES;
ShellStartInfo: STARTUPINFO;
shellstr: array [0..256] of char;
RBuffer: array[0..25000] of char;
I: Integer;
nByteReaden: DWORD;
begin
CreateOK := False; //ok
I := 0;
// memo1.ReadOnly := False;// Wpos.X := 0;
// WPos.Y := 0;
with Pipeattr do
begin
nLength := Sizeof(SECURITY_ATTRIBUTES);
lpSecurityDescriptor := nil;
bInheritHandle := true;
end;
if CreatePipe(hReadPipe, hWriteFile, @Pipeattr, 0) then
Inc(i);
if CreatePipe(hReadFile, hWritePipe, @pipeattr, 0) then
Inc(i);
GetStartupInfo(ShellStartInfo);
with ShellStartInfo do
begin
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
hStdInput := hReadPipe;
hStdError := hWritePipe;
hStdOutput := hWritePipe;
wShowWindow := SW_HIDE;
end; GetSystemDirectory(@Shellstr, MAX_PATH+1);
StrCat(@ShellStr, Pchar( '\\cmd.exe ')); if CreateProcess(Shellstr, nil, nil, nil, True, 0,nil, nil, ShellStartInfo, processinfo) then
begin
Inc(i);
end
else
begin
MessageBox(Handle, Pchar( '调用Shell错误! '), Pchar( '错误 '), (MB_OK or MB_ICONERROR));
end; if i = 3 then
begin
CreateOK := True; //ok
// memo1.Lines.Clear; sleep(250);
ReadFile(hReadFile, RBuffer, 25000, nByteReaden, nil);
// memo1.Lines.Add(StrPas(RBuffer));// WPos.Y := memo1.Lines.Count-1;
//
// WPos.X := Length(memo1.Lines[WPos.Y])-1; end;
end;
//3,执行
function TForm0.SendCmdToShell(const CmdStr: String):tstrings;
var
ShellCmdStr: array[0..256] of char;
RBuffer: array[0..25000] of char;
nByteToWrite: DWORD;
nByteWritten: DWORD;
nByteReaden: DWORD;
begin
// if CreateOK then
begin
StrPCopy(ShellCmdStr, CmdStr);
nByteToWrite := StrLen(ShellCmdStr);
ShellCmdStr[nByteToWrite] := #13;
ShellCmdStr[nByteToWrite+1] := #10;
ShellCmdStr[nByteToWrite+2] := #0;
Inc(nByteToWrite, 2);
WriteFile(hWriteFile, ShellCmdStr, nByteToWrite, nByteWritten, nil);
Sleep(1100);
// memo1.Lines.Clear;
result := tstringlist.Create ;
FillChar(RBuffer, Sizeof(RBuffer), #0);
ReadFile(hReadFile, RBuffer, 25000, nByteReaden, nil);
result.Add(StrPas(RBuffer));
// memo1.Lines.Add(StrPas(RBuffer));
// WPos.Y := memo1.Lines.Count-1;
// WPos.X := Length(memo1.Lines[WPos.Y])-1;
end;
end;
//4,释放
procedure TForm0.btnendClick(Sender: TObject);
var
shellexitcode: Cardinal;
begin
if GetExitCodeProcess(processinfo.hProcess, shellexitcode) then
begin
if shellexitcode = STILL_ACTIVE then
TerminateProcess(processinfo.hProcess, 0);
end;
if hWriteFile <> 0 then
CloseHandle(hWriteFile);
if hReadFile <> 0 then
CloseHandle(hReadFile);
end;
//5,举例
procedure TForm0.ButtondoClick(Sender: TObject);
begin
self.Memo1.Lines.Assign( SendCmdToShell(self.Edit1.Text) ) ;
end;
==================================================================================================
(*
procedure CheckResult(b: Boolean);
begin
if not b then
raise Exception.Create(SysErrorMessage(GetLastError));
end;
function RunDOS(const Prog, CommandLine, Dir: string; var ExitCode: DWORD): string;
var
HRead, HWrite: THandle;
StartInfo: TStartupInfo;
ProceInfo: TProcessInformation;
b: Boolean;
sa: TSecurityAttributes;
inS: THandleStream;
sRet: TStrings;
begin
Result := '';
FillChar(sa, sizeof(sa), 0);
//设置允许继承,否则在NT和2000下无法取得输出结果
sa.nLength := sizeof(sa);
sa.bInheritHandle := True;
sa.lpSecurityDescriptor := nil;
b := CreatePipe(HRead, HWrite, @sa, 0);
CheckResult(b);
FillChar(StartInfo, SizeOf(StartInfo), 0);
StartInfo.cb := SizeOf(StartInfo);
StartInfo.wShowWindow := SW_HIDE;
//使用指定的句柄作为标准输入输出的文件句柄,使用指定的显示方式
StartInfo.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
StartInfo.hStdError := HWrite;
StartInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE); //HRead;
StartInfo.hStdOutput := HWrite;
b := CreateProcess(PChar(Prog), //lpApplicationName: PChar
PChar(CommandLine), //lpCommandLine: PChar
nil, //lpProcessAttributes: PSecurityAttributes
nil, //lpThreadAttributes: PSecurityAttributes
True, //bInheritHandles: BOOL
CREATE_NEW_CONSOLE,
nil,
PChar(Dir),
StartInfo,
ProceInfo);
CheckResult(b);
WaitForSingleObject(ProceInfo.hProcess, INFINITE);
GetExitCodeProcess(ProceInfo.hProcess, ExitCode);
inS := THandleStream.Create(HRead);
if inS.Size > 0 then
begin
sRet := TStringList.Create;
sRet.LoadFromStream(inS);
Result := sRet.Text;
sRet.Free;
end;
inS.Free;
CloseHandle(HRead);
CloseHandle(HWrite);
end;
function GetDosOutput(const CommandLine: string): string;
var
SA: TSecurityAttributes;
SI: TStartupInfo;
PI: TProcessInformation;
StdOutPipeRead, StdOutPipeWrite: THandle;
WasOK: Boolean;
Buffer: array[0..255] of Char;
BytesRead: Cardinal;
WorkDir, Line: string;
begin
Application.ProcessMessages;
with SA do
begin
nLength := SizeOf(SA);
bInheritHandle := True;
lpSecurityDescriptor := nil;
end;
// create pipe for standard output redirection
CreatePipe(StdOutPipeRead, // read handle
StdOutPipeWrite, // write handle
@SA, // security attributes
0 // number of bytes reserved for pipe - 0 default
);
try
// Make child process use StdOutPipeWrite as standard out,
// and make sure it does not show on screen.
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 stdinput
hStdOutput := StdOutPipeWrite;
hStdError := StdOutPipeWrite;
end;
// launch the command line compiler
WorkDir := ExtractFilePath(CommandLine);
WasOK := CreateProcess(nil, PChar(CommandLine), nil, nil, True, 0, nil,
PChar(WorkDir), SI, PI);
// Now that the handle has been inherited, close write to be safe.
// We don't want to read or write to it accidentally.
CloseHandle(StdOutPipeWrite);
// if process could be created then handle its output
if not WasOK then
raise Exception.Create('Could not execute command line!')
else
try
// get all output until dos app finishes
Line := '';
repeat
// read block of characters (might contain carriage returns and line feeds)
WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
// has anything been read?
if BytesRead > 0 then
begin
// finish buffer to PChar
Buffer[BytesRead] := #0;
// combine the buffer with the rest of the last run
Line := Line + Buffer;
end;
until not WasOK or (BytesRead = 0);
// wait for console app to finish (should be already at this point)
WaitForSingleObject(PI.hProcess, INFINITE);
finally
// Close all remaining handles
CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);
end;
finally
result := Line;
CloseHandle(StdOutPipeRead);
end;
end;
*)
//==============================================================================
方法三:
procedure TForm0.Button12Click(Sender: TObject);
var
hReadPipe, hWritePipe: THandle;
si: STARTUPINFO;
lsa: SECURITY_ATTRIBUTES;
pi: PROCESS_INFORMATION;
cchReadBuffer: DWORD;
ph: PChar;
fname: PChar;
begin
fname := allocmem(255);
ph := AllocMem(5000);
lsa.nLength := sizeof(SECURITY_ATTRIBUTES);
lsa.lpSecurityDescriptor := nil;
lsa.bInheritHandle := True;
if CreatePipe(hReadPipe, hWritePipe, @lsa, 0) = false then
begin
ShowMessage('Can not create pipe!');
exit;
end;
fillchar(si, sizeof(STARTUPINFO), 0);
si.cb := sizeof(STARTUPINFO);
si.dwFlags := (STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW);
si.wShowWindow := SW_SHOW;
si.hStdOutput := hWritePipe;
StrPCopy(fname, Edit1.text);
if CreateProcess(nil, fname, nil, nil, true, 0, nil, nil, si, pi) = False then
begin
ShowMessage('can not create process');
FreeMem(ph);
FreeMem(fname);
Exit;
end;
while (true) do
begin
if not PeekNamedPipe(hReadPipe, ph, 1, @cchReadBuffer, nil, nil) then break;
if cchReadBuffer <> 0 then
begin
if ReadFile(hReadPipe, ph^, 4096, cchReadBuffer, nil) = false then break;
ph[cchReadbuffer] := chr(0);
Memo1.Lines.Add(ph);// 在memo中显示输出
end
else if (WaitForSingleObject(pi.hProcess, 0) = WAIT_OBJECT_0) then break;
Sleep(100);
end;
ph[cchReadBuffer] := chr(0);
Memo1.Lines.Add(ph); // 在memo中显示输出
CloseHandle(hReadPipe);
CloseHandle(pi.hThread);
CloseHandle(pi.hProcess);
CloseHandle(hWritePipe);
FreeMem(ph);
FreeMem(fname);
end;