ftp.pas

Monster FTP Client 强大的ftp客户控件,支持Proxy等

   if DataSocket.IsConnected then DataSocket.Disconnect;
   if ListeningSocket.IsConnected then ListeningSocket.Disconnect;
   if IsConnected then Disconnect;
end;

procedure TMFtp.FtpLogin;
var i, j: Integer;
    s, fsyst: String;
begin
   if line = '' then Exit;

   if Intermediate and (Copy(line, 1, 4) <> Response + ' ') then Exit;
   if Line[4] = '-' then
   begin
      Intermediate := True;
      Response := Copy(line, 1, 3);
      Exit;
   end;
   Intermediate := False;

   case Step of
      0: {banner}
      begin
         if URLMode = 0 then FtpLastAction := ftplaLOGIN else UrlMode := 2;
         if line[1] <> '2' then
            FatalError(ftpServerDown)
         else
         begin
            if (FUser = '') and Assigned(NeedInfo) then NeedInfo(Self, niUser, FUser);
            if FProxyType <> proxyNone then
            begin
               Server := FtpServer;
               Port := FtpPort;
            end
            else
            begin
               if FType = ftpstAutoDetect then
               begin
                  if Pos('NetTerm FTP server', line) <> 0 then FType := ftpstNetTerm;
               end;
            end;
            case FProxyType of
               proxyOpen:
               begin
                  Proceed('OPEN ' + Server, 900);
               end;
               proxySite:
               begin
                  Proceed('USER ' + FPUser, 910);
               end;
               proxyUserSite:
               begin
                  {USER username@site:port}
                  if Port = 21 then
                     Proceed('USER ' + FUser + '@' + Server, 1)
                  else
                     Proceed('USER ' + FUser + '@' + Server + ':' + IntToStr(Port), 1);
               end;
               proxyHost:
               begin
                  {Actually, it is a way to implement vitual server on the same IP and port}
                  Proceed('HOST ' + Server, 901);
               end;
               proxyHostUser:
               begin
                  {USER host:port!username}
                  if Port = 21 then
                     Proceed('USER ' + Server + '!' + FUser, 1)
                  else
                     Proceed('USER ' + Server + ':' + IntToStr(Port) + '!' + FUser, 1);
               end;
               else
               begin
                  Proceed('USER ' + FUser, 1);
               end;
            end;
         end;
      end;
      1: {USER}
      begin
         if line[1] = '2' then
            if FType = ftpstAutoDetect then
               Proceed('SYST', 5)
            else
               Proceed('REST 100', 110)
         else
         begin
            if line[1] <> '3' then
            begin
               FatalError(ftpAccessDenied);
            end
            else
            begin
               if (FPass = '') and Assigned(NeedInfo) then NeedInfo(Self, niPassword, FPass);
               Proceed('PASS ' + FPass, 2);
            end;
         end;
      end;
      2: {PASS}
      begin
         if line[1] = '2' then
            if FType = ftpstAutoDetect then
               Proceed('SYST', 5)
            else
               Proceed('REST 100', 110)
         else
            if line[1] <> '3' then
            begin
               FatalError(ftpAccessDenied);
            end
            else
            begin
               if (FAcct = '') and Assigned(NeedInfo) then NeedInfo(Self, niAccount, FAcct);
               Proceed('ACCT ' + FAcct, 3);
            end;
      end;
      3: {ACCT}
      begin
         if line[1] = '2' then
            if FType = ftpstAutoDetect then
               Proceed('SYST', 5)
            else
               Proceed('REST 100', 110)
         else
         begin
            FatalError(ftpAccessDenied);
         end
      end;
      5: {following a SYST}
      begin
         if line[1] <> '5' then
         begin
            if FType = ftpstAutoDetect then
            begin
               FSyst := UpperCase(Copy(line, 5, 99));
               FType := ftpstDefault;
               if Pos('UNIX', FSyst) <> 0 then FType := ftpstUnix else
               if Pos('BSD', FSyst) <> 0 then FType := ftpstBSD else
               if Pos('SUNOS', FSyst) <> 0 then FType := ftpstSunOS else
               if Pos('CLIX', FSyst) <> 0 then FType := ftpstClix else
               if Pos('ULTRIX', FSyst) <> 0 then FType := ftpstUltrix else
               if Pos('MVS', FSyst) <> 0 then FType := ftpstMVS else
               if Pos('QVT', FSyst) <> 0 then FType := ftpstQVT else
               if Pos('NCSA', FSyst) <> 0 then FType := ftpstNCSA else
               if Pos('WFTPD', FSyst) <> 0 then FType := ftpstWFTPD else
               if Pos('WINDWOS_NT', FSyst) <> 0 then FType := ftpstMSFTP else
               if Pos('CHAMELEON', FSyst) <> 0 then FType := ftpstChameleon else
               if Pos('VMS', FSyst) <> 0 then
                  if Pos('MULTINET', FSyst) <> 0 then
                     FType := ftpstVmsMultinet
                  else
                     FType := ftpstVmsUcx
               else
               begin
                  if Pos('VM', Fsyst) <> 0 then
                  begin
                     if Pos('VPS', FSyst) = 0 then
                        FType := ftpstVM
                     else
                        FType := ftpstVMVPS;
                  end;
               end;
            end;
         end
         else
         begin
            FType := ftpstDefault;
         end;

         Proceed('REST 100', 110);
      end;
      6: {logged in here}
      begin
         if FDirectory = '' then
         begin
            if line[1] = '2' then
            begin
               FDirectory := Copy(line, Pos('"', line) + 1, 999);
               FDirectory := Copy(FDirectory, 1, Pos('"', FDirectory) - 1);

               if (FType = ftpstNetTerm) or (FType = ftpstServU) then
                  FDirectory := DOSName2UnixName(FDirectory);
            end
            else
               FatalError(ftpProtocolError);
         end
         else
         begin
            if line[1] <> '2' then
               DoFtpInfo(ftpPermissionDenied, '');
         end;
         DoFtpInfo(ftpLoggedIn, '');

         Step := 100;
         Ready;
      end;
      8: {TYPE A, in preparation for listing}
      begin
         ReadyMain := False;
         ReadyPort := False;
         if line[1] = '2' then
            if FPassive then
            begin
               pStep := 10;
               Proceed('PASV', 13)
            end
            else
               Proceed('PORT ' + SetupDataPort, 10)
         else
            FatalError(ftpProtocolError);
      end;
      10: {following a PORT}
      begin
         if line[1] <> '2' then
            FatalError(ftpProtocolError)
         else
         begin
            with DataSocket do
            begin
               OnReadReady := DataDoListing;
               OnDisconnected := DataListDisconnected;
               OnWriteReady := nil;
               if FPassive then
                  OnConnected := DataListConnected
               else
                  ListeningSocket.OnAccept := DataListConnected;
            end;
            FList.Clear;
            FFiles.Clear;
            FFilesInfo.Clear;
            FDirectories.Clear;
            FDirectoriesInfo.Clear;
            if FFileMask <> '' then
               Proceed('LIST ' + FFileMask, 12)
            else
               Proceed('LIST', 12);
         end;
      end;
      12: {following a LIST}
      begin
         if line[1] = '1' then Exit;
         if line[1] = '2' then
         begin
            ReadyMain := True;
            if ReadyPort then Ready;
         end
         else
         begin
            DataSocket.Disconnect; {close data connection}
            ListeningSocket.Disconnect;
            if (Aborted) and (Copy(Line, 1, 3) = '426') then
            begin
               if Assigned(FAborted) then FAborted(Self);
               CallNEvents(13);
            end
            else
            begin
               DoFtpInfo(ftpPermissionDenied, '');
               FSuccess := False;
            end;
            Ready;
         end;
      end;
      13: {passive mode}
      begin
         if line[1] = '2' then
         begin
            SetupDataPortPassive(line);
            Step := pStep;
            FTPProc('299');
         end
         else
         begin
            FatalError(ftpProtocolError);
            FSuccess := False;
         end;
      end;
      20: {size checking}
      begin
         DownloadSize := 0;
         if Assigned(NeedInfo) then NeedInfo(self, niOverwrite, s);
         if s = 'Resume' then
         begin
            if FSupportResume then
            begin
               if Supports[2] then
               begin
                  Proceed('SIZE ' + FSelection, 120);
               end
               else
               begin
                  Step := 120;
                  FTPLogin('500');
               end;
            end
            else
            begin
               DoFtpInfo(ftpNotSupportResume, '');
               FileOpened := False;
               CloseFile(datafile);
               FTPLastAction := ftplaNone;
               Ready;
            end;
         end
         else
         begin
            if (s = 'Overwrite') or (s = '') then
            begin
               Step := 21;
               FTPProc('299');
            end
            else
            begin
               FileOpened := False;
               CloseFile(datafile);
               FTPLastAction := ftplaNone;
               Ready;
            end;
         end;
      end;
      21: {start of download operation}
      begin
         if line[1] = '2' then
            if FPassive then
            begin
               pStep := 22;
               Proceed('PASV', 13)
            end
            else
               Proceed('PORT ' + SetupDataPort, 22)
         else
            FatalError(ftpProtocolError);
      end;
      22: {following a PORT}
      begin
         if line[1] <> '2' then
            FatalError(ftpProtocolError)
         else
         begin
            with DataSocket do
            begin
               OnReadReady := DataRetrFile;
               OnDisconnected := DataFileDisconnected;
               OnWriteReady := nil;
               if FPassive then
                  OnConnected := DataListConnected
               else
                  ListeningSocket.OnAccept := DataListConnected;
            end;
            Proceed('RETR ' + FSelection, 23);
         end;
      end;
      23: {following a RETR}
      begin
         if line[1] = '1' then
         begin
            i := Pos('(', line);
            for j := i to Length(line) do
            begin
               if line[j] = ' ' then
               begin
                  DoFtpInfo(ftpFileSize, Copy(line, i + 1, j - i - 1));
                  Exit;
               end;
            end;
            Exit;
         end;
         if line[1] = '2' then
         begin
            ReadyMain := True;
            if ReadyPort then Ready;
            Step := 100;
         end
         else
         begin
            DataSocket.Disconnect; {close data connection}
            ListeningSocket.Disconnect;
            if (Aborted) and (Copy(Line, 1, 3) = '426') then
            begin
               if Assigned(FAborted) then FAborted(Self);
               CallNEvents(13);
            end
            else
            begin
               DoFtpInfo(ftpPermissionDenied, '');
               FSuccess := False;
            end;
            Ready;
         end;
      end;
      30: {size checking}
      begin
         UploadSize := 0;
         if (FSupportResume) and (Supports[2]) then
            Proceed('SIZE ' + FSelection, 130)
         else
         begin
            Step := 31;
            FTPProc('299');
         end;
      end;
      31: {start of upload operation}
      begin
         ReadyPort := False;
         ReadyMain := False;
         if line[1] = '2' then
            if FPassive then
            begin
               pStep := 32;
               Proceed('PASV', 13)
            end
            else
               Proceed('PORT ' + SetupDataPort, 32)
         else
            FatalError(ftpProtocolError);
      end;
      32: {following a PORT}
      begin
         if line[1] <> '2' then
         begin
            FatalError(ftpProtocolError);
            FSuccess := False;
         end
         else
         begin
            with DataSocket do
            begin
               OnReadReady := nil;
               OnDisconnected := DataFileDisconnected;
            {$ifdef BDS}
               OnWriteReady := DataStorFile;
               if FPassive then
                  OnConnected := DataStorConnected
               else
                  ListeningSocket.OnAccept := DataStorConnected;
            {$else}
               if FPassive then
               begin
                  OnWriteReady := DataStorConnected;
                  OnConnected := DataListConnected;
               end
               else
               begin
                  OnWriteReady := nil;
                  ListeningSocket.OnAccept := DataStorConnected;
               end;
            {$endif}
            end;
            Proceed('STOR ' + FSelection, 33);
         end;