Vorstellung und Frage

[hathor]

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,  ShellAPI, ComCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button2: TButton;
    Panel1: TPanel;
    Edit1: TEdit;
    Label13: TLabel;
    Button1: TButton;
    Label15: TLabel;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);

  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
begin Application.terminate; end;

function GetConsoleOutput(Command: string; Output, Errors: TStrings): Boolean;
var
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  SecurityAttr: TSecurityAttributes;
  PipeOutputRead: THandle;
  PipeOutputWrite: THandle;
  PipeErrorsRead: THandle;
  PipeErrorsWrite: THandle;
  Succeed: Boolean;
  Buffer: array [0 .. 255] of Char;
  NumberOfBytesRead: DWORD;
  Stream: TMemoryStream;
begin
  // Initialisierung ProcessInfo
  FillChar(ProcessInfo, SizeOf(TProcessInformation), 0);

  // Initialisierung SecurityAttr
  FillChar(SecurityAttr, SizeOf(TSecurityAttributes), 0);
  SecurityAttr.nLength := SizeOf(SecurityAttr);
  SecurityAttr.bInheritHandle := true;
  SecurityAttr.lpSecurityDescriptor := nil;

  // Pipes erzeugen
  CreatePipe(PipeOutputRead, PipeOutputWrite, @SecurityAttr, 0);
  CreatePipe(PipeErrorsRead, PipeErrorsWrite, @SecurityAttr, 0);

  // Initialisierung StartupInfo
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  StartupInfo.cb := SizeOf(StartupInfo);
  StartupInfo.hStdInput := 0;
  StartupInfo.hStdOutput := PipeOutputWrite;
  StartupInfo.hStdError := PipeErrorsWrite;
  StartupInfo.wShowWindow := sw_Hide;
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;

  UniqueString(Command);
  if CreateProcess(nil, PChar(Command), nil, nil, true,
    CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
    nil, nil, StartupInfo, ProcessInfo) then
    begin
      result := true;
      // Write-Pipes schließen
      CloseHandle(PipeOutputWrite);
      CloseHandle(PipeErrorsWrite);

      if Assigned(Output) then
        begin
          // Ausgabe Read-Pipe auslesen
          Stream := TMemoryStream.Create;
          try
            while true do
              begin
                Succeed := ReadFile(PipeOutputRead, Buffer, 255,
                  NumberOfBytesRead, nil);
                if not Succeed then
                  break;
                Stream.Write(Buffer, NumberOfBytesRead);
              end;
            Stream.Position := 0;
            Output.LoadFromStream(Stream);
          finally
            Stream.Free;
          end;
        end;
      CloseHandle(PipeOutputRead);

      if Assigned(Errors) then
        begin
          // Fehler Read-Pipe auslesen
          Stream := TMemoryStream.Create;
          try
            while true do
              begin
                Succeed := ReadFile(PipeErrorsRead, Buffer, 255,
                  NumberOfBytesRead, nil);
                if not Succeed then
                  break;
                Stream.Write(Buffer, NumberOfBytesRead);
              end;
            Stream.Position := 0;
            Errors.LoadFromStream(Stream);
          finally
            Stream.Free;
          end;
        end;
      CloseHandle(PipeErrorsRead);

      WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
      CloseHandle(ProcessInfo.hProcess);
    end
  else
    begin
      result := false;
      CloseHandle(PipeOutputRead);
      CloseHandle(PipeOutputWrite);
      CloseHandle(PipeErrorsRead);
      CloseHandle(PipeErrorsWrite);
    end;
end;
//C:\Windows\System32\
function GetSystemDir: string;
var Dir: string; Len: DWord;
begin
  SetLength(Dir,MAX_PATH);
  Len:=GetSystemDirectory(PChar(Dir),MAX_PATH);
  if Len>0 then begin SetLength(Dir,Len); Result:=Dir; end
  else RaiseLastOSError;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  Output : TStringList;
  Errors : TStringList;
  p : ANSIString;
begin
p:=ExtractFilePath(Application.ExeName);
Memo1.clear;
  Output := TStringList.Create;
  Errors := TStringList.Create;
  try
if GetConsoleOutput(GetSystemDir +'\ping.exe '+Edit1.text, Output, Errors) then
      Memo1.Lines.AddStrings(Output);
  finally
    Output.free;
    Errors.free;
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
 Button2.Click;
end;

end.