procedure Dos2Win(CmdLine:String; OutMemo:TMemo);

const BUFSIZE = 2000;

var SecAttr : TSecurityAttributes;

  hReadPipe,

  hWritePipe : THandle;

  StartupInfo: TStartUpInfo;

  ProcessInfo: TProcessInformation;

  Buffer : Pchar;

  WaitReason,

  BytesRead : DWord;

begin

 with SecAttr do

 begin

  nlength := SizeOf(TSecurityAttributes);

  binherithandle := true;

  lpsecuritydescriptor := nil;

 end;

 // Creazione della pipe

 if Createpipe (hReadPipe, hWritePipe, @SecAttr, 0) then

 begin

  Buffer := AllocMem(BUFSIZE + 1); // Allochiamo un buffer di dimensioni BUFSIZE+1

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

  StartupInfo.cb := SizeOf(StartupInfo);

  StartupInfo.hStdOutput := hWritePipe;

  StartupInfo.hStdInput := hReadPipe;

  StartupInfo.dwFlags := STARTF_USESTDHANDLES +

  STARTF_USESHOWWINDOW;

  StartupInfo.wShowWindow := SW_HIDE;

  if CreateProcess(nil,

  PChar(CmdLine),

  @SecAttr,

  @SecAttr,

  true,

  NORMAL_PRIORITY_CLASS,

  nil,

  nil,

  StartupInfo,

  ProcessInfo) then

  begin

  // Attendiamo la fine dell'esecuzione del processo

  repeat

  WaitReason := WaitForSingleObject( ProcessInfo.hProcess,100);

  Application.ProcessMessages;

  until (WaitReason <> WAIT_TIMEOUT);

  // Leggiamo la pipe

  Repeat

  BytesRead := 0;

  // Leggiamo "BUFSIZE" bytes dalla pipe

  ReadFile(hReadPipe, Buffer[0], BUFSIZE, BytesRead, nil);

  // Convertiamo in una stringa "\0 terminated"

  Buffer[BytesRead]:= #0;

  // Convertiamo i caratteri da DOS ad ANSI

  OemToAnsi(Buffer,Buffer);

  // Scriviamo nell' "OutMemo" l'output ricevuto tramite pipe

  OutMemo.Text := OutMemo.text + String(Buffer);

  until (BytesRead < BUFSIZE);

  end;

  FreeMem(Buffer);

  CloseHandle(ProcessInfo.hProcess);

  CloseHandle(ProcessInfo.hThread);

  CloseHandle(hReadPipe);

  CloseHandle(hWritePipe);

 end;

end;

procedure RunDosInMemo(CmdLine:String;AMemo:TMemo);

 const

  ReadBuffer = 2400;

 var

 Security : TSecurityAttributes;

 ReadPipe,WritePipe : THandle;

 start : TStartUpInfo;

 ProcessInfo : TProcessInformation;

 Buffer : Pchar;

 BytesRead : DWord;

 Apprunning : DWord;

 begin

 Screen.Cursor:=CrHourGlass;

 Form1.Button1.Enabled:=False;

 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(CmdLine),

  @Security,

  @Security,

  true,

  NORMAL_PRIORITY_CLASS,

  nil,

  nil,

  start,

  ProcessInfo)

 then

 begin

  repeat

  Apprunning := WaitForSingleObject

  (ProcessInfo.hProcess,100);

  ReadFile(ReadPipe,Buffer[0],

  ReadBuffer,BytesRead,nil);

  Buffer[BytesRead]:= #0;

  OemToAnsi(Buffer,Buffer);

  AMemo.Text := AMemo.text + String(Buffer);

  Application.ProcessMessages;

  until (Apprunning <> WAIT_TIMEOUT);

 end;

 FreeMem(Buffer);

 CloseHandle(ProcessInfo.hProcess);

 CloseHandle(ProcessInfo.hThread);

 CloseHandle(ReadPipe);

 CloseHandle(WritePipe);

 end;

 Screen.Cursor:=CrDefault;

 Form1.Button1.Enabled:=True;

 end;

procedure TForm1.Button1Click(Sender: TObject);

begin

 Memo1.Clear;

 RunDosInMemo('ping -t 192.168.28.200',Memo1);

end;

function ExecuteFile(FileName,StdInput: string;

  TimeOut: integer;

  var StdOutput:string) : boolean;

label Error;

type

 TPipeHandles = (IN_WRITE, IN_READ,

  OUT_WRITE, OUT_READ,

  ERR_WRITE, ERR_READ);

type

 TPipeArray = array [TPipeHandles] of THandle;

var

 i : integer;

 ph : TPipeHandles;

 sa : TSecurityAttributes;

 Pipes : TPipeArray;

 StartInf : TStartupInfo;

 ProcInf : TProcessInformation;

 Buf : array[0..1024] of byte;

 TimeStart : TDateTime;



function ReadOutput : string;

var

 i : integer;

 s : string;

 BytesRead : longint;

begin

 Result := '';

 repeat

  Buf[0]:=26;

  WriteFile(Pipes[OUT_WRITE],Buf,1,BytesRead,nil);

  if ReadFile(Pipes[OUT_READ],Buf,1024,BytesRead,nil) then

  begin

  if BytesRead>0 then

  begin

  buf[BytesRead]:=0;

  s := StrPas(@Buf[0]);

  i := Pos(#26,s);

  if i>0 then s := copy(s,1,i-1);

  Result := Result + s;

  end;

  end;

  if BytesRead1024 then break;

 until false;

end;



begin

 Result := false;

 for ph := Low(TPipeHandles) to High(TPipeHandles) do

  Pipes[ph] := INVALID_HANDLE_VALUE;



 // Создаем пайпы

 sa.nLength := sizeof(sa);

 sa.bInheritHandle := TRUE;

 sa.lpSecurityDescriptor := nil;



 if not CreatePipe(Pipes[IN_READ],Pipes[IN_WRITE], @sa, 0 ) then

  goto Error;

 if not CreatePipe(Pipes[OUT_READ],Pipes[OUT_WRITE], @sa, 0 ) then

  goto Error;

 if not CreatePipe(Pipes[ERR_READ],Pipes[ERR_WRITE], @sa, 0 ) then

  goto Error;



 // Пишем StdIn

 StrPCopy(@Buf[0],stdInput+^Z);

 WriteFile(Pipes[IN_WRITE],Buf,Length(stdInput),i,nil);



 // Хендл записи в StdIn надо закрыть - иначе выполняемая программа

 // может не прочитать или прочитать не весь StdIn.

 CloseHandle(Pipes[IN_WRITE]);

 Pipes[IN_WRITE] := INVALID_HANDLE_VALUE;



 FillChar(StartInf,sizeof(TStartupInfo),0);

 StartInf.cb := sizeof(TStartupInfo);

 StartInf.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;



 StartInf.wShowWindow := SW_SHOW; // SW_HIDE если надо запустить невидимо



 StartInf.hStdInput := Pipes[IN_READ];

 StartInf.hStdOutput := Pipes[OUT_WRITE];

 StartInf.hStdError := Pipes[ERR_WRITE];



 if not CreateProcess(nil, PChar(FileName), nil,

  nil, True, NORMAL_PRIORITY_CLASS,

  nil, nil, StartInf, ProcInf) then goto Error;

 TimeStart := Now;

 repeat

  Application.ProcessMessages;

  i := WaitForSingleObject(ProcInf.hProcess,100);

  if i = WAIT_OBJECT_0 then break;

  if (Now-TimeStart)*SecsPerDay>TimeOut then break;

 until false;



 if iWAIT_OBJECT_0 then goto Error;

 StdOutput := ReadOutput;

 for ph := Low(TPipeHandles) to High(TPipeHandles) do

  if Pipes[ph]INVALID_HANDLE_VALUE then

  CloseHandle(Pipes[ph]);



 CloseHandle(ProcInf.hProcess);

 CloseHandle(ProcInf.hThread);

 Result := true;

 Exit;



Error:

 if ProcInf.hProcessINVALID_HANDLE_VALUE then

 begin

  CloseHandle(ProcInf.hThread);

  i := WaitForSingleObject(ProcInf.hProcess, 1000);

  CloseHandle(ProcInf.hProcess);

  if iWAIT_OBJECT_0 then

  begin

  ProcInf.hProcess := OpenProcess(PROCESS_TERMINATE,

  FALSE,

  ProcInf.dwProcessId);

  if ProcInf.hProcess 0 then

  begin

  TerminateProcess(ProcInf.hProcess, 0);

  CloseHandle(ProcInf.hProcess);

  end;

  end;

 end;

 for ph := Low(TPipeHandles) to High(TPipeHandles) do

  if Pipes[ph]INVALID_HANDLE_VALUE then

  CloseHandle(Pipes[ph]);

end;