DELPHI盒子
!实时搜索: 盒子论坛 | 注册用户 | 修改信息 | 退出
检举帖 | 全文检索 | 关闭广告 | 捐赠
技术论坛
 用户名
 密  码
自动登陆(30天有效)
忘了密码
≡技术区≡
DELPHI技术
lazarus/fpc/Free Pascal
移动应用开发
Web应用开发
数据库专区
报表专区
网络通讯
开源项目
论坛精华贴
≡发布区≡
发布代码
发布控件
文档资料
经典工具
≡事务区≡
网站意见
盒子之家
招聘应聘
信息交换
论坛信息
最新加入: hebhanax
今日帖子: 49
在线用户: 13
导航: 论坛 -> DELPHI技术 斑竹:liumazi,sephil  
作者:
男 cenunus (cenunus) ★☆☆☆☆ -
普通会员
2019/6/10 8:36:55
标题:
求助管道执行dos命令的问题 浏览:759
加入我的收藏
楼主: 我想运行一个dos窗口,执行ping 127.0.0.1 -t,然后从这个dos窗口不停的读取返回的数据。我从网上找了一些代码,但是有问题,因为一直没弄过这样的功能,不知道怎么弄,请各位大侠有空的话帮助一下,谢谢!

全局变量:ReadOut, WriteOut,ReadIn, WriteIn: THandle;

procedure TForm1.创建管道;
var
  Security: TSecurityAttributes;
  start: TStartupInfoA;
  ProcessInfo:PROCESS_INFORMATION;
  HRead, HWrite: THandle;
begin
  with Security do
  begin
    nlength := SizeOf(TSecurityAttributes);
    binherithandle := true;
    lpsecuritydescriptor := nil;
  end;

  Createpipe(ReadOut, WriteOut, @Security, 0);
  Createpipe(ReadIn, WriteIn, @Security, 0);

  with Security do
  begin
    nlength := SizeOf(TSecurityAttributes);
    binherithandle := true;
    lpsecuritydescriptor := nil;
  end;

  FillChar(Start, Sizeof(Start), #0);
  start.cb := SizeOf(start);
  start.hStdOutput := WriteOut;
  start.hStdInput := ReadIn;
  start.hStdError := WriteOut;
  start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
  start.wShowWindow := SW_SHOW;

  CreateProcessA(nil, PAnsiChar(AnsiString('ping 127.0.0.1 -t')), @Security, @Security, True, CREATE_NEW_CONSOLE, nil, nil, start, ProcessInfo) ;
end;

function TForm1.从管道读取(Pipe: THandle): string;
const
  ReadBuffer =4096;
var
  Buffer: PAnsiChar;
  BytesRead: DWord;
begin
  Result := '';
  if GetFileSize(Pipe, nil) = 0 then Exit;

  Buffer := AllocMem(ReadBuffer + 1);
  repeat
    BytesRead := 0;
    ReadFile(Pipe, Buffer[0],ReadBuffer, BytesRead, nil);
    if BytesRead > 0 then
    begin
      Buffer[BytesRead] := #0;
      //OemToAnsi(Buffer, Buffer);
      Result := string(Buffer);
    end;
  until (BytesRead < ReadBuffer);
  FreeMem(Buffer);
end;

procedure TForm1.写入管道(Pipe: THandle; Value: string);
var
  len: integer;
  BytesWrite: DWord;
  Buffer: PChar;
begin
  len := Length(Value) + 1;
  Buffer := PChar(Value + #10);
  WriteFile(Pipe, Buffer[0], len, BytesWrite, nil);
end;

procedure TForm1.btn1Click(Sender: TObject);
begin
  创建管道;
end;

procedure TForm1.tmr1Timer(Sender: TObject);
var
  tmp:string;
begin
  tmp:=从管道读取(WriteOut);
  mmo1.Text:=tmp;
end;
----------------------------------------------
作者:
男 useguest (useguest) ★☆☆☆☆ -
普通会员
2019/6/10 8:49:54
1楼: 这我平时用的:

function RunDosCommand(command: string; mode: Byte = 1): string;
var
  hReadPipe, hWritePipe: THandle;
  si: STARTUPINFO;
  lsa: SECURITY_ATTRIBUTES;
  pi: PROCESS_INFORMATION;
  cchReadBuffer, BytesRead: DWORD;
  Dest: array[0..1023] of char;
  cmdLine: array[0..512] of char;
begin
  Result := '';
  case mode of
    1:          // 命令行结果输出到字符串
      begin
        lsa.nLength := sizeof(SECURITY_ATTRIBUTES);
        lsa.lpSecurityDescriptor := nil;
        lsa.bInheritHandle := True;

        if CreatePipe(hReadPipe, hWritePipe, @lsa, 0) = False then
        begin
          //MessageDlg('Can not create pipe!', mtError, [mbOK], 0);
          Result := 'Can not create pipe!';
          Exit;
        end;

        try
          FillChar(si, SizeOf(STARTUPINFO), 0);
          si.cb := SizeOf(STARTUPINFO);
          si.dwFlags := (STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW);
          si.wShowWindow := SW_HIDE;
          si.hStdOutput := hWritePipe;
          si.hStdError := hWritePipe;
          StrPCopy(cmdLine, command);

          if CreateProcess(nil, cmdLine, nil, nil, true, 0, nil, nil, si, pi) = False then
          begin
          //MessageDlg('Can not create process!', mtError, [mbOK], 0);
          Result := 'Can not create process!';
          Exit;
          end;

          Result := '';
          while (True) do
          begin
          if not PeekNamedPipe(hReadPipe, @Dest[0], 1024, @cchReadBuffer, nil, nil) then
          break;
          if cchReadBuffer <> 0 then
          begin
          FillChar(Dest, SizeOf(Dest), 0);
          if ReadFile(hReadPipe, Dest[0], cchReadBuffer, BytesRead, nil) = false then
          break;
          Result := Result + Copy(Dest, 0, BytesRead);
          end
          else if (WaitForSingleObject(pi.hProcess, 0) = WAIT_OBJECT_0) then
          break;
          Delay(100);
          end;

          CloseHandle(pi.hThread);
          CloseHandle(pi.hProcess);
        finally
          CloseHandle(hReadPipe);
          CloseHandle(hWritePipe);
        end;
      end;
    2:          // 无返回值
      begin
        ShellExecute(0, 'open', 'cmd', PChar('/k ' + command + '&exit'), nil, SW_HIDE);
      end;
  end;
end;
----------------------------------------------
-
作者:
男 cenunus (cenunus) ★☆☆☆☆ -
普通会员
2019/6/10 10:42:13
2楼: 我把SW_HIDE改成SW_SHOW后
procedure TForm1.btn1Click(Sender: TObject);
begin
  TThread.CreateAnonymousThread(
  procedure
  begin
    RunDosCommand('ping 127.0.0.1 -t');
  end
  ).Start;
end;
运行后,dos窗口中没有任何返回,并没有预期中的不停ping的信息,请教楼上。。。。。
----------------------------------------------
作者:
男 tuesdays (Tuesday) ▲▲▲▲△ -
普通会员
2019/6/10 11:16:30
3楼: 跟SW_HIDE没关系... 他那函数写得不严.. 

// Result := Result + Copy(Dest, 0, BytesRead);

Result := Result + Copy(Dest, 0, BytesRead);
ShowMessage(Result);

然后你就可以看到效果了.. 但这样会无限占用一个进程..  所以需要规划一下...
----------------------------------------------
delphi界写python最强, python界写delphi最强. 写自己的代码, 让别人去运行.
作者:
男 cenunus (cenunus) ★☆☆☆☆ -
普通会员
2019/6/10 13:08:32
4楼: 看见了,可惜是乱码。。。不知道怎么搞。。。
----------------------------------------------
作者:
男 bahamut8348 (leonna) ★☆☆☆☆ -
普通会员
2019/6/10 13:54:19
5楼: char改成ansichar
----------------------------------------------
--
作者:
男 cenunus (cenunus) ★☆☆☆☆ -
普通会员
2019/6/10 14:46:06
6楼: 谢谢大家~~~
----------------------------------------------
信息
登陆以后才能回复
Copyright © 2CCC.Com 盒子论坛 v3.0.1 版权所有 页面执行70.3125毫秒 RSS