• 获取DOS命令的返回值.


    procedure CheckResult(b: Boolean);
    begin
      if not b then
        raise Exception.Create(SysErrorMessage(GetLastError));
    end;
    
    function RunDOS(const Prog, CommandLine, Dir: string; var ExitCode: DWORD): string;
    var
      HRead, HWrite: THandle;
      StartInfo: TStartupInfo;
      ProceInfo: TProcessInformation;
      b: Boolean;
      sa: TSecurityAttributes;
      inS: THandleStream;
      sRet: TStrings;
    begin
      Result := '';
      FillChar(sa, sizeof(sa), 0);
          //设置允许继承,否则在NT和2000下无法取得输出结果
      sa.nLength := sizeof(sa);
      sa.bInheritHandle := True;
      sa.lpSecurityDescriptor := nil;
      b := CreatePipe(HRead, HWrite, @sa, 0);
      CheckResult(b);
    
      FillChar(StartInfo, SizeOf(StartInfo), 0);
      StartInfo.cb := SizeOf(StartInfo);
      StartInfo.wShowWindow := SW_HIDE;
          //使用指定的句柄作为标准输入输出的文件句柄,使用指定的显示方式
      StartInfo.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
      StartInfo.hStdError := HWrite;
      StartInfo.hStdInput := GetStdHandle(STD_INPUT_HANDLE); //HRead;
      StartInfo.hStdOutput := HWrite;
    
      b := CreateProcess(PChar(Prog), //lpApplicationName:   PChar
        PChar(CommandLine), //lpCommandLine:   PChar
        nil, //lpProcessAttributes:   PSecurityAttributes
        nil, //lpThreadAttributes:   PSecurityAttributes
        True, //bInheritHandles:   BOOL
        CREATE_NEW_CONSOLE,
        nil,
        PChar(Dir),
        StartInfo,
        ProceInfo);
    
      CheckResult(b);
      WaitForSingleObject(ProceInfo.hProcess, INFINITE);
      GetExitCodeProcess(ProceInfo.hProcess, ExitCode);
    
      inS := THandleStream.Create(HRead);
      if inS.Size > 0 then
      begin
        sRet := TStringList.Create;
        sRet.LoadFromStream(inS);
        Result := sRet.Text;
        sRet.Free;
      end;
      inS.Free;
    
      CloseHandle(HRead);
      CloseHandle(HWrite);
    end;
    
    function GetDosOutput(const CommandLine: string): string;
    var
      SA: TSecurityAttributes;
      SI: TStartupInfo;
      PI: TProcessInformation;
      StdOutPipeRead, StdOutPipeWrite: THandle;
      WasOK: Boolean;
      Buffer: array[0..255] of Char;
      BytesRead: Cardinal;
      WorkDir, Line: string;
    begin
      Application.ProcessMessages;
      with SA do
      begin
        nLength := SizeOf(SA);
        bInheritHandle := True;
        lpSecurityDescriptor := nil;
      end;
              //   create   pipe   for   standard   output   redirection
      CreatePipe(StdOutPipeRead, //   read   handle
        StdOutPipeWrite, //   write   handle
        @SA, //   security   attributes
    //   number   of   bytes   reserved   for   pipe   -   0   default
        );
      try
                  //   Make   child   process   use   StdOutPipeWrite   as   standard   out,
                  //   and   make   sure   it   does   not   show   on   screen.
        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); //   don't   redirect   stdinput
          hStdOutput := StdOutPipeWrite;
          hStdError := StdOutPipeWrite;
        end;
    
                  //   launch   the   command   line   compiler
        WorkDir := ExtractFilePath(CommandLine);
        WasOK := CreateProcess(nil, PChar(CommandLine), nil, nil, True, 0, nil,
          PChar(WorkDir), SI, PI);
    
                  //   Now   that   the   handle   has   been   inherited,   close   write   to   be   safe.
                  //   We   don't   want   to   read   or   write   to   it   accidentally.
        CloseHandle(StdOutPipeWrite);
                  //   if   process   could   be   created   then   handle   its   output
        if not WasOK then
          raise Exception.Create('Could   not   execute   command   line!')
        else
        try
                          //   get   all   output   until   dos   app   finishes
          Line := '';
          repeat
                              //   read   block   of   characters   (might   contain   carriage   returns   and   line   feeds)
            WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
    
                              //   has   anything   been   read?
            if BytesRead > 0 then
            begin
                                  //   finish   buffer   to   PChar
              Buffer[BytesRead] := #0;
                                  //   combine   the   buffer   with   the   rest   of   the   last   run
              Line := Line + Buffer;
            end;
          until not WasOK or (BytesRead = 0);
                          //   wait   for   console   app   to   finish   (should   be   already   at   this   point)
          WaitForSingleObject(PI.hProcess, INFINITE);
        finally
                          //   Close   all   remaining   handles
          CloseHandle(PI.hThread);
          CloseHandle(PI.hProcess);
        end;
      finally
        result := Line;
        CloseHandle(StdOutPipeRead);
      end;
    end;
    
    
    procedure TForm1.btn1Click(Sender: TObject);
    var
      hReadPipe, hWritePipe: THandle;
      si: STARTUPINFO;
      lsa: SECURITY_ATTRIBUTES;
      pi: PROCESS_INFORMATION;
      cchReadBuffer: DWORD;
      ph: PChar;
      fname: PChar;
    begin
      fname := allocmem(255);
      ph := AllocMem(5000);
      lsa.nLength := sizeof(SECURITY_ATTRIBUTES);
      lsa.lpSecurityDescriptor := nil;
      lsa.bInheritHandle := True;
    
      if CreatePipe(hReadPipe, hWritePipe, @lsa, 0) = false then
      begin
        ShowMessage('Can   not   create   pipe!');
        exit;
      end;
      fillchar(si, sizeof(STARTUPINFO), 0);
      si.cb := sizeof(STARTUPINFO);
      si.dwFlags := (STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW);
      si.wShowWindow := SW_SHOW;
      si.hStdOutput := hWritePipe;
      StrPCopy(fname, EdtFilename.text);
      if CreateProcess(nil, fname, nil, nil, true, 0, nil, nil, si, pi) = False then
      begin
        ShowMessage('can   not   create   process');
        FreeMem(ph);
        FreeMem(fname);
        Exit;
      end;
    
      while (true) do
      begin
        if not PeekNamedPipe(hReadPipe, ph, 1, @cchReadBuffer, nil, nil) then break;
        if cchReadBuffer <> 0 then
        begin
          if ReadFile(hReadPipe, ph^, 4096, cchReadBuffer, nil) = false then break;
          ph[cchReadbuffer] := chr(0);
          Mmo1.Lines.Add(ph);
        end
        else if (WaitForSingleObject(pi.hProcess, 0) = WAIT_OBJECT_0) then break;
        Sleep(100);
      end;
    
      ph[cchReadBuffer] := chr(0);
      Mmo1.Lines.Add(ph);
      CloseHandle(hReadPipe);
      CloseHandle(pi.hThread);
      CloseHandle(pi.hProcess);
      CloseHandle(hWritePipe);
      FreeMem(ph);
      FreeMem(fname);
    end;
  • 相关阅读:
    AcWing 286. 选课
    背包问题极小值空间至少是j
    Logo在线公式编辑转图片
    AcWing 1055. 股票买卖 II
    枚举一个集合的所有有效子集
    CF580D Kefa and Dishes [洛谷]
    AcWing 1282. 搜索关键词
    背包问题最大值空间恰好是j
    多叉树转二叉树有依赖的背包问题解法
    Thinkpad T14重装Win10后不见无线网络问题的解决
  • 原文地址:https://www.cnblogs.com/china1/p/3395159.html
Copyright © 2020-2023  润新知