rundos.pas

a voice guide client ,it is the second part of voice guide center

{-----------------------------------------------------------------------------
 Unit Name: RunDos
 Author:    kuangying
 Purpose:
 History:
-----------------------------------------------------------------------------}
unit RunDos;

interface

uses
  SysUtils, Classes, Windows;

type

  TOnDosAppOutput = procedure (Sender: TObject; OutPut: string) of Object;
  TOnAppTerminate = TNotifyEvent;

  TRunDos = class;

  TRunThread = class(TThread)
  private
    { Private declarations }
    fCmdLines: TStringList;
    fOutPut: string;
    fOwner: TRunDos;
  protected
    procedure Execute; override;
  public
    constructor Create(AOwner: TRunDos; CmdLine: string);
  end;

  TRunDos = class(TComponent)
  private
    { Private declarations }
    fCmd: string;
    fProcessHandle: Cardinal;
    fProcessHandleAssigned: Boolean;
    fOnDosAppOutput: TOnDosAppOutput;
    fOnAppTerminate: TOnAppTerminate;
    fRunThread: TRunThread;
    procedure DoRecv;
  protected
    { Protected declarations }
  public
    { Public declarations }
    procedure OnThreadTerminate(Sender: TObject);
    procedure Execute(CmdLine: string);
    procedure Stop;
  published
    { Published declarations }
    property CmdLine: string
        read fCmd
       write fCmd;
    property OnDosAppOutput: TOnDosAppOutput
        read fOnDosAppOutput
       write fOnDosAppOutput;
    property OnDosAppTerminate : TOnAppTerminate
        read fOnAppTerminate
       Write fOnAppTerminate;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Treble', [TRunDos]);
end;

{ TRunThread }

constructor TRunThread.Create(AOwner: TrunDos; CmdLine: string);
begin
  fOwner:= AOwner;
  fOutPut:= '';
  fCmdLines:= TStringList.Create;
  fCmdLines.Text:= CmdLine;
  FreeOnTerminate:= True;
  OnTerminate:= AOwner.OnThreadTerminate;
  Inherited Create(False);
end;

{-----------------------------------------------------------------------------
  Procedure: TRunThread.Execute
  Author:    kuangying
  Date:      17-二月-2003
  Arguments: None
  Result:    None
-----------------------------------------------------------------------------}
procedure TRunThread.Execute;
const
  ReadBuffer = 2400;
var
  Security : TSecurityAttributes;
  ReadPipe,WritePipe : THandle;
  start : TStartUpInfo;
  ProcessInfo : TProcessInformation;
  Buffer : Pchar;
  //BytesRead : DWord;
  Apprunning : DWord;
  TempCmdLine: string;
begin
  //inherited;
  With Security do
  begin
    nlength := SizeOf(TSecurityAttributes);
    binherithandle := true;
    lpsecuritydescriptor := nil;
  end;
  if Createpipe (ReadPipe, WritePipe, @Security, 0) then
  begin
    Buffer := AllocMem(ReadBuffer + 1);
    FillChar(Start,Sizeof(Start),#0);
    start.cb := SizeOf(start);
    start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
    //标准输出和标准错误定向到一个通道上
    start.hStdOutput := WritePipe;
    start.hStdInput := ReadPipe;
    start.hStdError:= WritePipe;
    start.wShowWindow := SW_HIDE;
    while (not Terminated) and (fCmdLines.Count >0) do begin
      //if fCmdLines.Count >0  then begin
        TempCmdLine:= fCmdLines[0];
        fOwner.fProcessHandleAssigned:=
          CreateProcess(nil, PChar(TempCmdLine), @Security, @Security, True,
          NORMAL_PRIORITY_CLASS, nil, nil, start, ProcessInfo);
        if fOwner.fProcessHandleAssigned then
        begin
          fOwner.fProcessHandle:= ProcessInfo.hProcess;
          repeat
            Apprunning := WaitForSingleObject(ProcessInfo.hProcess,100);
//            BytesRead := 0;
//            ReadFile(ReadPipe,Buffer[0],ReadBuffer,BytesRead,nil);
//            Buffer[BytesRead]:= #0;
//            OemToAnsi(Buffer, Buffer);
//            fOutPut:= String(Buffer);
//            if BytesRead>0 then Synchronize(fOwner.DoRecv);
          until (Apprunning <> WAIT_TIMEOUT)or (Terminated);
          fCmdLines.Delete(0);
        end;
      //end ;//else Sleep(1000)
    end;
    FreeMem(Buffer);
    CloseHandle(ProcessInfo.hProcess);
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ReadPipe);
    CloseHandle(WritePipe);
  end;
end;

{ TRunDos }

procedure TRunDos.DoRecv;
begin
  if Assigned(fOnDosAppOutput)and Assigned(fRunThread)
  then fOnDosAppOutput(Self, fRunThread.fOutPut);
end;

procedure TRunDos.Execute(CmdLine: string);
begin
//  if (not Assigned(fRunThread))or (fRunThread.Terminated)
//  then fRunThread:= TRunThread.Create(Self, CmdLine)
//  else fRunThread.fCmdLines.Add(CmdLine);
  fRunThread:= TRunThread.Create(Self, CmdLine);
end;

procedure TRunDos.OnThreadTerminate(Sender: TObject);
begin
  if Assigned(fOnAppTerminate) then fOnAppTerminate(Self);
  fRunThread:= nil;
end;

procedure TRunDos.Stop;
begin
  if (Assigned(fRunThread))and (not fRunThread.Terminated)
  then begin
    fRunThread.Terminate;
    fRunThread:= nil;
    if fProcessHandleAssigned
    then TerminateProcess(fProcessHandle, $FFFFFFFF);
    fProcessHandleAssigned:= False;
  end;
end;

end.