delphi xe7 多线程调用CMD,使用管道,临界区技术,实现指定用户名,多线程,异步返回CMD命令结果到memo

第一次发这个,发现格式很乱,不好看,可以用XE7的project--format project sources命令格式化一下代码.

后面我会上传此次修改函数用的源代码到云盘

链接: http://pan.baidu.com/s/1jIjk7fK 密码: nf3p

基于网络上一个函数,我修改后发现如果运行命令ipconfig /all.将不能等待到返回.后面的函数已经该好了.

废话少说,先看第一个函数,注意此函数buffer为PansiChar.我想异步返回结果,结果造成不小麻烦,所有我选择一次性提交结果

function WaitRunDOs(ReadPepi: THandle;ProcessInfo: TProcessInformation;Memo: TMemo) :TProc;
begin
Result:= procedure
var
BytesRead: DWord;
Buffer: PAnsiChar;
fSize: DWORD;
begin
// showmessage('等待开始');
if (WaitForSingleObject(ProcessInfo.hProcess, INFINITE)= WAIT_OBJECT_0) then
begin
// 申请缓冲
Fsize := GetFileSize(ReadPepi,nil);
Buffer := AllocMem(Fsize + 1);
BytesRead := 0;
// ReadFile(ReadPepi, Buffer[0], CUANTOBUFFER, BytesRead, nil);
ReadFile(ReadPepi, Buffer[0], fSize + 1, BytesRead, nil);
Buffer[BytesRead] := #0;
OemToAnsi(Buffer, Buffer);
Memo.Lines.Add(String(AnsiToUtf8(Buffer)));
{按照换行符进行分割，并在Memo中显示出来}
{ while (pos(#10, Buffer) > 0)do
begin
sss:= Copy(Buffer, 1, pos(#10, Buffer) - 1);
Memo.Lines.Add(Copy(Buffer, 1, pos(#10, Buffer) - 1));
Delete(Buffer, 1, pos(#10, Buffer));
end; }

FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ReadPepi);
end;
end;
end;

procedure RunDosInMemo(command: String; Memo: TMemo);
var
pepiAttr: TSecurityAttributes;
startInfo: TStartupInfoW;
ProcessInfo: TProcessInformation;
ApplicationName: PWideChar;
ReadPipe,WritePipe: THandle;
begin
// 安全描述 可以省略
with pepiAttr do
begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;

{ 创建管道}
if Createpipe(ReadPipe, WritePipe, @pepiAttr, 0) then
begin
// 创建STARTUPINFO
FillChar(startInfo, SizeOf(startInfo), #0);
startInfo.cb := SizeOf(startInfo);
startInfo.hStdOutput := WritePipe;
// startInfo.hStdInput := ReadPipe;
startInfo.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES or 16;
startInfo.wShowWindow := SW_HIDE;
ApplicationName :=pwidechar('C:\Windows\System32\cmd.exe');
if not (CreateProcessWithLogon(
'用户名(如administrator)','域名','密码', LOGON_WITH_PROFILE,
nil,PChar('cmd /c' + command),
// CREATE_NO_WINDOW,
CREATE_DEFAULT_ERROR_MODE,
nil,nil,
StartInfo, ProcessInfo))then
begin
RaiseLastOSError;
end else
begin
CloseHandle(WritePipe);
//预计完成运行
cs.Enter;
TThread.CreateAnonymousThread(WaitRunDOs(ReadPipe,ProcessInfo,Memo)).Start;
cs.Leave;
end;
end;
end;

然后我决定有必要修改,查找资料后得到下面这个函数,总算实现了我的目的.如果想同时执行几个命令,可以将command赋值为'';然后将命令写在同目录下的command.bat中

当然也可以使用重定向输入.具体实现方式还没研究,不知道哪位兄弟可提供些代码来学习

/// <param name="command">

/// 命令行如果为空,则运行同一目录下command.bat文件,

/// 但需确保应用程序和bat文件不在特定用户的桌面等无读写权限的特殊目录
/// </param>
procedure GetDosToMemo(command:string;memo:TMemo);
var
SA: TSecurityAttributes;
SI: TStartupInfo;
PI: TProcessInformation;
PipeRead,PipeWrite: THandle;
WasOK: Boolean;
Buffer: array [0 .. 255] of AnsiChar;
PCName: array [0..254] of char;
PCNameSize:Dword;
BytesRead: Cardinal;
Commandline,AppName,CurrentDir,return:string;
begin
//获取计算机名
GetComputerName(PCName,PCNameSize);
AppName :=pwidechar('C:\Windows\System32\cmd.exe');
CommandLine:='/c' + Command;
if length(command) <= 0 then
CommandLine := '/c command.bat';
Currentdir := GetCurrentDir;

TThread.CreateAnonymousThread(
procedure
begin
with SA do
begin
nLength := SizeOf(SA);
bInheritHandle := True;
lpSecurityDescriptor := nil;
end;
if CreatePipe(PipeRead, PipeWrite, @SA, 0) then
begin
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); // 不重定向hStdInput
hStdOutput := PipeWrite;
hStdError := PipeWrite;
end;
{ CreateProcess(nil, PChar('cmd /c ' + comand), nil, nil,
True, 0, nil, nil, SI, PI); }
//如果ApplicationName :=pwidechar('C:\Windows\System32\ping.exe');
//则不使用cmd 参数 ,'/c'或'/k'等,
//AppName为nil,则参数必须加上环境变量目录内的//应用程序名 如'cmd /c'

{if not (CreateProcessWithLogon(
'用户名','域名','密码', LOGON_WITH_PROFILE,
nil, PChar('cmd /c' + command),
// PChar('cmd /c' + command),
// CREATE_NO_WINDOW,
CREATE_DEFAULT_ERROR_MODE,
nil,nil,
SI, PI))then }
if not (CreateProcessWithLogon(
'用户名','域名','密码',
LOGON32_PROVIDER_DEFAULT or LOGON_WITH_PROFILE,
PChar(AppName),
PChar(CommandLine),
(CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE) + CREATE_UNICODE_ENVIRONMENT,
nil,
pchar(CurrentDir),
SI, PI))then
RaiseLastOSError;

CloseHandle(PipeWrite);
try
return := '';
cs.Enter;
repeat
WasOK:= ReadFile(PipeRead, Buffer, 255, BytesRead, nil);
if BytesRead > 0 then
begin
Buffer[BytesRead] := #0;
return := string(AnsiToUtf8(return + Buffer));
end;

if EndsText(#13#10,return) then
begin
//ShowMessage(return + 'a');
//去掉首先返回的#13#10和最后的#13#10,否则每行会插入一空行
if Length(return) > 2 then
begin
if StartsText(#13#10,return) then
Delete(return,1,2);

Delete(return,Length(return)-2,Length(return));
//返回的数据有少量不同,不采用
//memo.Lines.Add(ReplaceText(return,#13#10,''));
memo.Lines.Add(return);
end;
return := '';
end;
until not WasOK or (BytesRead = 0);
//避免提前关闭句柄
WaitForSingleObject(PI.hProcess, INFINITE);
finally
CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);
end;
cs.Leave;
finally
CloseHandle(PipeRead);
end;
end;
end).Start;
end;