古詩詞大全網 - 成語用法 - delphi創建壹個進程並返回進程的PID

delphi創建壹個進程並返回進程的PID

程序設計思路:

首先,利用WIN API函數 Createpipe 建立兩個管道(Pipe),然後建立利用CreateProcess函數創建壹個控制臺程序的進程(這裏使用的是Win2000的Dos控制臺 cmd.exe),並且在StartUpInfo參數中指定用剛才建立的三個管道替換標準的輸入hStdOutput、輸出hStdInput以及錯誤輸出設備hStdError。

代碼如下:

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: 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 := string(Buffer);

end;

until (BytesRead < ReadBuffer);

FreeMem(Buffer);

end;

procedure TForm1.Timer1Timer(Sender: TObject);

var

s: string;

begin

s := ReadFromPipe(ReadOut);

if s <> '' then begin

Memo1.Lines.Text := Memo1.Lines.Text + s;

Memo1.SelStart := Length(Memo1.Lines.Text);

Memo1.SelLength := 0;

end;

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.Button1Click(Sender: TObject);

begin

if Trim(cbCmd.Text) <> '' then begin

WriteToPipe(WriteIn, cbCmd.Text);

if cbCMD.ItemIndex > -1 then

cbCMD.Items.Delete(cbCMD.ItemIndex);

cbcmd.Items.Insert(0, cbCmd.Text);

cbCmd.Text:='';

end;

end;

這裏要註意的是發送命令行的時候必須添加換行字符#10,才能被Dos控制臺接受並執行