Function GetDosOutput( const CommandLine, WorkDir: String;

                      var ResultCode: Cardinal ): String;

var StdOutPipeRead, StdOutPipeWrite: THandle;

   SA                             : TSecurityAttributes;

   SI                             : TStartupInfo;

   PI                             : TProcessInformation;

   WasOK                          : Boolean;

   Buffer                         : array[0..255] of Char;

   BytesRead                      : Cardinal;

   Line                           : String;

   Application.ProcessMessages;

   With SA do

   Begin

      nLength := SizeOf( SA );

      bInheritHandle := True;

      lpSecurityDescriptor := nil;

   end;

   // создаём пайп для перенаправления стандартного вывода

   CreatePipe( StdOutPipeRead,  // дескриптор чтения

               StdOutPipeWrite, // дескриптор записи

               @SA,              // аттрибуты безопасности

               0                // количество байт принятых для пайпа - 0 по умолчанию

              );

   try

    // Создаём дочерний процесс, используя StdOutPipeWrite в качестве стандартного вывода,

    // а так же проверяем, чтобы он не показывался на экране.

    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 ); // стандартный ввод не перенаправляем

       hStdOutput := StdOutPipeWrite;

       hStdError := StdOutPipeWrite;

    end;

 

    // Запускаем компилятор из командной строки

    //WorkDir := ExtractFilePath(CommandLine);

    WasOK := CreateProcess( nil,

                            PChar( CommandLine ),

                            nil,

                            nil,

                            True,

                            0,

                            nil,

                            PChar( WorkDir ),

                            SI,

                            PI );

    // Теперь, когда дескриптор получен, для безопасности закрываем запись.

    // Нам не нужно, чтобы произошло случайное чтение или запись.

    CloseHandle( StdOutPipeWrite );

    // если процесс может быть создан, то дескриптор, это его вывод

    if not WasOK then

     raise Exception.Create( 'Ошибка выполнения или компиляции: ' +

            Chr( 10 ) + Chr( 13 ) + CommandLine )

    else

      try

        // получаем весь вывод до тех пор, пока DOS-приложение не будет завершено

        Line := '';

        Repeat

           // читаем блок символов (могут содержать возвраты каретки и переводы строки)

           WasOK := ReadFile( StdOutPipeRead, Buffer, 255, BytesRead, nil );

           // есть ли что-нибудь ещё для чтения?

           if BytesRead > 0 then

           Begin

              // завершаем буфер PChar-ом

              Buffer[BytesRead] := #0;

              // добавляем буфер в общий вывод

              Line := Line + Buffer;

           end;

           Application.ProcessMessages;

        Until not WasOK or ( BytesRead = 0 );

        // ждём, пока завершится консольное приложение

        WaitForSingleObject( PI.hProcess, INFINITE );

        ResultCode := 0;

        GetExitCodeProcess( PI.hProcess, ResultCode );

      finally

        // Закрываем все оставшиеся дескрипторы

        CloseHandle( PI.hThread );

        CloseHandle( PI.hProcess );

      end;

   finally

     Result := Line;

     CloseHandle( StdOutPipeRead );

 end;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

var p,dp,s:string;

    F: TextFile;

    y:cardinal;

  GetDir(0, dp);

  s:='ping localhost';

  p:=dp+'\tmp.cmd'; AssignFile(F, p); ReWrite(F);

  WriteLn(F,s); CloseFile(F);

  Memo1.Text:=GetDosOutput(p,dp,y);

end;

 

 

 

procedure ExecuteCmd(DosApp:String);

    ReadBuffer = 2400;

  Security            : TSecurityAttributes;

  ReadPipe,WritePipe  : THandle;

  start               : TStartUpInfo;

  ProcessInfo         : TProcessInformation;

  Buffer              : PAnsiChar;

  BytesRead,Apprunning: DWord;

  p                   : string;

  F                   : TextFile;

  p:=dp+'\tmp.cmd'; AssignFile(F, p); ReWrite(F);

  WriteLn(F,DosApp); CloseFile(F);

  With Security do begin

    nlength              := SizeOf(TSecurityAttributes);

    binherithandle       := true;

    lpsecuritydescriptor := nil;

  end;

  if Createpipe (ReadPipe, WritePipe, @Security, 0)

  then begin

    Buffer  := AllocMem(ReadBuffer + 1);

    FillChar(Start,Sizeof(Start),#0);

    start.cb          := SizeOf(start);

    start.hStdOutput  := WritePipe;

    start.hStdInput   := ReadPipe;

    start.dwFlags     := STARTF_USESTDHANDLES +

                         STARTF_USESHOWWINDOW;

    start.wShowWindow := SW_HIDE;

 

    if CreateProcess(nil,

            PChar(P),

            @Security,

            @Security,

            true,

            NORMAL_PRIORITY_CLASS,

            nil,

            nil,

            start,

            ProcessInfo)

    then begin

      repeat

       Apprunning := WaitForSingleObject

                    (ProcessInfo.hProcess,100);

       Application.ProcessMessages;

      until (Apprunning <> WAIT_TIMEOUT);

      Repeat

        BytesRead := 0;

        ReadFile(ReadPipe,Buffer[0],

                ReadBuffer,BytesRead,nil);

        Buffer[BytesRead]:= #0;

        OemToAnsi(PAnsiChar(Buffer),PAnsiChar(Buffer));

        fmMain.Memo.Text := fmMain.Memo.text + String(Buffer);

      until (BytesRead < ReadBuffer);

    end;

    FreeMem(Buffer);

    CloseHandle(ProcessInfo.hProcess);

    CloseHandle(ProcessInfo.hThread);

    CloseHandle(ReadPipe);

    CloseHandle(WritePipe);

  end;

  DeleteFile(P);

end;