delphi 在线程中运行控制台命令(console)
<p>转载自：https://www.cnblogs.com/lackey/p/10357331.html</p><p>在编程开发的时候，我们时常会调用windows本身的功能，如：检测网络通断，连接无线wifi等。</p>
<p>虽然，用 windows api 操作可以完美地完成这些操作，但是，函数参数太难了。令人望而生畏，不是普通开发者能办到的。</p>
<p>但是，我们可以用一种变通的方法，来解决这个问题，就是使用控制台命令行，如 ping , netsh 等。</p>
<p>我在网络上，搜索到了delphi调用命令行，并返回接收返回的结果（字符串信息）代码，但这些代码仅仅只是功能实现了，离实用性还差一步。</p>
<p>所以做了如下改进：</p>
<p>1.将 cmd 运行进程放入线程中，不放入线程，界面就卡死了，阻塞的，实用性大大降低，可能只能采用运行一次命令，就创建一次cmd进程的方式来实现。</p>
<p>本例的CMD只创建一次，可以复用。</p>
<p>2.提供了明确的执行结果事件，就是命令真正执行完毕的事件，因为返回的结果字符串不是一次性全部返回的，太长的结果是分批次返回的。这一点，但其它的控制台的设备中也是一样的。如路由器的 console 下。</p>
<p>3.实现了 ctrl + c 这类特殊事件的触发，如果没有这个功能，运行 ping 127.0.0.1 -t 就无法正常结束。</p>
<p>经过工作实践中运行，觉得还不错，不敢独享，故分享给大家。也算是 delphi 线程的一个教学实例。</p>
<div class="cnblogs_Highlighter">
<pre class="brush:delphi;gutter:true;">unit uSimpleConsole;
interface
uses
System.Classes, WinApi.Windows, uElegantThread, uSimpleThread, uSimpleList;
type
TSimpleConsole = class;
TConsoleStatus = (ccUnknown, ccInit, ccCmdResult);
TOnConsoleStatus = procedure(Sender: TSimpleConsole; AStatus: TConsoleStatus) of object;
TInnerConsoleStatus = (iccInit, iccExecCmd, iccSpecEvent, iccWait);
PCmdStr = ^TCmdStr;
TCmdStr = record
Status: TInnerConsoleStatus;
CmdStr: string;
Event: integer;
end;
TCmdStrList = class(TSimpleList<PCmdStr>)
private
function AddCmdStr(ACmdStr: string): PCmdStr;
function AddSpecialEvent(AEvent: integer): PCmdStr;
protected
procedure FreeItem(Item: PCmdStr); override;
end;
TSimpleConsole = class(TSimpleThread)
private
FInRead: THandle; // in 用于控制台输入
FInWrite: THandle;
FOutRead: THandle; // out 用于控制台输出
FOutWrite: THandle;
FFileName: String;
FProcessInfo: TProcessInformation;
FProcessCreated: Boolean;
FCmdStrList: TCmdStrList;
FCmdResultStrs: TStringList;
FConsoleStatus: TInnerConsoleStatus;
procedure Peek;
procedure DoPeek;
procedure DoCreateProcess;
procedure DoExecCmd(ACmdStr: string);
function WriteCmd(ACmdStr: string): Boolean;
procedure DoOnConsoleStatus(AStatus: TConsoleStatus);
procedure ClearCmdResultStrs;
procedure AddCmdResultText(AText: string);
function CheckCmdResultSign(AText: string): Boolean;
public
constructor Create(AFileName: string); reintroduce;
destructor Destroy; override;
procedure StartThread; override;
procedure ExecCmd(ACmdStr: String);
procedure ExecSpecialEvent(AEvent: integer); // 执行特殊事件，如 ctrl + c
property CmdResultStrs: TStringList read FCmdResultStrs;
public
WorkDir: string;
ShowConsoleWindow: Boolean;
OnConsoleStatus: TOnConsoleStatus;
end;
function AttachConsole(dwprocessid: DWORD): BOOL;
stdcall external kernel32;
implementation
uses
Vcl.Forms, System.SysUtils, System.StrUtils;
{ TSimpleConsole }
const
cnSecAttrLen = sizeof(TSecurityAttributes);
procedure TSimpleConsole.AddCmdResultText(AText: string);
var
L: TStringList;
begin
L := TStringList.Create;
try
L.Text := Trim(AText);
FCmdResultStrs.AddStrings(L);
finally
L.Free;
end;
end;
function TSimpleConsole.CheckCmdResultSign(AText: string): Boolean;
var
L: TStringList;
i, n: integer;
sTemp: string;
begin
Result := false;
L := TStringList.Create;
try
L.Text := Trim(AText);
for i := L.Count - 1 downto 0 do
begin
sTemp := Trim(L);
n := length(sTemp);
if (PosEx(':\', sTemp) = 2) and (PosEx('>', sTemp, 3) >= n) then
begin
Result := true;
exit;
end;
end;
finally
L.Free;
end;
end;
procedure TSimpleConsole.ClearCmdResultStrs;
begin
FCmdResultStrs.Clear;
end;
constructor TSimpleConsole.Create(AFileName: string);
begin
inherited Create(true);
FFileName := AFileName;
FProcessCreated := false;
ShowConsoleWindow := false;
FCmdResultStrs := TStringList.Create;
FCmdStrList := TCmdStrList.Create;
end;
destructor TSimpleConsole.Destroy;
var
Ret: integer;
begin
Ret := 0;
if FProcessCreated then
begin
TerminateProcess(FProcessInfo.hProcess, Ret);
closehandle(FInRead);
closehandle(FInWrite);
closehandle(FOutRead);
closehandle(FOutWrite);
end;
FCmdResultStrs.Free;
FCmdStrList.Free;
inherited;
end;
procedure TSimpleConsole.DoCreateProcess;
const
cnBuffLen = 256;
cnReadByteLen = cnBuffLen;
cnSecAttrLen = sizeof(TSecurityAttributes);
cnStartUpInfoLen = sizeof(TStartupInfo);
var
sWorkDir: string;
LStartupInfo: TStartupInfo;
LSecAttr: TSecurityAttributes;
sCmd: string;
v: integer;
begin
if length(WorkDir) > 0 then
begin
sWorkDir := WorkDir;
end
else
begin
sWorkDir := ExtractFileDir(Application.ExeName);
WorkDir := sWorkDir;
end;
if ShowConsoleWindow then
v := 1
else
v := 0;
ZeroMemory(@LSecAttr, cnSecAttrLen);
LSecAttr.nLength := cnSecAttrLen;
LSecAttr.bInheritHandle := true;
LSecAttr.lpSecurityDescriptor := nil;
CreatePipe(FInRead, FInWrite, @LSecAttr, 0);
CreatePipe(FOutRead, FOutWrite, @LSecAttr, 0);
ZeroMemory(@LStartupInfo, cnStartUpInfoLen);
LStartupInfo.cb := cnStartUpInfoLen;
LStartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
LStartupInfo.wShowWindow := v;
LStartupInfo.hStdInput := FInRead; // 如果为空，则可以由键盘输入
LStartupInfo.hStdOutput := FOutWrite; // 如果为空,则显示到屏幕上
LStartupInfo.hStdError := FOutWrite;
setlength(sCmd, length(FFileName));
CopyMemory(@sCmd, @FFileName, length(FFileName) * sizeof(char));
if CreateProcess(nil, PChar(sCmd), { pointer to command line string }
@LSecAttr, { pointer to process security attributes }
@LSecAttr, { pointer to thread security attributes }
true, { handle inheritance flag }
NORMAL_PRIORITY_CLASS, nil, { pointer to new environment block }
PChar(sWorkDir), { pointer to current directory name, PChar }
LStartupInfo, { pointer to STARTUPINFO }
FProcessInfo) { pointer to PROCESS_INF }
then
begin
// ClearCmdResultStrs;
// FInnerConsoleList.AddInerStatus(iccInit);
end
else
begin
DoOnStatusMsg('进程[' + FFileName + ']创建失败');
end;
end;
procedure TSimpleConsole.DoExecCmd(ACmdStr: string);
var
sCmdStr: string;
begin
sCmdStr := ACmdStr + #13#10;
if WriteCmd(sCmdStr) then
begin
// FInnerConsoleList.AddCmdStr(iccExecCmd);
// Peek
end
else
begin
DoOnStatusMsg('执行:[' + ACmdStr + ']失败');
end;
end;
procedure TSimpleConsole.DoOnConsoleStatus(AStatus: TConsoleStatus);
begin
if Assigned(OnConsoleStatus) then
OnConsoleStatus(self, AStatus);
end;
procedure TSimpleConsole.DoPeek;
var
strBuff: array of AnsiChar;
nBytesRead: cardinal;
sOutStr: string;
sOut: AnsiString;
nOut: cardinal;
BPeek: Boolean;
p: PCmdStr;
begin
if not FProcessCreated then
begin
FConsoleStatus := iccInit;
DoCreateProcess;
FProcessCreated := true;
end;
sOutStr := '';
nBytesRead := 0;
nOut := 0;
sOut := '';
BPeek := PeekNamedPipe(FOutRead, @strBuff, 256, @nBytesRead, nil, nil);
while BPeek and (nBytesRead > 0) do
begin
inc(nOut, nBytesRead);
setlength(sOut, nOut);
CopyMemory(@sOut, @strBuff, nBytesRead);
ReadFile(FOutRead, strBuff, nBytesRead, nBytesRead, nil);
BPeek := PeekNamedPipe(FOutRead, @strBuff, 256, @nBytesRead, nil, nil);
end;
if length(sOut) > 0 then
begin
sOutStr := String(sOut);
DoOnStatusMsg(sOutStr);
if CheckCmdResultSign(sOutStr) then
begin
if FConsoleStatus = iccInit then
begin
DoOnConsoleStatus(ccInit)
end
else if FConsoleStatus = iccExecCmd then
begin
AddCmdResultText(sOutStr);
DoOnConsoleStatus(ccCmdResult)
end
else
DoOnConsoleStatus(ccUnknown);
ClearCmdResultStrs;
end;
end;
FCmdStrList.Lock;
try
p := FCmdStrList.PopFirst;
if Assigned(p) then
begin
FConsoleStatus := iccExecCmd;
if p.Status = iccExecCmd then
DoExecCmd(p.CmdStr)
else if p.Status = iccSpecEvent then
begin
AttachConsole(self.FProcessInfo.dwprocessid);
SetConsoleCtrlHandler(nil, true);
GenerateConsoleCtrlEvent(p.Event, 0);
end;
dispose(p);
end;
finally
FCmdStrList.Unlock;
end;
Peek;
SleepExceptStopped(200);
end;
procedure TSimpleConsole.ExecCmd(ACmdStr: String);
begin
FCmdStrList.Lock;
try
FCmdStrList.AddCmdStr(ACmdStr);
finally
FCmdStrList.Unlock;
end;
Peek;
end;
procedure TSimpleConsole.Peek;
begin
ExeProcInThread(DoPeek);
end;
procedure TSimpleConsole.ExecSpecialEvent(AEvent: integer);
begin
FCmdStrList.Lock;
try
FCmdStrList.AddSpecialEvent(AEvent);
finally
FCmdStrList.Unlock;
end;
Peek;
end;
procedure TSimpleConsole.StartThread;
begin
inherited;
Peek;
end;
function TSimpleConsole.WriteCmd(ACmdStr: string): Boolean;
var
nCmdLen: cardinal;
nRetBytes: cardinal;
sCmdStr: AnsiString;
begin
nCmdLen := length(ACmdStr);
sCmdStr := AnsiString(ACmdStr);
Result := WriteFile(FInWrite, sCmdStr, (nCmdLen), nRetBytes, nil);
end;
{ TInnerStatusList }
function TCmdStrList.AddCmdStr(ACmdStr: string): PCmdStr;
begin
New(Result);
Add(Result);
Result.Status := iccExecCmd;
Result.CmdStr := ACmdStr;
end;
function TCmdStrList.AddSpecialEvent(AEvent: integer): PCmdStr;
begin
New(Result);
Add(Result);
Result.Status := iccSpecEvent;
Result.Event := AEvent;
end;
procedure TCmdStrList.FreeItem(Item: PCmdStr);
begin
inherited;
dispose(Item);
end;
end.
uSimpleConsole
</pre>
</div>
<p>本例程XE8源码下载</p><br><br>
来源：https://www.cnblogs.com/approx/p/11852375.html
頁:
[1]