管道出错了(150分)

  • 主题发起人 主题发起人 我爱吃草莓
  • 开始时间 开始时间

我爱吃草莓

Unregistered / Unconfirmed
GUEST, unregistred user!
一个朋友给了下面的代码,目的是在EDIT1里面输入DOS命令,然后在MEMO1里面回显,可是执行的时候总是出错,哪位富翁能帮着看一下是什么原因导致的。[:)]

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Memo1: TMemo;
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
procedure ShellThread;
end;

var
Form1: TForm1;
Terminated: boolean;
Cmdbuffer:string;
implementation

{$R *.dfm}
procedure TForm1.ShellThread;
const
MAX_CHUNK: dword = 8191;
var
Buffer: array [0..8191] of byte;
SecurityAttributes: SECURITY_ATTRIBUTES;
hiRead, hoRead, hiWrite, hoWrite: THandle;
StartupInfo: TSTARTUPINFO;
ProcessInfo: TProcessInformation;
BytesRead, BytesWritten, ExitCode, PipeMode: dword;
Temp:string;
begin
SecurityAttributes.nLength := SizeOf(SECURITY_ATTRIBUTES);
SecurityAttributes.lpSecurityDescriptor := nil;
SecurityAttributes.bInheritHandle := True;
CreatePipe(hiRead, hiWrite, @SecurityAttributes, 0);
CreatePipe(hoRead, hoWrite, @SecurityAttributes, 0);
GetStartupInfo(StartupInfo);
StartupInfo.hStdOutput := hoWrite;
StartupInfo.hStdError := hoWrite;
StartupInfo.hStdInput := hiRead;
StartupInfo.dwFlags := STARTF_USESHOWWINDOW + STARTF_USESTDHANDLES;
StartupInfo.wShowWindow := SW_HIDE;
CreateProcess(nil,'cmd.exe', nil, nil, True, CREATE_NEW_CONSOLE, nil, nil, StartupInfo, ProcessInfo);
CloseHandle(hoWrite);
CloseHandle(hiRead);
PipeMode := PIPE_NOWAIT;
SetNamedPipeHandleState(hoRead, PipeMode , nil, nil);

while (not Terminated) do
begin
if Terminated then Break;
Sleep(100);
GetExitCodeProcess(ProcessInfo.hProcess, ExitCode);
if ExitCode <> STILL_ACTIVE then Break;
ReadFile(hoRead, Buffer, MAX_CHUNK, BytesRead, nil);
if BytesRead > 0 then
begin
SetLength(Temp,BytesRead);
Copymemory(@Temp[1],@Buffer[0],BytesRead);
Memo1.Text:=Temp;
end;
Sleep(100);
if Length(Cmdbuffer) > 0 then
begin
WriteFile(hiWrite, CmdBuffer[1], Length(CmdBuffer), BytesWritten, nil);
CmdBuffer:='';
end;
end;

GetExitCodeProcess(ProcessInfo.hProcess, ExitCode);
if ExitCode = STILL_ACTIVE then TerminateProcess(ProcessInfo.hProcess, 0);
CloseHandle(hoRead);
CloseHandle(hiWrite);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Cmdbuffer:=Edit1.Text ; //执行的命令
end;

procedure TForm1.Button2Click(Sender: TObject); //开始按钮
var ThreadId:Dword;
begin
Terminated:=False;
CreateThread(nil,0,@TForm1.ShellThread,nil,0,ThreadId);
end;

procedure TForm1.Button3Click(Sender: TObject); //停止按钮
begin
Terminated:=True;
end;

end.
 
网上有许多现成的管道函数。找一个就行
 
在网上找过一些例子看,没有跟这个相似的,使用管道是不是有什么禁忌,不能这样在一个线程里循环读写吗
 
运行DOS程序,并把输出显示在Memo里
procedure RunDosInMemo(DosApp:String;AMemo:TMemo);
const
ReadBuffer = 2400;
var
Security : TSecurityAttributes;
ReadPipe,WritePipe : THandle;
start : TStartUpInfo;
ProcessInfo : TProcessInformation;
Buffer : Pchar;
BytesRead : DWord;
Apprunning : DWord;
begin
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.hStdOutput := WritePipe;
start.hStdInput := ReadPipe;
start.dwFlags := STARTF_USESTDHANDLES +
STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;
if CreateProcess(nil,
PChar(DosApp),
@Security,
@Security,
true,
NORMAL_PRIORITY_CLASS,
nil,
nil,
start,
ProcessInfo)
then
begin
repeat
Apprunning := WaitForSingleObject
(ProcessInfo.hProcess,100);
Application.ProcessMessages;
until (Apprunning <> WAIT_TIMEOUT);
Repeat
BytesRead := 0;
ReadFile(ReadPipe,Buffer[0],
ReadBuffer,BytesRead,nil);
Buffer[BytesRead]:= #0;
OemToAnsi(Buffer,Buffer);
AMemo.Text := AMemo.text + String(Buffer);
until (BytesRead < ReadBuffer);
end;
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ReadPipe);
CloseHandle(WritePipe);
end;
end;
 
这段代码,对于输入“c:”这样的命令不行,不能转换盘符,有没有更完善的
 
多人接受答案了。
 

Similar threads

后退
顶部