delphixe3关于CreateProcess F7不通过

Question

unit ufmMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls, StrUtils;

type
TForm1 = class(TForm)
cbCMD: TComboBox;
Button1: TButton;
RichEdit1: TRichEdit;
Timer1: TTimer;
procedure Timer1Timer(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure cbCMDKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
ReadOut, WriteOut: THandle;
ReadIn, WriteIn: THandle;
ProcessInfo: TProcessInformation;
cl:integer;
procedure InitConsole;
function ReadFromPipe(Pipe: THandle): string;
procedure WriteToPipe(Pipe: THandle; Value: string);
procedure CloseConsole;
public
{ Public declarations }
end;

var
Form1: TForm1;

const

ReadBuffer = 2400;

implementation

{$R *.dfm}

procedure TForm1.InitConsole;
var
Security: TSecurityAttributes;
start: TStartUpInfo;
begin
with Security do begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;
Createpipe(ReadOut, WriteOut, @Security, 0);
Createpipe(ReadIn, WriteIn, @Security, 0);
with Security do begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;
FillChar(Start, Sizeof(Start), #0);
start.cb := SizeOf(start);
start.hStdOutput := WriteOut;
start.hStdInput := ReadIn;
start.hStdError := WriteOut;
start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;

 CreateProcess

(nil,pchar('cmd'),@Security,@Security,true,NORMAL_PRIORITY_CLASS,nil,nil,start,ProcessInfo);
end;

function TForm1.ReadFromPipe(Pipe: THandle): string;
var
Buffer: PAnsiChar;
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 := string(Buffer);
end;
until (BytesRead < ReadBuffer);
FreeMem(Buffer);
end;

procedure TForm1.WriteToPipe(Pipe: THandle; Value: string);
var
len: integer;
BytesWrite: DWord;
Buffer: PChar;
begin
len := Length(Value) + 1 ;
Buffer := PChar(Value +#10);
WriteFile(Pipe, Buffer[0], len, BytesWrite, nil);
end;

procedure TForm1.CloseConsole;
begin
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);

CloseHandle(ReadIn);
CloseHandle(WriteIn);

CloseHandle(ReadOut);
CloseHandle(WriteOut);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
s: string;
begin
s := ReadFromPipe(ReadOut);
if s <> '' then begin
RichEdit1.SelAttributes.Color:=cl; //你还可以通过返回串改颜色
RichEdit1.Lines.Add(s);
end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
self.OnShow := nil;
cbCmd.Clear;
cbCmd.SetFocus;

InitConsole;

Timer1.Enabled := True;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Timer1.Enabled := False;
CloseConsole;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
s:string;
begin
s:=Trim(cbCmd.Text);
if (length(s)>=3) and (s[1]='[') and (s[3]=']') and (s[2]>='0') and (s[2]<='4') then
begin
case StrToInt(s[2]) of
0: cl:=clBlack;
1: cl:=clBlue;
2: cl:=clGreen;
3: cl:=clRed;
4: cl:=clYellow;
end;
s:=RightStr(s,length(s)-3);
end ;
if s<> '' then begin
WriteToPipe(WriteIn, s);
if cbCMD.ItemIndex > -1 then
cbCMD.Items.Delete(cbCMD.ItemIndex);
cbcmd.Items.Insert(0, cbCmd.Text);
cbCmd.Text:='';
end;
end;

procedure TForm1.cbCMDKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if Key = VK_RETURN then Button1.Click;
end;

end.