Главная / DELPHI / Часто задаваемые вопросы и ответы на них / Win Api / Мне нужно сделать такую прогу, которая будет работать как командная строка в windows 2000. Только параметры для команды должны вводится в editы

Мне нужно сделать такую прогу, которая будет работать как командная строка в windows 2000. Только параметры для команды должны вводится в editы

unit admin;

interface

uses Windows, Classes, syncobjs, SysUtils;

type
TConsole=class(TThread)
private
 FWnd:THandle;
 FMsg:Cardinal;
 ChildStdInWr,ChildStdoutRd:THandle;
 FCS:TCriticalSection;
 FCommandList:TStringList;
 procedure CreateConsole;
protected
 procedure Execute;override;
public
 constructor Create(AWnd:THandle; AMsg:Cardinal);reintroduce;
 procedure AddCommand(s:string);
end;

implementation

{ TConsole }

constructor TConsole.Create(AWnd:THandle; AMsg:Cardinal);
begin
 FWnd:=AWnd;
 FMsg:=AMsg;
 FCS:=TCriticalSection.Create;
 FCommandList:=TStringList.Create;
 inherited Create(false);
end;

procedure TConsole.AddCommand(s:string);
begin
 FCS.Enter;
 try
   FCommandList.Add(s+#13#10);
 finally
   FCS.Leave;
 end;
end;

procedure TConsole.Execute;
var
 buffer:Pointer;
 bytesRead:DWORD;
begin
 CreateConsole;
 while not Terminated do
 begin
   sleep(200);
   PeekNamedPipe(ChildStdoutRd,nil,0,nil,@bytesRead,nil);

   //?eoaai
   if bytesRead>0 then
   begin
     GetMem(buffer,bytesRead+1);
     try
       if not ReadFile(ChildStdoutRd,buffer^,bytesRead,bytesRead,nil) then
         RaiseLastWin32Error;
       PChar(buffer)[bytesRead]:=#0;
       SendMessage(FWnd,FMsg,Integer(PChar(buffer)),0);
     finally
       FreeMem(buffer);
     end;
   end;

   //Ieoai
   FCS.Enter;
   try
     while FCommandList.Count>0 do
     begin
       if not WriteFile(ChildStdinWr,PChar(FCommandList[0])^,Length(FCommandList[0]),
bytesRead,nil) then
         RaiseLastWin32Error;
       FCommandList.Delete(0);
     end;
   finally
     FCS.Leave;
   end;
 end;
end;

procedure TConsole.CreateConsole;
var
 sa:TSecurityAttributes;
 si:TStartupInfo;
 pi:TProcessInformation;
 comSpec:PChar;
 bufLen:DWORD;
 ChildStdoutWr, ChildStdInRd, Tmp1, Tmp2:THandle;
begin
 sa.nLength:=sizeof(TSecurityAttributes);
 sa.bInheritHandle:=true;
 sa.lpSecurityDescriptor:=nil;

 if not CreatePipe(ChildStdoutRd, ChildStdoutWr, @sa, 0) then
   RaiseLastWin32Error;
 if not CreatePipe(ChildStdinRd, ChildStdinWr, @sa, 0) then

   RaiseLastWin32Error;

 if not DuplicateHandle(GetCurrentProcess(), ChildStdoutRd, GetCurrentProcess(),
 @Tmp1, 0, False, DUPLICATE_SAME_ACCESS) then
   RaiseLastWin32Error;
 if not DuplicateHandle(GetCurrentProcess(), ChildStdinWr, 
GetCurrentProcess(), @Tmp2, 0, False, DUPLICATE_SAME_ACCESS) then
   RaiseLastWin32Error;

 CloseHandle(ChildStdoutRd);
 CloseHandle(ChildStdinWr);
 ChildStdoutRd:=Tmp1;
 ChildStdinWr:=Tmp2;

 bufLen:=GetEnvironmentVariable('ComSpec',nil,0);
 GetMem(comSpec,bufLen);
 GetEnvironmentVariable('ComSpec',comSpec,bufLen);

 GetStartupInfo(si);
 si.cb:=sizeof(TStartupInfo);
 si.dwFlags:=STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
 si.hStdInput:=ChildStdInRd;
 si.hStdOutput:=ChildStdOutWr;
 si.hStdError:=ChildStdOutWr;
 si.wShowWindow:=SW_HIDE;
 if not CreateProcess(nil,comSpec,nil,nil,true,CREATE_NEW_CONSOLE,nil,nil,si,pi) then
   RaiseLastWin32Error;
end;
end.

пример использования

unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   Memo1: TMemo;
   procedure FormCreate(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
   c:TConsole;
   procedure Z(var Msg:TMessage);message WM_USER+1;
 end;

var
 Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
 c:=TConsole.Create(Handle,WM_USER+1);
 c.AddCommand('ping 192.168.1.23');
end;

procedure TForm1.Z(var Msg: TMessage);
var
p:PChar;
begin
 p:=PChar(Msg.wParam);
 OemToCharBuff(p,p,length(p));
 Memo1.Lines.Add(p);
end;
end.

Copyright ©   "Мастера DELPHI"   E-mail:   delphi@mastak.com  http://www.delphimaster.ru

Источник получения информации: http://www.delphimaster.ru