标签：begin TSimpleConsole end string delphi 程中 console ACmdStr procedure
在编程开发的时候，我们时常会调用windows本身的功能，如：检测网络通断，连接无线wifi等。
虽然，用 windows api 操作可以完美地完成这些操作，但是，函数参数太难了。令人望而生畏，不是普通开发者能办到的。
但是，我们可以用一种变通的方法，来解决这个问题，就是使用控制台命令行，如 ping , netsh 等。
我在网络上，搜索到了delphi调用命令行，并返回接收返回的结果（字符串信息）代码，但这些代码仅仅只是功能实现了，离实用性还差一步。
所以做了如下改进：
1.将 cmd 运行进程放入线程中，不放入线程，界面就卡死了，阻塞的，实用性大大降低，可能只能采用运行一次命令，就创建一次cmd进程的方式来实现。
本例的CMD只创建一次，可以复用。
2.提供了明确的执行结果事件，就是命令真正执行完毕的事件，因为返回的结果字符串不是一次性全部返回的，太长的结果是分批次返回的。这一点，但其它的控制台的设备中也是一样的。如路由器的 console 下。
3.实现了 ctrl + c 这类特殊事件的触发，如果没有这个功能，运行 ping 127.0.0.1 -t 就无法正常结束。
经过工作实践中运行，觉得还不错，不敢独享，故分享给大家。也算是 delphi 线程的一个教学实例。
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[i]);
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[1], @FFileName[1], 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 [0 .. 255] 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[nOut - nBytesRead + 1], @strBuff[0], nBytesRead);
ReadFile(FOutRead, strBuff[0], 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[1], (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
标签：begin,TSimpleConsole,end,string,delphi,程中,console,ACmdStr,procedure 来源： https://www.cnblogs.com/lackey/p/10357331.html
本站声明： 1. iCode9 技术分享网（下文简称本站）提供的所有内容，仅供技术学习、探讨和分享； 2. 关于本站的所有留言、评论、转载及引用，纯属内容发起人的个人观点，与本站观点和立场无关； 3. 关于本站的所有言论和文字，纯属内容发起人的个人观点，与本站观点和立场无关； 4. 本站文章均是网友提供，不完全保证技术分享内容的完整性、准确性、时效性、风险性和版权归属；如您发现该文章侵犯了您的权益，可联系我们第一时间进行删除； 5. 本站为非盈利性的个人网站，所有内容不会用来进行牟利，也不会利用任何形式的广告来间接获益，纯粹是为了广大技术爱好者提供技术内容和技术思想的分享性交流网站。