Konsol (Dos - Console) uygulamaların Delphi tarafında çalıştırmak

Yazdığınız makaleleri ve üyelerimizin işine yarayacağını düşündüğünüz kodlarınızı gönderebilirsiniz. Bu foruma soru sormayın!
Cevapla
Kullanıcı avatarı
sabanakman
Kıdemli Üye
Mesajlar: 3077
Kayıt: 17 Nis 2006 08:11
Konum: Ah bi Antalya olaydı keşke (Ankara)

Konsol (Dos - Console) uygulamaların Delphi tarafında çalıştırmak

Mesaj gönderen sabanakman »

İyi günler. Uzunca zamandır elimde olan bir kütüphaneyi ancak forumda sorulan soru sonrası paylaşmayı akıl edebildim :mrgreen: (geç olsun güç olmasın :lol: ) . Bu bileşen dos tarafında bir komut veya toplu komut (.bat) dosyası çalıştırmakta ve ekrana akan mesajların delphi tarafında elde ederek kendi uygulamamız üzerinden ekrana yansıtmamızı sağlamaktadır. Bileşen ConsoleIO.pas dosyasında aşağıdaki şekilde tanımlıdır.
ConsoleIO .pas yazdı:

Kod: Tümünü seç

{$WARN UNSAFE_TYPE OFF}
{$WARN UNSAFE_CAST OFF}
{$WARN UNSAFE_CODE OFF}
unit ConsoleIO platform;

interface

uses Messages, Windows, SysUtils, Classes, Forms;

const
  MIO_OFFSET = $1911;
  MIO_RECEIVE_OUTPUT = WM_USER + MIO_OFFSET + 0;
  MIO_RECEIVE_ERROR = WM_USER + MIO_OFFSET + 1;
  MIO_ERROR = WM_USER + MIO_OFFSET + 2;
  MIO_PROCESS_TERMINATED = WM_USER + MIO_OFFSET + 3;

type
  TReceiveEvent = procedure(Sender: TObject; const Cmd: AnsiString) of object;
  TProcessStatusChangeEvent = procedure(Sender: TObject; IsRunning: Boolean) of object;
  TSplitMode = (smNone, sm0D0A, smSplitchar);

  TConsoleIO = class(TComponent)
  private
    FWindowHandle: HWND;
    InputReadPipe, InputWritePipe: THandle;
    OutputReadPipe, OutputWritePipe: THandle;
    ErrorReadPipe, ErrorWritePipe: THandle;
    FProcessHandle: THandle;
    FTerminateCommand: AnsiString;
    FEnableKill: Boolean;
    FWaitTimeout: Integer;
    FStopProcessOnFree: Boolean;
    FOnReceiveError: TReceiveEvent;
    FOnReceiveOutput: TReceiveEvent;
    FOnError: TReceiveEvent;
    FOnProcessStatusChange: TProcessStatusChangeEvent;
    FOutputBuffer: AnsiString;
    FSplitReceive: Boolean;
    FSplitSend: Boolean;
    FSplitChar: Char;
    FSplitMode: TSplitMode;
    function GetIsRunning: Boolean;
    procedure SetProcessHandle(const Value: THandle);
    procedure ReceiveOutput(Buf: Pointer; Size: Integer);
    procedure ReceiveError(Buf: Pointer; Size: Integer);
    procedure Error(const Msg: AnsiString);
    procedure ReaderProc(Handle: THandle; MessageCode: Integer);
    procedure ProcessTerminated;
    procedure CloseProcessHandle;
    function SplitSendAvail: AnsiString;
    property ProcessHandle: THandle read FProcessHAndle write SetProcessHandle;
    property OutputBuffer: AnsiString read FOutputBuffer write FOutputBuffer;
  protected
    procedure WndProc(var Msg: TMessage);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ClosePipes;
    procedure SendInput(Msg: AnsiString);
    procedure RunProcess(const CmdLine: AnsiString; CurrentDir: AnsiString = ''; ShowWindow: Boolean = False);
    procedure StopProcess;
  published
    property IsRunning: Boolean read GetIsRunning;
    property OnReceiveOutput: TReceiveEvent read FOnReceiveOutput write FOnReceiveOutput;
    property OnReceiveError: TReceiveEvent read FOnReceiveError write FOnReceiveError;
    property OnError: TReceiveEvent read FOnError write FOnError;
    property OnProcessStatusChange: TProcessStatusChangeEvent read FOnProcessStatusChange write FOnProcessStatusChange;
    property TerminateCommand: AnsiString read FTerminateCommand write FTerminateCommand;
    property StopProcessOnFree: Boolean read FStopProcessOnFree write FStopProcessOnFree default True;
    property EnableKill: Boolean read FEnableKill write FEnableKill default False;
    property WaitTimeout: Integer read FWaitTimeout write FWaitTimeout default 1000;
    property SplitMode: TSplitMode read FSplitMode write FSplitMode default sm0D0A;
    property SplitChar: Char read FSplitChar write FSplitChar default #10;
    property SplitReceive: Boolean read FSplitReceive write FSplitReceive default True;
    property SplitSend: Boolean read FSplitSend write FSplitSend default True;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Mustits', [TConsoleIO]);
end;

{ Win API wrappers }

procedure WinCheck(Result: Boolean);
begin
  if not Result then RaiseLastOSError;
end;

procedure InprocessDuplicateHandle(Source: THandle; var Destination: THandle);
var
  CurrentProcess: THandle;
begin
  CurrentProcess := GetCurrentProcess;
  WinCheck(DuplicateHandle(
    CurrentProcess,
    Source,
    CurrentProcess,
    @Destination,
    0, False, DUPLICATE_SAME_ACCESS));
end;

procedure CloseAndZeroHandle(var Handle: THandle);
var
  SaveHandle: THandle;
begin
  SaveHandle := Handle;
  Handle := 0;
  WinCheck(CloseHandle(SaveHandle));
end;

function ToPChar(const St: AnsiString): PAnsiChar;
begin
  if St = ''
    then Result := nil
    else Result := PAnsiChar(St);
end;

function ToShowWindowArg(ShowWindow: Boolean): Integer;
begin
  if ShowWindow
    then Result := SW_SHOW
    else Result := SW_HIDE
end;

{ Thread functions }

procedure IOReadOutput(Handler: TConsoleIO);
begin
  Handler.ReaderProc(Handler.OutputReadPipe, MIO_RECEIVE_OUTPUT);
end;

procedure IOReadError(Handler: TConsoleIO);
begin
  Handler.ReaderProc(Handler.ErrorReadPipe, MIO_RECEIVE_ERROR);
end;

procedure WaitProcess(Handler: TConsoleIO);
begin
  if WaitForSingleObject(Handler.ProcessHandle, INFINITE) = WAIT_OBJECT_0 then
    SendMessage(Handler.FWindowHandle, MIO_PROCESS_TERMINATED, 0, 0);
end;

{ TConsoleIO }

procedure TConsoleIO.ClosePipes;
begin
  CloseAndZeroHandle(InputReadPipe);
  CloseAndZeroHandle(OutputWritePipe);
  CloseAndZeroHandle(ErrorWritePipe);
  CloseAndZeroHandle(InputWritePipe);
  CloseAndZeroHandle(OutputReadPipe);
  CloseAndZeroHandle(ErrorReadPipe);
end;

constructor TConsoleIO.Create(AOwner: TComponent);
begin
  inherited;
  FTerminateCommand := 'quit';
  FSplitChar := #10;
  FSplitMode := sm0D0A;
  FSplitReceive := True;
  FSplitSend := True;
  FStopProcessOnFree := True;
  FWaitTimeout := 1000;
  FWindowHandle := Classes.AllocateHWnd(WndProc);
end;

destructor TConsoleIO.Destroy;
begin
  if StopProcessOnFree then StopProcess;
  CloseProcessHandle;
  Classes.DeallocateHWnd(FWindowHandle);
  FWindowHandle := 0;
  inherited;
end;

procedure TConsoleIO.ReceiveOutput(Buf: Pointer; Size: Integer);
var
  Cmd: AnsiString;
  TastyStrPos: Integer;
begin
  if (Size <= 0) then Exit;
  SetLength(Cmd, Size);
  Move(Buf^, Cmd[1], Size);
  OutputBuffer := OutputBuffer + Cmd;
  if not Assigned(FOnReceiveOutput) then Exit;

  if not SplitReceive or (SplitMode = smNone) then
  begin
    FOnReceiveOutput(Self, OutputBuffer);
    OutputBuffer := '';
  end
  else if SplitMode = sm0D0A then
    repeat
      TastyStrPos := Pos(#13#10, OutputBuffer);
      if TastyStrPos = 0 then Break;
      FOnReceiveOutput(Self, Copy(OutputBuffer, 1, TastyStrPos-1));
      OutputBuffer := Copy(OutputBuffer, TastyStrPos+2, Length(OutputBuffer));
    until False
  else if SplitMode = smSplitChar then
    repeat
      TastyStrPos := Pos(SplitChar, OutputBuffer);
      if TastyStrPos = 0 then Break;
      FOnReceiveOutput(Self, Copy(OutputBuffer, 1, TastyStrPos-1));
      OutputBuffer := Copy(OutputBuffer, TastyStrPos+1, Length(OutputBuffer));
    until False;
end;

procedure TConsoleIO.ReceiveError(Buf: Pointer; Size: Integer);
var
  Cmd: AnsiString;
begin
  if (Size <= 0) then Exit;
  if not Assigned(FOnReceiveOutput) then Exit;
  SetLength(Cmd, Size);
  Move(Buf^, Cmd[1], Size);
  FOnReceiveError(Self, Cmd);
end;

procedure TConsoleIO.RunProcess(const CmdLine: AnsiString; CurrentDir: AnsiString = ''; ShowWindow: Boolean = False);
var
  SA: TSecurityAttributes;
  //SI: TStartupInfo;
  SIEx: TStartupInfoA;
  PI: TProcessInformation;

  InputWriteTmp: THandle;
  OutputReadTmp: THandle;
  ErrorReadTmp: THandle;

  ThreadId: Cardinal;
begin
  SA.nLength := SizeOf(SA);
  SA.lpSecurityDescriptor := nil;
  SA.bInheritHandle := True;

  WinCheck(CreatePipe(InputReadPipe, InputWriteTmp, @SA, 0));
  WinCheck(CreatePipe(OutputReadTmp, OutputWritePipe, @SA, 0));
  WinCheck(CreatePipe(ErrorReadTmp, ErrorWritePipe, @SA, 0));

  InprocessDuplicateHandle(InputWriteTmp, InputWritePipe);
  InprocessDuplicateHandle(OutputReadTmp, OutputReadPipe);
  InprocessDuplicateHandle(ErrorReadTmp, ErrorReadPipe);

  CloseAndZeroHandle(InputWriteTmp);
  CloseAndZeroHandle(OutputReadTmp);
  CloseAndZeroHandle(ErrorReadTmp);

  {FillChar(SI, SizeOf(SI), $00);
  SI.cb := SizeOf(SI);
  SI.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  SI.hStdInput := InputReadPipe;
  SI.hStdOutput := OutputWritePipe;
  SI.hStdError := ErrorWritePipe;
  SI.wShowWindow := ToShowWindowArg(ShowWindow);{}

  FillChar(SIEx, SizeOf(SIEx), $00);
  SIEx.cb := SizeOf(SIEx);
  SIEx.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  SIEx.hStdInput := InputReadPipe;
  SIEx.hStdOutput := OutputWritePipe;
  SIEx.hStdError := ErrorWritePipe;
  SIEx.wShowWindow := ToShowWindowArg(ShowWindow);

  WinCheck(CreateProcessA(nil, ToPChar(CmdLine), @SA, nil, True,
   CREATE_NEW_CONSOLE, nil, ToPChar(CurrentDir), SIEx, PI));

  CloseAndZeroHandle(PI.hThread);
  ProcessHandle := PI.hProcess;
  BeginThread(nil, 0, @IOReadOutput, Self, 0, ThreadId);
  BeginThread(nil, 0, @IOReadError, Self, 0, ThreadId);
  BeginThread(nil, 0, @WaitProcess, Self, 0, ThreadId);
end;

procedure TConsoleIO.SendInput(Msg: AnsiString);
var
  BytesWritten: Cardinal;
begin
  Msg := Msg + SplitSendAvail;
  WinCheck(WriteFile(InputWritePipe, Msg[1], Length(Msg), BytesWritten, nil));
end;

procedure TConsoleIO.WndProc(var Msg: TMessage);
var
  Unhandled: Boolean;
begin
  with Msg do
  begin
    Unhandled := False;
    try
      case Msg of
        MIO_RECEIVE_OUTPUT: ReceiveOutput(Pointer(wParam), LParam);
        MIO_RECEIVE_ERROR: ReceiveError(Pointer(wParam), LParam);
        MIO_PROCESS_TERMINATED: ProcessTerminated;
        MIO_ERROR: Error(AnsiString(Pointer(wParam)))
        else Unhandled := True;
      end;
    except
      Application.HandleException(Self);
    end;
    if Unhandled then
      Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
  end;
end;

procedure TConsoleIO.Error(const Msg: AnsiString);
begin
  if Assigned(FOnError) then FOnError(Self, Msg); 
end;

procedure TConsoleIO.ReaderProc(Handle: THandle; MessageCode: Integer);
var
  Buf: array[0..1024] of Char;
  BytesRead: Cardinal;
  Err: AnsiString;
begin
  repeat
    if not ReadFile(Handle, Buf, SizeOf(Buf), BytesRead, nil) then
      try
        if not IsRunning then Exit;
        RaiseLastOSError;
      except
        on E: Exception do
        begin
          Err := E.Message;
          Windows.SendMessage(FWindowHandle, MIO_ERROR, Integer(PChar(Err)), Length(Err) + 1);
        end;
      end;

    if BytesRead > 0 then
      Windows.SendMessage(FWindowHandle, MessageCode, Integer(@Buf), BytesRead);
  until False;
end;

procedure TConsoleIO.ProcessTerminated;
begin
  if Assigned(FOnReceiveOutput) then
    FOnReceiveOutput(Self, OutputBuffer);
  OutputBuffer := ''; 
  CloseProcessHAndle;
  ClosePipes;
end;

function TConsoleIO.GetIsRunning: Boolean;
begin
  Result := ProcessHandle <> 0;
end;

procedure TConsoleIO.SetProcessHandle(const Value: THandle);
begin
  if FProcessHandle = Value then Exit;
  Assert((ProcessHandle = 0) or (Value = 0));
  FProcessHandle := Value;
  if Assigned(FOnProcessStatusChange) then
    FOnProcessStatusChange(Self, IsRunning);
end;

procedure TConsoleIO.CloseProcessHandle;
begin
  if ProcessHandle = 0 then Exit;
  WinCheck(CloseHandle(ProcessHandle));
  ProcessHandle := 0;
end;

procedure TConsoleIO.StopProcess;
begin
  if not IsRunning then Exit;
  if TerminateCommand <> '' then SendInput(TerminateCommand);
  if not EnableKill then Exit;
  if TerminateCommand <> '' then
    if WaitForSingleObject(ProcessHandle, WaitTimeout) = WAIT_OBJECT_0 then
      Exit;
  Windows.TerminateProcess(ProcessHandle, 4);
end;

function TConsoleIO.SplitSendAvail: AnsiString;
begin
  Result := '';
  if not SplitSend then Exit;
  if SplitMode = smNone then Exit;
  if SplitMode = sm0D0A
    then Result := #$0D#$0A
    else Result := SplitChar
end;

end.
Bu bileşen, RunProcess metotu ile dos komutu (örnek bir .bat dosyasını) çalıştırır. ReceiveOutput olayını kullanarak dos ortamında ekranda akan bilgiler elde edilir. Tabi bu komut satırı çalıştırıldıktan sonra bitişini beklemek gerekli olacağı için bu işlem bir döngüyle sağlanmaktadır. Basitçe örneklemek gerekirse..:

Kod: Tümünü seç

...
ConsoleIO.RunProcess('c:\yol\dene.bat','c:\yol',False);//<-dos komutunu (dene.bat uygulamasını) çalıştır
while ConsoleIO.IsRunning do Application.ProcessMessages; //<- Bitmesini bekle,
...

function OemToAnsi(const Str: AnsiString): AnsiString;//dos tarafının TR karakterlerinin Win tarafındaki karşılığına çevirir
begin
  SetLength(Result, Length(Str));
  OemToCharA(PAnsiChar(Str), PAnsiChar(Result));
end;

procedure ConsoleOutStringList(S:AnsiString;List:TStrings);//dos komutundan oluşan mesajın TStrings özelliğine eklenmesi
var i:Integer;
begin
  //S:=OemToAnsi(S);
  {i:=RPos(#13,S);
  if i>0 then Delete(S,1,i);
  i:=Pos(#8,S);
  if i>0 then S:=Copy(S,1,i-1);}
  List.Add(S);
end;

procedure TForm1.ConsoleIOReceiveError(Sender: TObject;
  const Cmd: AnsiString);
begin  //memConsoleOut->TRichEdit
  memConsoleOut.SelAttributes.Color:=clRed;
  ConsoleOutStringList(Cmd, memConsoleOut.Lines);
end;

procedure TForm1.ConsoleIOReceiveOutput(Sender: TObject;
  const Cmd: AnsiString);
begin  //memConsoleOut->TRichEdit
  memConsoleOut.SelAttributes.Color:=clNavy;
  ConsoleOutStringList(Cmd, memConsoleOut.Lines);
end;
şeklinde kullanılabilir. İyi çalışmalar
Şaban Şahin AKMAN
_________________
Derin olan kuyu değil kısa olan iptir. - .
Cevapla