DELPHI盒子
!实时搜索: 盒子论坛 | 注册用户 | 修改信息 | 退出
检举帖 | 全文检索 | 关闭广告 | 捐赠
技术论坛
 用户名
 密  码
自动登陆(30天有效)
忘了密码
≡技术区≡ ①
DELPHI技术
lazarus/fpc/Free Pascal
移动应用开发
Web应用开发
数据库专区
报表专区
网络通讯
开源项目
论坛精华贴
≡发布区≡ ②
发布代码
发布控件
文档资料
经典工具
≡事务区≡ ③
网站意见
盒子之家
招聘应聘
信息交换
论坛信息
最新加入： tkzcol
今日帖子： 9
在线用户： 31
导航： 论坛 -> DELPHI技术 斑竹:liumazi,sephil  
作者：
男 rechalow (砖需需需) ▲△△△△ -
普通会员
2023/7/2 17:02:08
标题：
在使用CreateProcess的时候，等待执行的过程中，如果命令行回显过多则程序会卡死。 浏览:1905
加入我的收藏
楼主： 我使用了CreateProcess，调用外部命令，然后等待其执行完毕之后，返回回显的值进入一个字符串里面。
但是嘛……很遗憾，在运行到WaitForSingleObject的时候，该程序被卡死。
很明显，我只是想获取回显罢了，如果无法获取回显也无所谓，那给我一个等待命令行执行完毕后才开始执行下一步操作的代码吧！
就是的，我使用了一个C++写的一小串非常简单的代码测试我的程序是否能执行，果然是在WaitForSingleObject中被卡死的。

在这个C++中，我只是用一个很简单的循环一万次，然后输出一万次的值，就像这样：
https://paste.ubuntu.com/p/zpWSg84qWQ/
然后嘛，调用Delphi程序获取其一万行的回显，程序卡死。。
https://paste.ubuntu.com/p/sjp6YNZnnm/
其中，commandline我填入的是我C++编译出来的exe，millisecond填入的是Integer.MaxValue。
说实在的，如果获取不了回显的话，就请告诉我如何等待命令执行完毕之后，再执行下一步指令的确切值了！
也谢谢各位啦！

在我的程序中，我只是想要程序能够无论回显多少，都能够等待执行完毕并且正常返回即可啦！只是能够回显是最好不过了的！
----------------------------------------------
十全十美，万中无一。
作者：
男 net1999 (好人) ★☆☆☆☆ -
普通会员
2023/7/2 17:33:52
1楼： 不需要的话，可以关闭回显，转向到空设备。
----------------------------------------------
-
作者：
男 rechalow (砖需需需) ▲△△△△ -
普通会员
2023/7/2 17:53:32
2楼： 那请问一下，除了使用WaitForSingleObject以外，还有什么方式可以等待命令执行完毕的？

比如说我要执行一个超过10w+会显示在命令行中的exe文件，那我应该怎么做才能等待该10w+个回显显示完毕后，等待最后一个Done命令一旦执行，则立刻返回我的程序执行下一步呢？

其实，获取其回显的主要目的，就是为了读取程序最后输出的Done！如果输出的是Error，则证明有错误。

但是正常的电脑来说，都应该是Done才对，所以获取回显不回显的都无所谓了。。
----------------------------------------------
十全十美，万中无一。
作者：
男 tuesdays (Tuesday) ▲▲▲▲△ -
普通会员
2023/7/2 20:53:12
3楼： 明天我给个类你, 完美兼容win dos, 使用更方便.
----------------------------------------------
delphi界写python最强, python界写delphi最强. 写自己的代码, 让别人去运行.
作者：
男 rechalow (砖需需需) ▲△△△△ -
普通会员
2023/7/3 3:00:21
4楼： 不太需要类这玩意，里面函数功能过多了反而不好，我需要的功能其实非常简单的。
最好是一个function运行的示例。
不管怎么说，还是谢谢啦！
----------------------------------------------
十全十美，万中无一。
作者：
男 tuesdays (Tuesday) ▲▲▲▲△ -
普通会员
2023/7/3 8:58:25
5楼： 那就算了, 你每次造个轮子也行.
----------------------------------------------
delphi界写python最强, python界写delphi最强. 写自己的代码, 让别人去运行.
作者：
男 bahamut8348 (leonna) ★☆☆☆☆ -
普通会员
2023/7/3 21:41:04
6楼： 你一次性等完他当然卡住，你要分段等待，期间调用handlemessage接受并处理消息就不会卡死了。
----------------------------------------------
--
作者：
男 souledge (souledge) ★☆☆☆☆ -
普通会员
2023/7/5 11:01:30
7楼： GUI是在主线程运行的，我估计你是在主线程去等待的，这肯定会导致界面卡死。应该单独开个线程去CreateProcess并等待执行结束
----------------------------------------------
-
作者：
男 rechalow (砖需需需) ▲△△△△ -
普通会员
2023/7/5 14:06:39
8楼： 好吧，这么说吧，无论单独开一个TTask，还是使用主线程，都会卡死。。
这种卡死是无论等多久都不会动的那种。
还是无法获取Done吗？最近我测试的时候，有些电脑是返回Error的。。在返回Error的时候，我的程序需要做相应的处理才行【指将错误反馈给客户】
怎么调用handlemessage呢？能给个示例吗？
----------------------------------------------
十全十美，万中无一。
作者：
男 rechalow (砖需需需) ▲△△△△ -
普通会员
2023/7/5 14:13:04
9楼： 用的是最基础的Windows VCL程序测试
----------------------------------------------
十全十美，万中无一。
作者：
男 1111111112 (1111111112) ▲△△△△ -
普通会员
2023/7/5 14:28:12
10楼： jcl 示例里面怕是有你要的。
----------------------------------------------
-
作者：
男 bahamut8348 (leonna) ★☆☆☆☆ -
普通会员
2023/7/5 14:35:46
9楼： ttask么？这个东西倒是没用过，不过也要看你究竟是怎么用的，如果你调用了同步方法，或者启动任务之后就用了waitfor，那一样是在主线程阻塞。
----------------------------------------------
--
作者：
男 rechalow (砖需需需) ▲△△△△ -
普通会员
2023/7/5 23:27:24
11楼： 那应该怎么办才好，我现在只需要检测回显的最后是否出现Done就好了，别的我都不祈求了。

还是同一个问题，应该怎么使用message消息，怎么处理呢？
----------------------------------------------
十全十美，万中无一。
作者：
男 net1999 (好人) ★☆☆☆☆ -
普通会员
2023/7/6 8:19:35
12楼： 可以在等待中加入消息处理。如：

while not done do
begin
 sleep(100);
 application.processmessage;
end;
----------------------------------------------
-
作者：
男 souledge (souledge) ★☆☆☆☆ -
普通会员
2023/7/6 9:55:02
13楼： 看了下楼主的代码，是实现方式有点问题，我直接给你贴我的代码吧

class function TWinUtils.WinExecWithPipe(const ACmdLine, ADirectory: string;
  var AOutputStr: string; var AExitCode: Cardinal): Boolean;
var
  LPipeReadHandle, LPipeWriteHandle: THandle;
  LStartInfo: TStartupInfo;
  LProceInfo: TProcessInformation;
  LPipeSa: TSecurityAttributes;
  LPipeReadStream: THandleStream;
  LTmpStr: string;

  procedure ReadLinesFromPipe(const AIsEnd: Boolean);
  var
    S: string;
    LTmpBytes: TBytes;
    LTmpStrList: TStringList;
    I: Integer;
  begin
    if (LPipeReadStream.Position < LPipeReadStream.Size) then
    begin
      SetLength(LTmpBytes, LPipeReadStream.Size - LPipeReadStream.Position);
      LPipeReadStream.Read(LTmpBytes[0], LPipeReadStream.Size - LPipeReadStream.Position);
      SetString(S, MarshaledAString(@LTmpBytes[0]), Length(LTmpBytes));

      LTmpStr := LTmpStr + S;
      LTmpStrList := TStringList.Create;
      try
        LTmpStrList.Text := LTmpStr;
        for I := 0 to LTmpStrList.Count - 2 do
          AOutputStr := AOutputStr + LTmpStrList[I] + sLineBreak;
        LTmpStr := LTmpStrList[LTmpStrList.Count - 1];
      finally
        FreeAndNil(LTmpStrList);
      end;
    end;

    if AIsEnd and (LTmpStr <> '') then
    begin
      AOutputStr := AOutputStr + LTmpStr + sLineBreak;
      LTmpStr := '';
    end;
  end;
begin
  AExitCode := 0;
  Result := False;
  try
    FillChar(LPipeSa, SizeOf(LPipeSa), 0);
    LPipeSa.nLength := SizeOf(LPipeSa);
    LPipeSa.bInheritHandle := True;
    LPipeSa.lpSecurityDescriptor := nil;
    LPipeReadStream := nil;
    LTmpStr := '';
    LPipeReadHandle := INVALID_HANDLE_VALUE;
    LPipeWriteHandle := INVALID_HANDLE_VALUE;
    try
      Win32Check(CreatePipe(LPipeReadHandle, LPipeWriteHandle, @LPipeSa, 0));

      FillChar(LStartInfo, SizeOf(LStartInfo), 0);
      LStartInfo.cb := SizeOf(LStartInfo);
      LStartInfo.wShowWindow := SW_HIDE;
      LStartInfo.dwFlags := STARTF_USESTDHANDLES{ + STARTF_USESHOWWINDOW};
      LStartInfo.hStdError := LPipeWriteHandle;
      LStartInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE);
      LStartInfo.hStdOutput := LPipeWriteHandle;

      FillChar(LProceInfo, SizeOf(LProceInfo), 0);

      LPipeReadStream := THandleStream.Create(LPipeReadHandle);

      Win32Check(CreateProcess(nil, //lpApplicationName: PChar
        TUtils.StrToPChar(ACmdLine), //lpCommandLine: PChar
        nil, //lpProcessAttributes: PSecurityAttributes
        nil, //lpThreadAttributes: PSecurityAttributes
        True, //bInheritHandles: BOOL
        0,
        nil,
        TUtils.StrToPChar(ADirectory),
        LStartInfo,
        LProceInfo));

      while (WaitforSingleObject(LProceInfo.hProcess, 100) = WAIT_TIMEOUT) do
      begin
        ReadLinesFromPipe(False);
        //Application.ProcessMessages;
        //if Application.Terminated then break;
      end;
      ReadLinesFromPipe(True);

      GetExitCodeProcess(LProceInfo.hProcess, AExitCode);

      CloseHandle(LProceInfo.hProcess);
      CloseHandle(LProceInfo.hThread);

      Result := True;
    finally
      if (LPipeReadStream <> nil) then
        FreeAndNil(LPipeReadStream);

      if (LPipeReadHandle <> INVALID_HANDLE_VALUE) then
        CloseHandle(LPipeReadHandle);

      if (LPipeWriteHandle <> INVALID_HANDLE_VALUE) then
        CloseHandle(LPipeWriteHandle);
    end;
  except
    ;
  end;
end;
----------------------------------------------
-
作者：
男 bahamut8348 (leonna) ★☆☆☆☆ -
普通会员
2023/7/6 12:37:52
14楼： const
  /// 定义消息
  cwm_custom_first = wm_user + $0100;
  cwm_call_process = cwm_custom_first + $0001;
  cp_error = -1; /// 错误
  cp_start = 1; /// 开始
  cp_progress = 2; /// 进行中
  cp_done = 3; /// 结束

/// 匿名线程
tthread.createanonymousthread(procedure ()
begin
  sendmessage(self.handle, cwm_call_process, cp_start, 0); /// 通知主线程开始
  createprocess(...); /// 执行你的调用过程
  /// 或者在执行过程中也可以持续不断的用消息对主线程输出读取到的回显内容，增加友好程度. 例如 sendmessage(self.handle, cwm_call_process, cp_progress, 回显内容);
  sendmessage(self.handle, cwm_call_process, cp_done, 回显内容); /// 同知主线程结束
end).start();



在主窗口增加对cwm_call_process消息的处理：
定义: procedure cwmcallprocess(var message: tmessage); message cwm_call_process;

实现：
procedure ...cwmcallprocess(var message: tmessage);
begin
  case message.wparam of
    cp_error: /// 出错
      ....
    cp_start: /// 线程开始
      ...
    cp_progress: /// 进行中，可以取lparam也就是sendmessage最后一个参数提取内容
      showmessage(pchar(message.lparam));
    cp_done: /// 结束，
      showmessage(pchar(message.lparam));
  end;
end;
----------------------------------------------
--
作者：
男 rechalow (砖需需需) ▲△△△△ -
普通会员
2023/7/6 21:14:07
15楼： 你好啊，我尝试了一下你的代码，发现还是在超过一万行输出的程序里面有报错。
这里是改装后的源码
这个是我经过了你的代码之后改装的源码链接。
我尝试过这样输出：
【showmessage(RunDOSBack('cmd /c echo hello'));】
这样肯定能够成功回显出来，信息框里能够显示hello
但是我再一次堵塞在回显超过一万行的地方卡住。。源码还是上面C++的源码。
我觉得，无论是在主线程中执行，还是在TTask中执行，都不应该有问题的啊？
----------------------------------------------
十全十美，万中无一。
作者：
男 tuesdays (Tuesday) ▲▲▲▲△ -
普通会员
2023/7/7 13:58:25
16楼： 这楼主是个憨憨, 说给它一个类文件, 它说只想要个函数. 
     Qc := QShell.Create;
     // 无限等待.
     Qc.Timeout := 0;  
    // 调用命令行看名字应该是ffmpeg. 
    Qc.Exec(video.FFmpeg, CMMD);
    // 无限循环, 第一个判断是手工中止, 第二个判断是退出程序.  但凡一个条件为true, 退出循环. 
    while Qc.ExecWait((btn_zmcon.Hint = '') or IS_CLOSE) do
    begin
      // 很多人觉得命令行是一行一行输出, 实际没那么简单. 
      if Qc.ExecLines.Count > 0 then begin
        // 如果有新的输出, 循环读出来.  
        for s in Qc.ExecLines do begin
          
        end;
      end;
    end;
    Qc.ExecData;
----------------------------------------------
delphi界写python最强, python界写delphi最强. 写自己的代码, 让别人去运行.
作者：
男 tuesdays (Tuesday) ▲▲▲▲△ -
普通会员
2023/7/7 13:59:58
17楼： ExecWait 方法才是精华. 
function QShell.ExecWait(WaitStop:Boolean=False): Boolean;
var
  inS: TStream;
  WTi:Integer;
  WErrCode:Cardinal;
  Dest: AnsiString;
  Avail: DWORD;
begin
   SetLength(Dest, 1024);
   ExecLines.Clear;
   Result := False;
   try
     if (not WaitStop) and Handle and (ProcessAppMessage) AND (not Application.Terminated) and (not IsExecEnd) then begin
        WTi := 0;
        while True do begin
          Application.ProcessMessages;
          WErrCode := WaitForSingleObject(PI.hProcess, 100);
          inc(WTi, 100);
          Inc(RunTime,100);
          if WTi >= ExecWaitTime then
          Break;
          if IsExecEnd then
          Break;
          if Application.Terminated then
          Break;
        end;

        Result := True;
        if (WErrCode <> WAIT_TIMEOUT) then begin
          IsExecEnd := true;
        end else
        if (Timeout <> 0) and (RunTime >= Timeout) then begin //超时.
          WErrCode := WAIT_TIMEOUT;
          IsExecEnd := true;
        end;
        Info.ForceName('SingleObject').AsInteger := WErrCode;
        Info.ForceName('WaitForTime').AsInt64    := RunTime;
        Info.ForceName('WaitErrCode').AsInteger  := WErrCode;
        Info.ForceName('WaitErrMsg').AsString    := SysErrorMessage(WErrCode);
     end else begin
        // 如果它并没完全完成, 添加错误码值.
        if ErrCode = 0 then begin
          if not ProcessAppMessage then begin
          ErrCode := 995;
          ErrMsg  := SysErrorMessage(ErrCode);
          end else if WaitStop then begin
          ErrCode := 1223;
          ErrMsg  := SysErrorMessage(ErrCode);
          end else if not Handle then begin
          ErrCode := 1830;
          ErrMsg  := SysErrorMessage(ErrCode);
          end else if Application.Terminated then begin
          ErrCode := 1235;
          ErrMsg  := SysErrorMessage(ErrCode);
          end;
          Info.ForceName('ErrCode').AsInteger   := ErrCode;
          Info.ForceName('ErrMsg').AsString     := SysErrorMessage(ErrCode);
        end;
     end;


     if PeekNamedPipe(StdOutPipeRead, @Dest[1], 1024, @Avail, nil, nil) then begin
      if Avail > 0 then begin
       inS := THandleStream.Create(StdOutPipeRead);
        try
          if inS.Size > 0 then begin
          try
          TemStrQ.Clear;
          TemStrQ.CopyFrom(inS,ins.Size);
          TemStrQ.Position := 0;
          ExecLines.Clear;
          ExecLines.LoadFromStream(TemStrQ,TEncoding.UTF8);
          except
          on E: Exception do begin
          TemStrQ.Position := 0;
          ExecLines.Clear;
          ExecLines.LoadFromStream(TemStrQ);
          end;
          end;

          // 识别异常.
          if (ExecLines.Count > 0) AND (Pos('**#11021#**', ExecLines.Text) > 0) then begin
          ExecLines.Text := Trim(StringReplace(ExecLines.Text,'**#11021#**','',[rfReplaceAll]));
          // 这是dos 错误. 但不会阻止循环.
          if ErrCode = 0 then begin
          ErrCode := 119;
          ErrMsg  := SysErrorMessage(ErrCode);
          Info.ForceName('ErrCode').AsInteger := ErrCode;
          Info.ForceName('ErrMsg').AsString   := ErrMsg;
          end;
          end;

          if (not IsNotRetData) AND (ExecLines.Count > 0) then begin
          OutStrings.AddStrings(ExecLines);
          end;
          end;
        finally
          FreeAndNil(inS);
        end;
      end;
      end;
     // 释放监控信息在json里面。
     with Info do begin
        ForceName('isNotTerminateApp').AsBoolean := isNotTerminateApp;
        ForceName('SetTimeout').AsInteger := Timeout;
        ForceName('IsNotRetData').AsBoolean := IsNotRetData;
        ForceName('ExecCount').AsInteger := (ForceName('ExecCount').AsInteger+1);
        ForceName('ExecResult').AsBoolean := Result;
        ForceName('EndDate').AsString := FormatDateTime('yyyy-mm-dd hh:nn:ss',now());
     end;
   finally
     // 如果返回假，可能情况是已经退出， 或者超时， 清理pid之类。
     if not Result then begin
        DoEnd;
        if not IsNotRetData then begin
          Info.ForceName('OutStringSize').AsInt64 := Length(OutStrings.Text);
          if Info.ForceName('OutStringSize').AsInt64 <= 10240 then
          Info.ForceName('OutStringS').AsString := OutStrings.Text;
        end;
        IsExecEnd := True;
     end;
     Info.ForceName('ExecEnd').AsBoolean      := IsExecEnd;
     if not ProcessAppMessage then
        PostQuitMessage(ExitCode);
   end;
end;
----------------------------------------------
delphi界写python最强, python界写delphi最强. 写自己的代码, 让别人去运行.
作者：
男 1111111113 (1111111113) ▲△△△△ -
普通会员
2023/7/7 16:57:07
18楼： 条条大路通罗马，为何死守泥泞路？
此帖子包含附件:1111111113_20237716577.rar 大小:998B
----------------------------------------------
-
作者：
男 rechalow (砖需需需) ▲△△△△ -
普通会员
2023/7/7 21:10:08
19楼： 好吧，那我试试，谢谢各位啦！
----------------------------------------------
十全十美，万中无一。
信息
登陆以后才能回复
Copyright © 2CCC.Com 盒子论坛 v3.0.1 版权所有 页面执行70.3125毫秒 RSS