• 获取DOS命令的返回值.


    procedure CheckResult(b: Boolean);
    begin
      
    if not b then
        
    raise Exception.Create(SysErrorMessage(GetLastError));
    end;

    function RunDOS(const Prog, CommandLine, Dir: stringvar 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..255of 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
        
    0 //   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), nilnil, True, 0nil,
          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, nilnil, true, 0nilnil, 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, nilnilthen 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_0then 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;
  • 相关阅读:
    Tomcat 7.x 6.x 和 JDK 7 旧版本下载教程
    下载ios系统文件,使用UltraISO刻录系统(windows Server)光盘,安装操作系统
    MSDN, 我告诉你
    669. 修剪二叉搜索树
    99. 恢复二叉搜索树
    windows系统 python安装uwsgi教程
    mysql5.7修改密码命令
    客户端浏览器访问django服务器
    二、kafka的环境部署+命令行
    二十、SpringCloud Alibaba Seata处理分布式事务(一、基础)
  • 原文地址:https://www.cnblogs.com/jxgxy/p/1407644.html
Copyright © 2020-2023  润新知