unit CmdConslAPI;

interface

Uses
 //SysUtils,
 Windows;

Type TCmdProc = (CP_NIL,CP_RESUME,CP_SUSPEND,CP_STOP);

Type
 PMsgRec = ^TMsgRec;
 TMsgRec = Record
   WND      : HWND;
   ThreadId : Cardinal;
   Msg      : Cardinal;
   ConslThrId : Cardinal;
   hThrConsl  : THandle;
End;

//WND,ThrId,Msg = response value
Function ConsoleCreate(WND: HWND; ThrId: Cardinal; Msg:Cardinal): boolean;
function ConsoleSendCommand(Cmd: String): Boolean;
procedure ConsoleThreadProc(P: Pointer);
function ConsoleResume: Boolean;
function ConsoleSuspend: Boolean;
function ConsoleStop: Boolean;

Var
 pi : TProcessInformation;
 ChildStdInWr  : THandle;
 ChildStdoutRd : THandle;
 CS_REC        : TRTLCriticalSection;
 MsgRec        : PMsgRec = Nil;
 CmdString     : String;
 CmdProc       : TCmdProc;
 ConslStat     : TCmdProc = CP_NIL;

implementation

{------------------------------- ConsoleCreate --------------------------------}
Function ConsoleCreate(WND: HWND; ThrId: Cardinal; Msg: Cardinal): boolean;
Var
ComSpec : String;
bufLen  : DWORD;
ChildStdoutWr, ChildStdInRd, Tmp1, Tmp2: THandle;
sa : TSecurityAttributes;
si : TStartupInfo;
begin
Result := false;

If Assigned(MsgRec) then Exit;
if (WND = 0) and (ThrId  = 0) then Exit;
if (WND = 0) and (Msg = 0) and (ThrId  = 0) Then Exit;

sa.nLength              := sizeof(TSecurityAttributes);
sa.bInheritHandle       := true;
sa.lpSecurityDescriptor := nil;

if not CreatePipe(ChildStdoutRd, ChildStdoutWr, @sa, 0) then begin
  //RaiseLastWin32Error;
  //PostThreadMessage(ThrId,Msg,0,GetLastError);
  //SendMessage(WND,Msg,0,GetLastError);
  Exit;
end;
if not CreatePipe(ChildStdinRd, ChildStdinWr, @sa, 0) then begin
  //RaiseLastWin32Error;
  //PostThreadMessage(ThrId,Msg,0,GetLastError);
  //SendMessage(WND,Msg,0,GetLastError);
  Exit;
end;

if not DuplicateHandle(GetCurrentProcess(),ChildStdoutRd,GetCurrentProcess(),@Tmp1,0,Fa lse,DUPLICATE_SAME_ACCESS) then
  begin
    //RaiseLastWin32Error;
    //PostThreadMessage(ThrId,Msg,0,GetLastError);
    //SendMessage(WND,Msg,0,GetLastError);
    exit;
  end;
if not DuplicateHandle(GetCurrentProcess(),ChildStdinWr,GetCurrentProcess(),@Tmp2,0,Fal se,DUPLICATE_SAME_ACCESS) then
  begin
    //RaiseLastWin32Error;
    //PostThreadMessage(ThrId,Msg,0,GetLastError);
    //SendMessage(WND,Msg,0,GetLastError);
    Exit;
  end;

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

bufLen := GetEnvironmentVariable('ComSpec',nil,0);
SetLength(ComSpec,bufLen);
GetEnvironmentVariable('ComSpec',@ComSpec[1],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,PChar(ComSpec),nil,nil,true,CREATE_NEW_CONSOLE,nil,nil,si,pi) then begin
  //RaiseLastWin32Error;
  //PostThreadMessage(ThrId,Msg,0,GetLastError);
  //SendMessage(WND,Msg,0,GetLastError);
  Exit;
end;

New(MsgRec);
ZeroMemory(MsgRec,SizeOf(TMsgRec));

MsgRec.WND       := WND;
MsgRec.ThreadId  := ThrId;
MsgRec.Msg       := Msg;
MsgRec.hThrConsl := BeginThread(Nil,0,Addr(ConsoleThreadProc),MsgRec,CREATE_SUSPENDED,MsgRec^.ConslT hrId);
if MsgRec.hThrConsl = 0 Then begin
  //RaiseLastWin32Error;
  //PostThreadMessage(ThrId,Msg,0,GetLastError);
  //SendMessage(WND,Msg,0,GetLastError);
  Exit;
end;
ResumeThread(MsgRec.hThrConsl);
Result    := true;
ConslStat := CP_RESUME;
end;
{------------------------------ ConsoleSendCommand ----------------------------}
function ConsoleSendCommand(Cmd: String): Boolean;
begin
 if Not Assigned(MsgRec) Then Exit;
 EnterCriticalSection(CS_REC);
   CmdString:=CMD+#13#10;
 LeaveCriticalSection(CS_REC);
end;
{------------------------------- ConsoleThreadProc ----------------------------}
procedure ConsoleThreadProc(P: Pointer);
Var
buffer   : Pointer;
ByteRead : DWORD;
begin
 InitializeCriticalSection(CS_REC);
 try
 while WaitForSingleObject(PI.hProcess, 0) = WAIT_TIMEOUT do begin
   Sleep(50);
   PeekNamedPipe(ChildStdoutRd,nil,0,nil,@ByteRead,nil);

   if ByteRead > 0 then begin
     GetMem(buffer,ByteRead+1);
     try
       if not ReadFile(ChildStdoutRd,buffer^,ByteRead,ByteRead,nil) then begin
         //RaiseLastWin32Error;
         With PMsgRec(P)^ do begin
           PostThreadMessage(ThreadId,Msg,0,GetLastError);
           SendMessage(WND,Msg,0,GetLastError);
         end;
         Exit;
       end;
       PChar(buffer)[ByteRead]:=#0;
       With PMsgRec(P)^ do begin
         PostThreadMessage(ThreadId,Msg,Integer(PChar(buffer)),0);
         SendMessage(WND,Msg,Integer(PChar(buffer)),0);
       end;
     finally
       FreeMem(buffer);
     end;
   end;

   if CmdString <> '' then begin
     EnterCriticalSection(CS_REC);
     if not Windows.WriteFile(ChildStdinWr,CmdString[1],Length(CmdString),ByteRead,nil) then begin
       //RaiseLastWin32Error;
       With PMsgRec(P)^ do begin
         PostThreadMessage(ThreadId,Msg,0,GetLastError);
         SendMessage(WND,Msg,0,GetLastError);
       end;
       Exit;
     end;
     CmdString:='';
     LeaveCriticalSection(CS_REC);
   end;
 end;

 finally
   ConslStat:=CP_STOP;
   DeleteCriticalSection(CS_REC);
   CloseHandle(PI.hProcess);
   CloseHandle(PI.hThread);
   CloseHandle(PMsgRec(P).hThrConsl);
   Dispose(PMsgRec(p));
   MsgRec := Nil;
 end;
end;
{--------------------------------- ConsoleResume ------------------------------}
function ConsoleResume: Boolean;
begin
 Result:=false;
 if Not Assigned(MsgRec) Then Exit;
 if ResumeThread(PI.hThread) = -1 then Exit;
 ConslStat := CP_RESUME;
 Result := true;
end;
{-------------------------------- ConsoleSuspend ------------------------------}
function ConsoleSuspend: Boolean;
begin
 Result:=false;
 if Not Assigned(MsgRec) or (ConslStat = CP_SUSPEND) Then Exit;
 if SuspendThread(PI.hThread) = -1 then Exit;
 ConslStat := CP_SUSPEND;
 Result    := true;
end;
{---------------------------------- ConsoleStop -------------------------------}
function ConsoleStop: Boolean;
begin
 Result:=false;
 if Not Assigned(MsgRec) then Exit;
 if Not TerminateProcess(PI.hProcess,0) then Exit;
 ConslStat := CP_STOP;
 Result    := true;
end;

end.

unit CmdConsole;

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.