Delphi控件源码

开发平台：
Delphi

ftpProtocol.pas：源码内容
							unit ftpProtocol;
interface
  uses windows,WinSock,CommandsAndUtils;
procedure ftpcomEvents( wParam,lParam: Integer);
procedure FTP_Connect(Host: string;User : string; PASS : string;Port : integer;Handle :HWnd);
const
  WM_ftpcom =  $0400 + $1004;
  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;
ftpcom : TSocket;
  FTP_HANDLE :  HWnd  ;
   FTP_IPReturn : string;
  
  ftpCaddr : SOCKADDR_IN; // Internet address
  ftpCaddrserver : SOCKADDR_IN; // Internet address
 
  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_Abort : boolean;
  FTP_status : integer;
implementation
function stringtochar(st : string) : char;
var c : char;
begin
     c := #0;
     while c <> st do
           c := succ(c);
     stringtochar := c;
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;
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 GetUpload(OpenFile : String;Ipadress : string; PORT : string) ;
 var addr : TSockAddrIn;
     addrserver : TSockAddrIn;
     sinsize : Integer;
     sock, client      : TSocket;
     a          : THandle;
     Archivo      : THandle;
     Buffer       : array [ 1..1024 ] of Char;
     FileStatus : Boolean;
     BytesRead    : DWord;
     Error     : Boolean;
      size : longint ;
      f   : file ;
begin
  Client := socket(AF_INET, SOCK_STREAM, 0);
  if (Client <> INVALID_SOCKET)   THEN BEGIN
  addr.sin_family := AF_INET;
  addr.sin_port := 0;
  addr.sin_addr.s_addr := htonl(INADDR_ANY);
  end;
 if (bind(Client ,addr,sizeof(addr))= INVALID_SOCKET ) then begin
 halt;
 end;
 addrserver.sin_family := AF_INET;
 addrserver.sin_port := htons(strtoint(port));
 addrserver.sin_addr.s_addr := inet_addr(pchar(Ipadress));
 if (connect(Client, addrserver,sizeof(addrserver)) =SOCKET_ERROR) then begin
 //messagebox(0,'dddddddddddd','ddddddddd',0);
 end;
               
                                    
   try
        AssignFile(f, OpenFile);
             Reset(f);
             try
             size :=FileSize(f)*128 div 1024;
            //  frmMain.lblFTPSize.Caption:= inttostr(size);
            //frmMain.ProgressBarExplorer.Max:=size;
              if size<1 then begin
            //frmMain.ProgressBarExplorer.Max:=1;
              end;
             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);
       // frmMain.ProgressBarExplorer.Position:= frmMain.ProgressBarExplorer.Position +1;
     until ( Error  ) and ( BytesRead = 0 );
     CloseHandle( Archivo );
     try CloseSocket( client ); except end;
     FTP_Abort := FALSE;
end;
 procedure GetList(SaveDIR : string  ;Ipadress : string; PORT : string) ;
 var addr : TSockAddrIn;
     addrserver : TSockAddrIn;
     BytesRead, sinsize : Integer;
       client      : TSocket;
     a          : THandle;
     Buffer     : array [ 1..2048 ] of Char;
     BytesWrite : DWORD;
     FileStatus : Boolean;
    begin
  Client := socket(AF_INET, SOCK_STREAM, 0);
  if (Client <> INVALID_SOCKET)   THEN BEGIN
  addr.sin_family := AF_INET;
  addr.sin_port := 0;
  addr.sin_addr.s_addr := htonl(INADDR_ANY);
  end;
 if (bind(Client ,addr,sizeof(addr))= INVALID_SOCKET ) then begin
 halt;
 end;
 addrserver.sin_family := AF_INET;
 addrserver.sin_port := htons(strtoint(PORT));
 addrserver.sin_addr.s_addr := inet_addr(pchar(Ipadress));
 if (connect(Client, addrserver,sizeof(addrserver)) =SOCKET_ERROR) then begin
 //messagebox(0,'dddddddddddd','ddddddddd',0);
 end;
   BytesWrite := 0;
    try
        a := CreateFile( PChar(SaveDIR + 'FTP_LIST.txt') , GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0 );
    except
        CloseSocket(Client );
        Exit;
    end;
    repeat BytesRead  := Recv( client, Buffer, SizeOf( Buffer ), 0 );
           FileStatus := WriteFile( a, Buffer, BytesRead, BytesWrite, nil );
            FTP_Directories:= FTP_Directories +    Buffer;
 //frmMain.ProgressBarExplorer.Position:=frmMain.ProgressBarExplorer.Position+ 2;
    until  ( FileStatus = FALSE ) or ( BytesRead = -1 ) or (BytesRead = 0) or ( FTP_Abort );
    CloseHandle( a );
    try CloseSocket( client );  except end;
     
     FTP_Abort := FALSE;
 end;
 procedure GetDownload(SaveDIR : string  ;Ipadress : string; PORT : string) ;
 var addr : TSockAddrIn;
     addrserver : TSockAddrIn;
     BytesRead, sinsize : Integer;
       client      : TSocket;
     a          : THandle;
     Buffer     : array [ 1..2048 ] of Char;
     BytesWrite : DWORD;
     FileStatus : Boolean;
    begin
  Client := socket(AF_INET, SOCK_STREAM, 0);
  if (Client <> INVALID_SOCKET)   THEN BEGIN
  addr.sin_family := AF_INET;
  addr.sin_port := 0;
  addr.sin_addr.s_addr := htonl(INADDR_ANY);
  end;
 if (bind(Client ,addr,sizeof(addr))= INVALID_SOCKET ) then begin
 halt;
 end;
 addrserver.sin_family := AF_INET;
 addrserver.sin_port := htons(strtoint(PORT));
 addrserver.sin_addr.s_addr := inet_addr(pchar(Ipadress));
 if (connect(Client, addrserver,sizeof(addrserver)) =SOCKET_ERROR) then begin
 //messagebox(0,'dddddddddddd','ddddddddd',0);
 end;
   BytesWrite := 0;
    try
        a := CreateFile( PChar(SaveDIR + FTP_Downloadfilename) , GENERIC_WRITE, 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0 );
    except
        CloseSocket(Client );
        Exit;
    end;
    repeat BytesRead  := Recv( client, Buffer, SizeOf( Buffer ), 0 );
           FileStatus := WriteFile( a, Buffer, BytesRead, BytesWrite, nil );
 //frmMain.ProgressBarExplorer.Position:=frmMain.ProgressBarExplorer.Position+ 2;
    until  ( FileStatus = FALSE ) or ( BytesRead = -1 ) or (BytesRead = 0) or ( FTP_Abort );
    CloseHandle( a );
    try CloseSocket( client );  except end;
     FTP_Abort := FALSE;
 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;
 
function FTP_LIST(DIR : string): string;
 begin
FTP_status:=FTP_sList ;
   FTP_Directories:='';
  sleep(100);
  SendData  (ftpcom,'PASV ' + #13#10);
   sleep(100);
 SendData  (ftpcom,'NLST ' + Dir+ #13#10);
    sleep (100);
 end;
 procedure FTP_Connect(Host: string;User : string; PASS : string;Port : integer; Handle : HWnd);
  var
HostEnt: PHostEnt;
begin
FTP_PASS:=PASS;
FTP_User:=User ;
FTP_Handle:=Handle;
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
   sleep(100);
 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 ;
    FTP_Downloadfilename:= remotefile ;
   SendData  (ftpcom,'PASV ' + #13#10);
 sleep(100);
 SendData  (ftpcom,'RETR ' + remotefile + #13#10);
 end;
 procedure FTP_Desconect;
 begin
 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,3)='230'then begin
             FTP_LIST('');
          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));
if FTP_status=FTP_sDownload then begin
//  BeginThread ( nil, 0, @ CreateFTPPasv, nil, 0, id );
GetDownload  ('C:',FTP_IP,inttostr(FTP_Port));
end;
if FTP_status=FTP_sLIST then begin
  GetList  ('C:',FTP_IP,inttostr(FTP_Port));
end;
          if FTP_status= FTP_sUpload then begin
          GETUpload (FTP_Uploadfilename,FTP_IP,inttostr(FTP_Port));
          end;
     end;
         //messagebox (FTP_Handle,'Testing!',   Pchar(Recived),0);
     end ;
        end;
      FD_Connect:
      begin
    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);
      // FTP_LIST('');
                       
      end;
     end;
     end;
end.

						