www.pudn.com > CMDpipe.rar > uMain.pas

unit uMain; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls, ExtCtrls, ShellCtrls; 
const 
    ReadBuffer = 255; 
type 
  TForm3 = class(TForm) 
    Memo1: TMemo; 
    Timer1: TTimer; 
    Panel1: TPanel; 
    ComboBox1: TComboBox; 
    procedure FormCreate(Sender: TObject); 
    procedure FormClose(Sender: TObject; var Action: TCloseAction); 
    procedure Timer1Timer(Sender: TObject); 
    procedure ComboBox1KeyPress(Sender: TObject; var Key: Char); 
    procedure ComboBox1Select(Sender: TObject); 
    procedure Memo1KeyPress(Sender: TObject; var Key: Char); 
  private 
    procedure WriteToPipe(Pipe: THandle; Value: string); 
    function ReadFromPipe(Pipe: THandle): string; 
    { Private declarations } 
  public 
    ReadPipeIn, WritePipeIn,ReadPipeOut, WritePipeOut: THandle; 
    ProcessInfo: TProcessInformation; 
    Buffer: PChar; 
    BytesRead: DWord; 
    bStart:boolean; 
    s:Tstringlist; 
  end; 
 
var 
  Form3: TForm3; 
 
implementation 
 
{$R *.dfm} 
 
procedure TForm3.FormCreate(Sender: TObject); 
var 
Security: TSecurityAttributes; 
start: TStartUpInfo; 
begin 
 
     // s.Destroy; 
    with Security do 
    begin 
        nlength := SizeOf(TSecurityAttributes); 
        binherithandle := true; 
        lpsecuritydescriptor := nil; 
    end; 
 
    {创建一个命名管道用来捕获console程序的输出} 
 
 
    if not Createpipe(ReadPipeIn, WritePipeIn, @Security, 0) then 
    begin 
        showmessage('无法创建命名管道！'); 
        exit; 
    end; 
    if not Createpipe(ReadPipeOut, WritePipeOut, @Security, 0)  then 
    begin 
        showmessage('无法创建命名管道！'); 
        CloseHandle(ReadPipeIn); 
        CloseHandle(WritePipeIn); 
        exit; 
    end; 
 
    Buffer := AllocMem(ReadBuffer + 1); 
 
    FillChar(Start, Sizeof(Start), #0); 
    {设置console程序的启动属性} 
    with start do 
    begin 
        cb := SizeOf(start); 
        start.lpReserved := nil; 
        lpDesktop := nil; 
        lpTitle := nil; 
        dwX := 0; 
        dwY := 0; 
        dwXSize := 0; 
        dwYSize := 0; 
        dwXCountChars := 0; 
        dwYCountChars := 0; 
        dwFillAttribute := 0; 
        cbReserved2 := 0; 
        lpReserved2 := nil; 
        hStdOutput := WritePipeOut; //将输出定向到我们建立的WritePipe上 
        hStdInput := ReadPipeIn;  //将输入定向到我们建立的ReadPipeIn上 
        hStdError := WritePipeOut;  //将错误输出定向到我们建立的WritePipe上 
        dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW; 
        wShowWindow := SW_hide;  //设置窗口为hide 
    end; 
 
    if not CreateProcess(nil, 
              PChar('cmd.exe'), 
              @Security, 
              @Security, 
              true, 
              NORMAL_PRIORITY_CLASS, 
              nil, 
              nil, 
              start, 
              ProcessInfo) 
   then 
    begin 
        showmessage('无法起动cmd!'); 
        exit; 
    end; 
    Memo1.Lines.Add('程序起动'); 
    BytesRead := 0; 
    self.bStart :=true; 
 
end; 
procedure TForm3.WriteToPipe(Pipe: THandle; Value: string); 
var 
  len: integer; 
  BytesWrite: DWord; 
  Buffer: PChar; 
begin 
  len := Length(Value) + 2; 
  Buffer := PChar(Value + #13#10); 
  WriteFile(Pipe, Buffer[0], len, BytesWrite, nil); 
end; 
 
procedure TForm3.FormClose(Sender: TObject; var Action: TCloseAction); 
begin 
    if self.bStart then 
    begin 
        TerminateProcess(ProcessInfo.hProcess,0); 
        FreeMem(Buffer); 
        CloseHandle(ProcessInfo.hProcess); 
        CloseHandle(ProcessInfo.hThread); 
        CloseHandle(ReadPipeOut); 
        CloseHandle(WritePipeOut); 
        CloseHandle(ReadPipeIn); 
        CloseHandle(WritePipeIn); 
    end; 
end; 
 
procedure TForm3.Timer1Timer(Sender: TObject); 
var 
    Buf: string; 
    fileSize:dword; 
begin 
    buf:= ReadFromPipe( ReadPipeOut); 
 
    if buf <>'' then 
    begin 
        Memo1.Lines.BeginUpdate ; 
        Memo1.Text := Memo1.Text + buf; 
        postmessage(Memo1.Handle,EM_SCROLL,SB_BOTTOM,0); 
        application.ProcessMessages; 
        memo1.SelStart := length(Memo1.Text); 
        Memo1.Lines.EndUpdate; 
    end; 
end; 
 
function TForm3.ReadFromPipe(Pipe: THandle): string; 
var 
  Buffer: PChar; 
  BytesRead: DWord; 
begin 
   Result := ''; 
 
   if GetFileSize(Pipe, nil) = 0 then Exit; 
 
   Buffer := AllocMem(ReadBuffer + 1); 
 
   repeat 
       BytesRead := 0; 
       ReadFile(Pipe, Buffer[0], 
       ReadBuffer, BytesRead, nil); 
        if BytesRead > 0 then begin 
            Buffer[BytesRead] := #0; 
            OemToAnsi(Buffer, Buffer); 
            Result := Result+string(Buffer); 
        end; 
   until (GetFileSize(Pipe, nil) <= 0); 
 
   FreeMem(Buffer); 
 
end; 
 
procedure TForm3.ComboBox1KeyPress(Sender: TObject; var Key: Char); 
begin 
    if Key = #13 then 
    begin 
        //向管道写入数据。 
        WriteToPipe(WritePipeIn,ComboBox1.Text); 
 
        Key :=#0; 
        if (ComboBox1.Text <> '')then 
        begin 
         ComboBox1.Items.Insert(0,ComboBox1.Text); 
            if ComboBox1.Items.Count > 20  then 
            ComboBox1.Items.Delete(ComboBox1.Items.Count -1); 
            ComboBox1.Text:=''; 
            ComboBox1.ItemIndex:=-1; 
        end; 
    end; 
    ComboBox1.Tag:= ComboBox1.SelStart ; 
end; 
 
procedure TForm3.ComboBox1Select(Sender: TObject); 
begin 
    if length(ComboBox1.Text) <=ComboBox1.Tag  then 
   ComboBox1.SelStart := ComboBox1.Tag  ; 
end; 
 
procedure TForm3.Memo1KeyPress(Sender: TObject; var Key: Char); 
begin 
    PostMessage(ComboBox1.Handle,WM_CHAR, integer(Key),0); 
    Key:=#0; 
    ComboBox1.SetFocus; 
end; 
 
end.