타이핑이 귀찮아서 DLL로 만들어 둠.
2009에선 유니코드 호환때문에 짜증이 나서, 2006으로 제작함.

소스는 아래에...
리팩토링을 했으면 좋았을 껄.



library DosUtil;

uses
  Windows,
  SysUtils,
  Classes;

{$R *.res}

procedure D(s: String);
begin
  OutputDebugString(PChar(s));
end;

function GetDosOutput(cmd: PChar): PChar;
type
  TPipeHandles=record
    hRead, hWrite: DWORD;
  end;

const BUFFER_SIZE=$8000;

var
  ProcessInfo: TProcessInformation;
  StartupInfo: TStartupInfo;
  SecAttr: TSecurityAttributes;
  PipeStdOut: TPipeHandles;
  PipeStdErr: TPipeHandles;
  PipeStdIn: TPipeHandles;
  dwExitCode: DWORD;
  Command: array [0..1023] of Char;
  ReadBuf: array [0..BUFFER_SIZE] of Char;
  BytesRead: DWORD;
  TotalBytesRead: DWORD;

  procedure ClosePipe(var Pipe: TPipeHandles);
  begin
    with Pipe do begin
      if
hRead<>0 then CloseHandle(hRead);
      if hWrite<>0 then CloseHandle(hWrite);
      hRead:=0;
      hWrite:=0;
    end;
  end;

begin
  Result:='';

  TotalBytesRead:=0;

  SecAttr.nLength:=SizeOf(SecAttr);
  SecAttr.lpSecurityDescriptor:=nil;
  SecAttr.bInheritHandle:=True;

  // STDOUT 파이프 생성
  with PipeStdOut do
    if not
CreatePipe(hRead, hWrite, @SecAttr, BUFFER_SIZE) then D('Error - CreatePipe StdOut');

  // STDERR 파이프 생성
  try
    with
PipeStdErr do
      if not
CreatePipe(hRead, hWrite, @SecAttr, BUFFER_SIZE) then D('Error - CreatePipe StdErr');
  except
    ClosePipe(PipeStdOut);
    raise;
    Exit;
  end;

  // STDIN의 경우 사용하진 않더라도 필요로 하는 프로그램은 에러를 내면서 죽는 경우가 있으므로
  // plink.exe 같은 interactive 콘솔 프로그램이 특히 그러하다..

  try
    with
PipeStdIn do
      if not
CreatePipe(hRead, hWrite, @SecAttr, BUFFER_SIZE) then D('Error - CreatePipe StdIn');
  except
    ClosePipe(PipeStdOut);
    ClosePipe(PipeStdErr);
    raise;
    Exit;
  end;

  try
    FillChar(StartupInfo, SizeOf(StartupInfo), 0);
    with StartupInfo do begin
      cb:=SizeOf(StartupInfo);
      dwFlags:=STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      // 파이프 연결
      hStdOutput:=PipeStdOut.hWrite;
      hStdInput:=PipeStdIn.hRead;
      hStdError:=PipeStdOut.hWrite;
      wShowWindow:=SW_HIDE;
    end;

    // 도스명령어 실행
    ZeroMemory(@Command, 1024);
    StrCopy(@Command, PChar(cmd));
    if CreateProcess(nil, Command, @SecAttr, @SecAttr, True,
                     DETACHED_PROCESS or NORMAL_PRIORITY_CLASS,
                     nil, nil, StartupInfo, ProcessInfo
    ) then begin
      dwExitCode:=STILL_ACTIVE;
      try
        ZeroMemory(@ReadBuf, BUFFER_SIZE+1);
        repeat
          WaitForSingleObject(ProcessInfo.hProcess, INFINITE);
          GetExitCodeProcess(ProcessInfo.hProcess, dwExitCode);

          if not PeekNamedPipe(PipeStdOut.hRead, nil, 0, nil, @BytesRead, nil) then break
          else if
BytesRead>0 then ReadFile(PipeStdOut.hRead, ReadBuf[TotalBytesRead], BytesRead, BytesRead, nil);

          TotalBytesRead:=TotalBytesRead+BytesRead;
        until (dwExitCodE<>STILL_ACTIVE);

        Result:=ReadBuf;

        if not GetExitCodePRocess(ProcessInfo.hProcess, dwExitCode) then D('ExitCode를 읽어올 수 없습니다.');
        if dwExitCode<>0 then raise Exception.Create('ExitCode '+IntToStr(dwExitCodE));
      finally
        if
dwExitCode=STILL_ACTIVE then TerminateProcess(ProcessInfo.hProcess, 1);
        CloseHandle(ProcessInfo.hProcess);
        CloseHandle(ProcessInfo.hThread);
        ProcessInfo.hProcess:=0;
      end;
    end;
  finally
    ClosePipe(PipeStdOut);
    ClosePipe(PipeStdErr);
    ClosePipe(PipeStdIn);
  end;
end;

exports
  GetDosOutput;

begin
end
.




















'Delphi' 카테고리의 다른 글

랜덤 문자열 생성  (0) 2009.10.10
[Delphi] PuTTY의 마지막 라인 가져오기  (0) 2009.09.05
[Delphi] DLL 만들기  (0) 2009.09.05
[Delphi] IdHTTP + 아파치 인증  (0) 2009.08.31
[Delphi] TWebBrowser 스크롤바 없애기  (2) 2009.08.17
Posted by bloodguy
,