[zxen]

Нарыл и приспособил немножко другой код.. Есть небольшая проблемка, когда программа запускает например пинг. ехе, во время обработки пргрпмму невозжожно закрыть крестиком, вставил паузу (стр. 116) программа не виснет , но крестик все равно не нажимается. И как можно закрывать порограммы, запущенные CreateProcess'om.. тасккил по имени как то тупо.. И еще, как бы сделать так, чтоб текст вывода консоли добавлялся к уже существующему в мемо, а не стирался с каждым новым выводом. Memo1.Text:= Memo1.Text + DosToWin(getcmdval) не работает, выполняется первая команда, дальше вообще ничего в мемо не пишется.

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Winapi.ShellAPI;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);

  private
       function GetDosOutput(const CommandLine:string): string;
  public


  end;

var
  Form1: TForm1;


implementation

{$R *.dfm}

var stopfunc: Integer;

function DosToWin(ASource: AnsiString): AnsiString;
 var
   Ch: PAnsiChar;
 begin
   Ch := AnsiStrAlloc(Length(ASource) + 1);
   OemToAnsi(PAnsiChar(ASource), Ch);
   Result := StrPas(Ch);
   StrDispose(Ch);
 end;


function TForm1.GetDosOutput(const CommandLine:string): string;
var
  SA: TSecurityAttributes;
  SI: TStartupInfoA;
  PI: TProcessInformation;
  StdOutPipeRead, StdOutPipeWrite: THandle;
  WasOK: Boolean;
  Buffer: array[0..255] of AnsiChar;
  BytesRead: Cardinal;
  WorkDir, Line: String;
  i:Integer;
begin
stopfunc:=0;
  Application.ProcessMessages;
  with SA do
  begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;

  CreatePipe(StdOutPipeRead,
             StdOutPipeWrite,
             @SA,
             0
             );
  try

    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:=CreateProcessa(nil, PAnsiChar(AnsiString(CommandLine)), nil, nil, True, 0, nil, PAnsiChar('C:\WINDOWS\system32\'), SI, PI);
    //WasOK := CreateProcess(nil, PChar('C:\WINDOWS\system32\cmd.exe'), nil, nil, True, 0, nil, PChar(WorkDir), SI, PI);

    CloseHandle(StdOutPipeWrite);

    if not WasOK then
      raise Exception.Create('Could not execute command line!')
    else
      try

        Line := '';
        repeat

          WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
          if BytesRead > 0 then

          begin

            Buffer[BytesRead] := #0;
            Line := Line + Buffer;
            if (Copy(Form1.Edit1.text,1,4) = 'ping') then begin 

             Form1.Memo1.text := DosToWin(Line); // конвертим вывод в мемо, с ОЕМ в Анси
              Memo1.Perform(EM_LINESCROLL,0,Memo1.Lines.Count-1); // автопрокрутка мемо вниз
               //////////////////////////  пауза, чтоб не висло окно при пинге и множественных выводов консоли

              i := 0;
               while i<100 do begin
              sleep(12);
              Application.ProcessMessages;
              inc(i);
              end;
                //// убиваем процессы
              if stopfunc = 1 then
               begin
               CloseHandle(PI.hThread);
               CloseHandle(PI.hProcess);
               shellexecute(0,'Open',Pchar('taskkill'),'/im cmd.exe /f',0,SW_HIDE);
               shellexecute(0,'Open',Pchar('taskkill'),'/im ping.exe /f',0,SW_HIDE);
              Exit;
             end;
            end;


          end;
        until not WasOK or (BytesRead = 0);
        WaitForSingleObject(PI.hProcess, INFINITE);
      finally
        CloseHandle(PI.hThread);
        CloseHandle(PI.hProcess);
      end;
  finally
      result:=Line;
      CloseHandle(StdOutPipeRead);
  end;
end;
  //// выполняем команду CMD
procedure TForm1.Button1Click(Sender: TObject);
 var cmdinput, getcmdval, memotxt: string;

begin

   Edit1.Text:= Trim(Edit1.Text); // удаляем пробелы в начале и в конце в строке ввода
   cmdinput:= 'cmd.exe /c ' + Edit1.Text; // текст посылаемый в функцию

    memotxt:= Memo1.Text;
    getcmdval:= GetDosOutput(cmdinput);


    Memo1.Text:=  DosToWin(getcmdval);
end;
      /// останавливаем выполнение CMD
procedure TForm1.Button2Click(Sender: TObject);
begin
stopfunc:=1;
end;

end.