1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:

procedure TForm1.DosCommand1NewLine(Sender: TObject; NewLine: String;
  OutputType: TOutputType);
begin
  DosCommand1.OutputLines := Memo1.Lines;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  DosCommand1.CommandLine := 'ping google.de';
  DosCommand1.Execute;
end;					

1:
2:
3:
4:
5:

procedure TForm1.DosCommand1NewLine(Sender: TObject; NewLine: String; 
  OutputType: TOutputType); 
begin 
  DosCommand1.OutputLines := OemToChar(Memo1.Lines); 
end;					

1:

  RunConsoleApp(Pfad + '\upx.exe ' + Para, Memo1.Lines);					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:

procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
  Liste: TStringList;
begin
  Liste := TStringList.Create;
  RunConsoleApp('ping google.de', Liste);
  I := Liste.Count - 1;
  while I > -1 do
  begin
    if Pos('Antwort', Liste.Strings[I]) > 0 then
      Liste.Delete(I + 1);
    Dec(I);
  end;
  for I := 0 to Liste.Count - 1 do
  begin
    OemToCharBuff(Pointer(Liste.Strings[I]), Pointer(Liste.Strings[I]), Length(Liste.Strings[I]));;
    Memo1.Lines.Add(Liste.Strings[I]);
  end;
  FreeAndNil(Liste);
  Memo1.Lines.SaveToFile('Ping.txt');
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:

function RunConsoleApp(const FileName: string; const Parent: THandle): THandle;

  function EnumWindowsProc(hWnd: HWND; lParam: LPARAM): BOOL; stdcall;
  begin
    TList(lParam).Add(Pointer(hWnd));
    Result := True;
  end;

var
  SI: TStartupInfo;
  PI: TProcessInformation;
  List: TList;
  ProcessId: DWORD;
  Console: THandle;
  I: Integer;
begin
  Result:= 0;
  FillChar(SI, SizeOf(TStartupInfo), 0);
  SI.cb := SizeOf(TStartupInfo);
  SI.dwFlags := STARTF_USESHOWWINDOW;
  SI.wShowWindow := SW_HIDE;
  if CreateProcess(nil, PChar(FileName), nil, nil, False, 0, nil, nil, SI, PI) then
  try
    Console:= 0;
    List:= TList.Create;
    try
      repeat
        List.Clear;
        if EnumWindows(@EnumWindowsProc, Longint(List)) then
        begin
          for I := 0 to List.Count - 1 do
          begin
            GetWindowThreadProcessId(Longint(List.Items[I]), ProcessId);
            if PI.dwProcessId = ProcessId then
            begin
              Console:= Longint(List.Items[I]);
              Break;
            end;
          end;
        end;
      until Console <> 0;
    finally
      List.Free; 
    end;
  finally
    CloseHandle(PI.hProcess);
    CloseHandle(PI.hThread);
  end;
  if Console <> 0 then
  begin
    SetParent(Console, Parent);
    SetWindowPos(Console, 0, 0, 0, 0, 0, SWP_NOSIZE or SWP_SHOWWINDOW);
    Result:= Console;
  end;
end;					

1:
2:
3:
4:

procedure TForm1.Button1Click(Sender: TObject);
begin
  RunConsoleApp('ping google.de', Memo1.Lines);
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:

procedure RunConsoleApp(const CommandLine: string; AStrings: TStrings);
type
  TCharBuffer = array[0..MaxInt - 1] of Char;
const
  MaxBufSize = 1024;
var
  I: Longword;
  SI: TStartupInfo;
  PI: TProcessInformation;
  SA: PSecurityAttributes;
  SD: PSECURITY_DESCRIPTOR;
  NewStdIn: THandle;
  NewStdOut: THandle;
  ReadStdOut: THandle;
  WriteStdIn: THandle;
  Buffer: ^TCharBuffer;
  BufferSize: Cardinal;
  Last: WideString;
  Str: WideString;
  ExitCode: DWORD;
  Bread: DWORD;
  Avail: DWORD;
begin
  GetMem(SA, SizeOf(TSecurityAttributes));
  case Win32Platform of
    VER_PLATFORM_WIN32_NT:
      begin
        GetMem(SD, SizeOf(SECURITY_DESCRIPTOR));
        SysUtils.Win32Check(InitializeSecurityDescriptor(SD, SECURITY_DESCRIPTOR_REVISION));
        SysUtils.Win32Check(SetSecurityDescriptorDacl(SD, True, nil, False));
        SA.lpSecurityDescriptor := SD;
      end; {end VER_PLATFORM_WIN32_NT}
  else
    SA.lpSecurityDescriptor := nil;
  end; {end case}
  SA.nLength := SizeOf(SECURITY_ATTRIBUTES);
  SA.bInheritHandle := True;
  SysUtils.Win32Check(CreatePipe(NewStdIn, WriteStdIn, SA, 0));
  if not CreatePipe(ReadStdOut, NewStdOut, SA, 0) then
  begin
    CloseHandle(NewStdIn);
    CloseHandle(WriteStdIn);
    SysUtils.RaiseLastWin32Error;
  end; {end if}
  GetStartupInfo(SI);
  SI.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  SI.wShowWindow := {SW_SHOWNORMAL} SW_HIDE;
  SI.hStdOutput := NewStdOut;
  SI.hStdError := NewStdOut;
  SI.hStdInput := NewStdIn;
  if not CreateProcess(nil, PChar(CommandLine), nil, nil, True,
    CREATE_NEW_CONSOLE, nil, nil, SI, PI) then
  begin
    CloseHandle(NewStdIn);
    CloseHandle(NewStdOut);
    CloseHandle(ReadStdOut);
    CloseHandle(WriteStdIn);
    SysUtils.RaiseLastWin32Error;
  end; {end if}
  Last := '';
  BufferSize := MaxBufSize;
  Buffer := AllocMem(BufferSize);
  try
    repeat
      SysUtils.Win32Check(GetExitCodeProcess(PI.hProcess, ExitCode));
      PeekNamedPipe(ReadStdOut, Buffer, BufferSize, @Bread, @Avail, nil);
      if (Bread <> 0) then
      begin
        if (BufferSize < Avail) then
        begin
          BufferSize := Avail;
          ReallocMem(Buffer, BufferSize);
        end; {end if}
        FillChar(Buffer^, BufferSize, #0);
        ReadFile(ReadStdOut, Buffer^, BufferSize, Bread, nil);
        Str := Last;
        I := 0;
        while (I < Bread) do
        begin
          case Buffer^[I] of
            #0: inc(I);
            #10:
              begin
                inc(I);
                AStrings.Add(Str);
                Str := '';
              end; {end #10}
            #13:
              begin
                inc(I);
                if (I < Bread) and (Buffer^[I] = #10) then
                  inc(I);
                AStrings.Add(Str);
                Str := '';
              end; {end #13}
          else
            begin
              Str := Str + Buffer^[I];
              inc(I);
            end; {end else}
          end; {end case}
        end; {end while}
        Last := Str;
      end; {end if}
      Sleep(1);
      Application.ProcessMessages;
    until (ExitCode <> STILL_ACTIVE);
    if Last <> '' then
      AStrings.Add(Last);
  finally
    FreeMem(Buffer);
  end; {end try/finally}
  CloseHandle(PI.hThread);
  CloseHandle(PI.hProcess);
  CloseHandle(NewStdIn);
  CloseHandle(NewStdOut);
  CloseHandle(ReadStdOut);
  CloseHandle(WriteStdIn);
end; {end procedure}					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:

var
  Form46: TForm46;
  AcceptLine: Boolean;

implementation

{$R *.dfm}

procedure TForm46.btnStartClick(Sender: TObject);
begin
  AcceptLine := True;
  memOutput.Lines.Clear;
  DosCommand1.CommandLine := edtCommandLine.Text;
  DosCommand1.Execute;
end;

procedure TForm46.DosCommand1NewLine(Sender: TObject; NewLine: string;
  OutputType: TOutputType);
begin
  if AcceptLine then
  begin
    if NewLine <> '' then
      OemToChar(PChar(NewLine), PChar(NewLine));
    memOutput.Lines.Add(NewLine);
  end;
  AcceptLine := not AcceptLine;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:

procedure TForm1.Button1Click(Sender: TObject);
begin
  AcceptLine := True;
  Memo1.Lines.Clear;
  DosCommand1.CommandLine := 'ping google.de';
  DosCommand1.Execute;
end;

procedure TForm1.DosCommand1NewLine(Sender: TObject; NewLine: String;
  OutputType: TOutputType);
begin
  if AcceptLine then
  begin
    if NewLine <> '' then
      OemToChar(PChar(NewLine), PChar(NewLine));
      Memo1.Lines.Add(NewLine);
  end;
  AcceptLine := not AcceptLine;
end;					

1:
2:

  while DosCommand1.Active do
    Application.ProcessMessages;					

1:
2:
3:
4:
5:
6:
7:
8:

procedure TForm1.Button1Click(Sender: TObject);
begin
  AcceptLine := True;
  Memo1.Lines.Clear;
  DosCommand1.CommandLine := 'diskpart';
  DosCommand1.Execute;
  DosCommand1.Sendline('select disk 0', True);
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:

procedure TForm1.Button1Click(Sender: TObject);
begin
  AcceptLine := True;
  Memo1.Lines.Clear;
  DosCommand1.CommandLine := 'diskpart';
  DosCommand1.Execute;
  DosCommand1.Sendline('select disk 0', True);
  DosCommand1.SendLine('', True);
end;