第一次發這個,發現格式很亂,不好看,可以用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;
