第一次发这个,发现格式很乱,不好看,可以用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);
bInheritH