unit CommandLineUnit;

interface

uses
  SysUtils, Windows, Classes, Forms;


type
  TCommandLineUnit = class
  private
    FLoopProcessMessages: Boolean;
    function GrabStdOut(CommandLine: string;
      StdIn: TMemoryStream): TMemoryStream;
  public
    constructor Create;
    function GetStringFromStream(Stream: TStream): String;
    function GrabStdOutText(CommandLine: string): String;
    property LoopProcessMessages: Boolean read FLoopProcessMessages write FLoopProcessMessages;
  end;

  TSysCharSet = set of Char;

  TDekoCommandLine = class
  private
    function CmdLineSwitchPos(const Switch: string;
     SwitchChars: TSysCharSet; IgnoreCase: Boolean): Integer;
  end;

implementation

//Autch.net
//http://hp.vector.co.jp/authors/VA026252/tips/delphi_anonymous_pipe.html
function TCommandLineUnit.GrabStdOut(CommandLine: string; StdIn: TMemoryStream): TMemoryStream;
var
  hReadPipe, hWritePipe: THandle;
  hStdInReadPipe, hStdInWritePipe, hStdInWritePipeDup: THandle;
  hErrReadPipe, hErrWritePipe: THandle;
  sa: TSecurityAttributes;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  bufStdOut, bufErrOut, bufStdIn: array[0..8192] of Byte;
  dwStdOut, dwErrOut, dwRet: DWord;
  StreamBufferSize, nWritten: DWord;
begin
  Result := nil;

  with sa do
  begin
    nLength := sizeof(TSecurityAttributes);
    lpSecurityDescriptor := nil;
    bInheritHandle := true;
  end;

  hReadPipe := 0; hWritePipe := 0;
  hErrReadPipe := 0; hErrWritePipe := 0;

  StdIn.Position := 0;

  CreatePipe(hStdInReadPipe, hStdInWritePipe, @sa, 8192);
  DuplicateHandle(GetCurrentProcess(), hStdInWritePipe, GetCurrentProcess(),
                  @hStdInWritePipeDup, 0, false, DUPLICATE_SAME_ACCESS);
  CloseHandle(hStdInWritePipe);

  CreatePipe(hReadPipe, hWritePipe, @sa, 8192);
  try
    CreatePipe(hErrReadPipe, hErrWritePipe, @sa, 8192);
    try
      ZeroMemory(@StartupInfo, sizeof(TStartupInfo));
      with StartupInfo do
      begin
        cb := sizeof(TStartupInfo);
        dwFlags := STARTF_USESTDHANDLES;
        // これがないと DOS 窓が表示されてしまう
        wShowWindow := SW_HIDE;
        // 標準 IO にパイプの端っこを指定してやる
        hStdInput := hStdInReadPipe;
        hStdOutput := hWritePipe;
        hStdError  := hErrWritePipe;
      end;

      // コンソールアプリ起動
      if CreateProcess(nil, PChar(CommandLine), @sa, nil, true, DETACHED_PROCESS,
                      nil, nil, StartupInfo, ProcessInfo) = true then
      begin
        // 入力待ちになるまで待ってから，
        WaitForInputIdle(ProcessInfo.hProcess, 1000);
        StreamBufferSize := 8192;
        while StreamBufferSize = 8192 do
        begin
          // 入力を与える
          StreamBufferSize := StdIn.Read(bufStdIn, 8192);
          WriteFile(hStdInWritePipeDup, bufStdIn, StreamBufferSize, nWritten, nil);
        end;
        // 入力を与え終わった
        CloseHandle(hStdInWritePipeDup);

        Result := TMemoryStream.Create;
        Result.Clear;
        try
          repeat
            if FLoopProcessMessages then
            begin
              Application.ProcessMessages;
              Sleep(50);
            end;

            // 標準出力パイプの内容を調べる
            PeekNamedPipe(hReadPipe, nil, 0, nil, @dwStdOut, nil);
            if (dwStdOut > 0) then
            begin
              // 内容が存在すれば、読み取る
              ReadFile(hReadPipe, bufStdOut, Length(bufStdOut) - 1, dwStdOut, nil);
              Result.Write(bufStdOut, dwStdOut);
            end;

            // 同様にエラー出力の処理
            PeekNamedPipe(hErrReadPipe, nil, 0, nil, @dwErrOut, nil);
            if (dwErrOut > 0) then
            begin
              ReadFile(hErrReadPipe, bufErrOut, Length(bufErrOut) - 1, dwErrOut, nil);
              // このデータは使わない（バッファから吐くだけ）
              // このデータが必要であれば，StdOut の例にならってコードを追加せよ
            end;

            dwRet := WaitForSingleObject(ProcessInfo.hProcess, 0);
          until (dwRet = WAIT_OBJECT_0);        // コンソールアプリのプロセスが存在している間
        finally
          CloseHandle(ProcessInfo.hProcess);
          CloseHandle(ProcessInfo.hThread);
          CloseHandle(hStdInReadPipe);
        end;
      end;
    finally
      CloseHandle(hErrReadPipe);
      CloseHandle(hErrWritePipe);
    end;
  finally
    CloseHandle(hReadPipe);
    CloseHandle(hWritePipe);
  end;
end;

constructor TCommandLineUnit.Create;
begin
  FLoopProcessMessages := False;
end;

function TCommandLineUnit.GetStringFromStream(Stream: TStream): String;
begin
  SetLength(Result, Stream.Size);
  Stream.Position := 0;

  Stream.ReadBuffer(Result[1], Stream.Size);
end;

function TCommandLineUnit.GrabStdOutText(CommandLine: string): String;
var
  msin, msout: TMemoryStream;
begin
  msin := TMemoryStream.Create; try
//  msout := TMemoryStream.Create; try
  msout := GrabStdOut(CommandLine, msin);

  if msout <> nil then
    Result := GetStringFromStream(msout);

  FreeAndNil(msout);
  finally FreeAndNil(msin) end;
end;

{ TDekoCommandLine }

function TDekoCommandLine.CmdLineSwitchPos(const Switch: string;
  SwitchChars: TSysCharSet; IgnoreCase: Boolean): Integer;
var   I: Integer;
  S: string;
begin
  for I := 1 to ParamCount do
  begin
    S := ParamStr(I);
    if (SwitchChars = []) or (S[1] in SwitchChars) then        if IgnoreCase then          begin            if (AnsiCompareText(Copy(S, 2, Length(Switch)), Switch) = 0) then
              begin
                Result := I;
                Exit;
              end;
          end
        else
      begin
        if (AnsiCompareStr(Copy(S, 2, Length(Switch)), Switch) = 0) then          begin            Result := I;
            Exit;
          end;
      end;
    end;
  Result := -1;
end;


end.