idftp.pas

photo.163.com 相册下载器 多线程下载

    FUseExtensionDataPort : Boolean;
    FTryNATFastTrack : Boolean;
    FUseMLIS : Boolean;
    FLangsSupported : TIdStrings;
    FUseCCC: Boolean;
    //is the SSCN Client method on for this connection?
    FSSCNOn : Boolean;

    FOnBannerBeforeLogin : TIdFTPBannerEvent;
    FOnBannerAfterLogin : TIdFTPBannerEvent;

    FTZInfo : TIdFTPTZInfo;

    FCompressor : TIdZLibCompressorBase;
    //ZLib settings
    FZLibCompressionLevel : Integer; //7
    FZLibWindowBits : Integer; //-15
    FZLibMemLevel : Integer; //8
    FZLibStratagy : Integer; //0 - default

    //dir events for some GUI programs.
    //The directory was Retrieved from the FTP server.
    FOnRetrievedDir : TNotifyEvent;
    //parsing is done only when DirectoryListing is referenced
    FOnDirParseStart : TNotifyEvent;
    FOnDirParseEnd : TNotifyEvent;

    procedure DoOnRetrievedDir;
    procedure DoOnDirParseStart;
    procedure DoOnDirParseEnd;

    procedure SetTZInfo(const Value: TIdFTPTZInfo);
    function IsSiteZONESupported : Boolean;
    function IndexOfFeatLine(const AFeatLine : String):Integer;
    procedure ClearSSCN;
    function SetSSCNToOn : Boolean;
    procedure SendInternalPassive(const ACmd : String; var VIP: string; var VPort: integer);
    procedure SendCPassive(var VIP: string; var VPort: integer);
    function FindAuthCmd : String;
    function GetReplyClass:TIdReplyClass; override;
    //
    function EPRTParams(const AIP : String; const APort : Integer; const AIPVersion : TIdIPVersion): String;
    procedure ParseFTPList(AData : TIdStrings);
    procedure SetPassive(const AValue : Boolean);
    procedure SetTryNATFastTrack(const AValue: Boolean);
    procedure DoTryNATFastTrack;
    procedure SetUseExtensionDataPort(const AValue: Boolean);

    procedure SetIPVersion(const AValue: TIdIPVersion); override;
    procedure SetIOHandler(AValue: TIdIOHandler); override;
    function GetSupportsTLS: Boolean; override;

    procedure ConstructDirListing;
    procedure DoAfterLogin;
    procedure DoFTPList;
    procedure DoCustomFTPProxy;
    procedure DoOnBannerAfterLogin(AText : TIdStrings);
    procedure DoOnBannerBeforeLogin(AText : TIdStrings);
    procedure SendPBSZ; //protection buffer size
    procedure SendPROT; //data port protection
    procedure SendDataSettings; //this is for the extensions only;
//    procedure DoCheckListFormat(const ALine: String);
    function GetDirectoryListing: TIdFTPListItems;
//    function GetOnParseCustomListFormat: TIdOnParseCustomListFormat;
    procedure InitDataChannel;
    //PRET is to help distributed FTP systems by letting them know what you will do
    //before issuing a PASV.  See: http://drftpd.mog.se/wiki/wiki.phtml?title=Distributed_PASV#PRE_Transfer_Command_for_Distributed_PASV_Transfers
    //for a discussion.
    procedure SendPret(const ACommand : String);
    procedure InternalGet(const ACommand: string; ADest: TIdStreamVCL; AResume: Boolean = false);
    procedure InternalPut(const ACommand: string; ASource: TIdStreamVCL; AFromBeginning: Boolean = true);
//    procedure SetOnParseCustomListFormat(const AValue: TIdOnParseCustomListFormat);
    procedure SendPassive(var VIP: string; var VPort: integer);
    procedure SendPort(AHandle: TIdSocketHandle); overload;
    procedure SendPort(const AIP : String; const APort : Integer); overload;
    procedure ParseEPSV(const AReply : String; var VIP : String; VPort : Integer);
    //These two are for RFC 2428.txt
    procedure SendEPort(AHandle: TIdSocketHandle); overload;
    procedure SendEPort(const AIP : String; const APort : Integer; const AIPVersion : TIdIPVersion); overload;
    procedure SendEPassive(var VIP: string; var VPort: integer);
    procedure SetProxySettings(const Value: TIdFtpProxySettings);
    procedure SetClientInfo(const AValue: TIdFTPClientIdentifier);
    procedure SendTransferType;
    procedure SetTransferType(AValue: TIdFTPTransferType);
    procedure DoBeforeGet; virtual;
    procedure DoBeforePut (AStream: TStream); virtual;
    procedure DoAfterGet (AStream: TStream); virtual; //APR
    procedure DoAfterPut; virtual;
    function IsValidOTPString(const AResponse:string):boolean;
    function GenerateOTP(const AResponse:string; const APassword:string):string;
    procedure FXPSetTransferPorts(AFromSite, AToSite: TIdFTP;
      const ATargetUsesPasv : Boolean);
    procedure FXPSendFile(AFromSite, AToSite: TIdFTP;
      const ASourceFile, ADestFile: String);
    function InternalEncryptedTLSFXP(AFromSite, AToSite: TIdFTP; const ASourceFile,
      ADestFile: String; const ATargetUsesPasv : Boolean) : Boolean;
    function InternalUnencryptedFXP(AFromSite, AToSite: TIdFTP; const ASourceFile,
      ADestFile: String; const ATargetUsesPasv : Boolean): Boolean;
    function ValidateInternalIsTLSFXP(AFromSite, AToSite: TIdFTP; const ATargetUsesPasv : Boolean): Boolean;
    procedure InitComponent; override;
    procedure SetUseTLS(AValue : TIdUseTLS); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetDataPortProtection(AValue : TIdFTPDataPortSecurity);
    procedure SetAUTHCmd(const AValue : TAuthCmd);
    procedure SetUseCCC(const AValue: Boolean);
  public
    function IsExtSupported(const ACmd : String):Boolean;
    procedure ExtractFeatFacts(const ACmd : String; AResults : TIdStrings);
    //this function transparantly handles OTP based on the Last command response
    //so it needs to be called only after the USER command or equivilent.

    function GetLoginPassword : String; overload;
    function GetLoginPassword(const APrompt : String) : String; overload;
    procedure Abort; virtual;
    procedure Account(AInfo: String);
    procedure Allocate(AAllocateBytes: Integer);
    procedure ChangeDir(const ADirName: string);
    procedure ChangeDirUp;
    procedure Connect; override;
    destructor Destroy; override;
    procedure Delete(const AFilename: string);
    procedure FileStructure(AStructure: TIdFTPDataStructure);
    procedure Get(const ASourceFile: string; ADest: TIdStreamVCL; AResume: Boolean = false); overload;
    procedure Get(const ASourceFile: string; ADest: TStream; AResume: Boolean = false); overload;
    procedure Get(const ASourceFile, ADestFile: string; const ACanOverwrite: boolean = false; AResume: Boolean = false); overload;
    procedure Help(var AHelpContents: TIdStringList; ACommand: String = '');
    procedure KillDataChannel; virtual;
    procedure List; overload; //.NET Overload
    procedure List(  //.NET Overload
      const ASpecifier: string;
      ADetails: Boolean = True); overload;
    procedure List(
      ADest: TIdStrings;
      const ASpecifier: string = '';
      ADetails: Boolean = True); overload;
    procedure ExtListDir(const ADest: TIdStrings=nil; const ADirectory: string = '');
    procedure ExtListItem(ADest: TIdStrings; AFList : TIdFTPListItems; const AItem: string='');  overload;
    procedure ExtListItem(ADest: TIdStrings; const AItem: string = ''); overload;
    procedure ExtListItem(AFList : TIdFTPListItems; const AItem : String= ''); overload;
    function  FileDate(const AFileName : String; const AsGMT : Boolean = False): TDateTime;

    procedure Login;
    procedure MakeDir(const ADirName: string);
    procedure Noop;
    procedure SetCMDOpt(const ACMD, AOptions : String);
    procedure Put(const ASource: TIdStreamVCL; const ADestFile: string;
     const AAppend: boolean = false); overload;
    procedure Put(const ASource: TStream; const ADestFile: string;
     const AAppend: boolean = false); overload;
    procedure Put(const ASourceFile: string; const ADestFile: string = '';
     const AAppend: boolean = false); overload;

    procedure StoreUnique(const ASource: TIdStreamVCL); overload;
    procedure StoreUnique(const ASource: TStream); overload;
    procedure StoreUnique(const ASourceFile: string); overload;

    procedure SiteToSiteUpload(const AToSite : TIdFTP; const ASourceFile : String; const ADestFile : String = '');
    procedure SiteToSiteDownload(const AFromSite: TIdFTP; const ASourceFile : String; const ADestFile : String = '');

    procedure Quit;
    function  Quote(const ACommand: String): SmallInt;
    procedure RemoveDir(const ADirName: string);
    procedure Rename(const ASourceFile, ADestFile: string);
    function  ResumeSupported: Boolean;
    function  RetrieveCurrentDir: string;
    procedure Site(const ACommand: string);
    function  Size(const AFileName: String): Integer;
    procedure Status(AStatusList: TIdStrings);
    procedure StructureMount(APath: String);
    procedure TransferMode(ATransferMode: TIdFTPTransferMode);
    procedure ReInitialize(ADelay: Cardinal = 10);
    procedure SetLang(const ALangTag : String);
    function CRC(const AFIleName : String; const AStartPoint : Cardinal = 0; const AEndPoint : Cardinal=0) : Int64;
    //file parts must be in order in TIdStrings parameter
    //GlobalScape FTP Pro uses this for multipart simultanious file uploading
    procedure CombineFiles(const ATargetFile : String; AFileParts : TIdStrings);
    //Set modified file time.
    procedure SetModTime(const AFileName: String; const ALocalTime: TDateTime);
    procedure SetModTimeGMT(const AFileName : String; const AGMTTime: TDateTime);
    // servers that support MDTM yyyymmddhhmmss[+-xxx] and also support LIST -T
    //This is true for servers that are known to support these even if they aren't
    //listed in the FEAT reply.
    function IsServerMDTZAndListTForm : Boolean;

    //
    property CanResume: Boolean read ResumeSupported;
    property DirectoryListing: TIdFTPListItems read GetDirectoryListing;
    property DirFormat : String read FDirFormat;
    property LangsSupported : TIdStrings read FLangsSupported;
    property ListParserClass : TIdFTPListParseClass read FListParserClass write FListParserClass;
    property LoginMsg: TIdReplyFTP read FLoginMsg;
    property ListResult: TIdStrings read FListResult;
    property SystemDesc: string read FSystemDesc;
    property TZInfo : TIdFTPTZInfo read FTZInfo write SetTZInfo;
    property UsingExtDataPort : Boolean read FUsingExtDataPort;
    property UsingNATFastTrack : Boolean read FUsingNATFastTrack;
    property UsingSFTP : Boolean read FUsingSFTP;
    property CurrentTransferMode : TIdFTPTransferMode read FCurrentTransferMode write TransferMode;
  published
    property AutoLogin: Boolean read FAutoLogin write FAutoLogin;
    // This is an object that can compress and decompress HTTP Deflate encoding
    property Compressor : TIdZLibCompressorBase read FCompressor write FCompressor;
    property Host;
    property UseCCC : Boolean read FUseCCC write SetUseCCC default DEF_Id_FTP_UseCCC;
    property Passive: boolean read FPassive write SetPassive default Id_TIdFTP_Passive;
    property DataPortProtection : TIdFTPDataPortSecurity read FDataPortProtection write SetDataPortProtection default Id_TIdFTP_DataPortProtection;
    property AUTHCmd : TAuthCmd read FAUTHCmd write SetAUTHCmd default DEF_Id_FTP_AUTH_CMD;
    property DataPort: Integer read FDataPort write FDataPort default 0;
    property DataPortMin: Integer read FDataPortMin write FDataPortMin default 0;
    property DataPortMax: Integer read FDataPortMax write FDataPortMax default 0;
    property ExternalIP : String read FExternalIP write FExternalIP;
    property Password;
    property TransferType: TIdFTPTransferType read FTransferType write SetTransferType default Id_TIdFTP_TransferType;
    property TransferTimeout: Integer read FTransferTimeout write FTransferTimeout default IdDefTimeout;
    property Username;
    property Port default IDPORT_FTP;
    property UseExtensionDataPort : Boolean read FUseExtensionDataPort write SetUseExtensionDataPort default DEF_Id_TIdFTP_UseExtendedData;
    property UseMLIS : Boolean read FUseMLIS write FUseMLIS default DEF_Id_TIdFTP_UseMIS;
    property TryNATFastTrack : Boolean read FTryNATFastTrack write SetTryNATFastTrack default Id_TIdFTP_UseNATFastTrack;
    property ProxySettings: TIdFtpProxySettings read FProxySettings write SetProxySettings;
    property ClientInfo : TIdFTPClientIdentifier read FClientInfo write SetClientInfo;
    property UseTLS;
    property OnTLSNotAvailable;

    property OnBannerBeforeLogin : TIdFTPBannerEvent read FOnBannerBeforeLogin write FOnBannerBeforeLogin;
    property OnBannerAfterLogin : TIdFTPBannerEvent read FOnBannerAfterLogin write FOnBannerAfterLogin;

    property OnAfterClientLogin: TOnAfterClientLogin read FOnAfterClientLogin write FOnAfterClientLogin;
    property OnCreateFTPList: TIdCreateFTPList read FOnCreateFTPList write FOnCreateFTPList;
    property OnAfterGet: TIdFtpAfterGet read FOnAfterGet write FOnAfterGet; //APR
    property OnCustomFTPProxy : TNotifyEvent read FOnCustomFTPProxy write FOnCustomFTPProxy;
    property OnDataChannelCreate:TIdOnDataChannelCreate read FOnDataChannelCreate write FOnDataChannelCreate;
    property OnDataChannelDestroy:TIdOnDataChannelDestroy read FOnDataChannelDestroy write FOnDataChannelDestroy;
    //The directory was Retrieved from the FTP server.
    property OnRetrievedDir : TNotifyEvent read FOnRetrievedDir write FOnRetrievedDir;
    //parsing is done only when DirectoryLiusting is referenced
    property OnDirParseStart : TNotifyEvent read FOnDirParseStart write FOnDirParseStart;
    property OnDirParseEnd : TNotifyEvent read FOnDirParseEnd write FOnDirParseEnd;
  end;

  EIdFTPException = class(EIdException);
  EIdFTPFileAlreadyExists = class(EIdFTPException);
  EIdFTPMustUseExtWithIPv6 = class(EIdFTPException);
  EIdFTPMustUseExtWithNATFastTrack = class(EIdFTPException);
  EIdFTPPassiveMustBeTrueWithNATFT = class(EIdFTPException);
  EIdFTPServerSentInvalidPort = class(EIdFTPException);
  EIdFTPSiteToSiteTransfer = class(EIdFTPException);
  EIdFTPSToSNATFastTrack = class(EIdFTPSiteToSiteTransfer);
  EIdFTPSToSNoDataProtection = class(EIdFTPSiteToSiteTransfer);
  EIdFTPSToSIPProtoMustBeSame = class(EIdFTPSiteToSiteTransfer);
  EIdFTPSToSBothMostSupportSSCN = class(EIdFTPSiteToSiteTransfer);
  EIdFTPSToSTransModesMustBeSame = class(EIdFTPSiteToSiteTransfer);
  EIdFTPUnknownOTPMethodException = class(EIdFTPException);
  EIdFTPOnCustomFTPProxyRequired = class(EIdFTPException);
  EIdFTPConnAssuranceFailure = class(EIdFTPException);
  EIdFTPWrongIOHandler = class(EIdFTPException);
  EIdFTPUploadFileNameCanNotBeEmpty = class(EIdFTPException);

  EIdFTPDataPortProtection = class(EIdFTPException);
  EIdFTPNoDataPortProtectionAfterCCC = class(EIdFTPDataPortProtection);
  EIdFTPNoDataPortProtectionWOEncryption = class(EIdFTPDataPortProtection);
  EIdFTPNoCCCWOEncryption = class(EIdFTPException);
  EIdFTPAUTHException = class(EIdFTPException);
  EIdFTPNoAUTHWOSSL = class(EIdFTPAUTHException);
  EIdFTPCanNotSetAUTHCon = class(EIdFTPAUTHException);

implementation

uses
  IdComponent, IdResourceStringsCore, IdIOHandlerStack, IdResourceStringsProtocols,
  IdSSL, IdGlobalProtocols,
  IdStack, IdSimpleServer,
  SysUtils, IdOTPCalculator;

function CleanDirName(const APWDReply: string): string;
begin
  Result := APWDReply;
  Delete(result, 1, IndyPos('"', result)); // Remove first doublequote                             {do not localize}
  Result := Copy(result, 1, IndyPos('"', result) - 1); // Remove anything from second doublequote  {do not localize}                               // to end of line
end;

function TIdFTP.IsValidOTPString(const AResponse:string):boolean;
var LChallenge:string;
    LChallengeStartPos:integer;
    LMethod:string;
begin
  LChallengeStartPos := pos('otp-',AResponse);  {do not localize}
  if LChallengeStartPos>0 then begin
    inc(LChallengeStartPos,4); // to remove "otp-"
    LChallenge:=copy(AResponse,LChallengeStartPos,$FFFF);
    LMethod:=Fetch(LChallenge);
    result := (LMethod='md4') or (LMethod='md5') or (LMethod='sha1'); // methods are case sensitive  {do not localize}
  end else result:=false;
end;


function TIdFTP.GenerateOTP(const AResponse:string; const APassword:string):string;
var LChallenge:string;
    LChallengeStartPos:integer;
    LMethod:string;
    LSeed:string;
    LCount:integer;
begin
  LChallengeStartPos := pos('otp-', AResponse);  {do not localize}
  if LChallengeStartPos > 0 then begin
    inc(LChallengeStartPos, 4); // to remove "otp-"
    LChallenge := copy(AResponse,LChallengeStartPos, $FFFF);
    LMethod := Fetch(LChallenge);
    LCount := StrToInt(Fetch(LChallenge));
    LSeed := Fetch(LChallenge);
    if LMethod = 'md5' then // methods are case sensitive   {do not localize}
    begin
      Result := TIdOTPCalculator.ToSixWordFormat(TIdOTPCalculator.GenerateKeyMD5(lseed,APassword,LCount))
    end
    else
    begin
      if LMethod = 'md4' then {do not localize}
      begin
        Result := TIdOTPCalculator.ToSixWordFormat(TIdOTPCalculator.GenerateKeyMD4(lseed,APassword,LCount))
      end
      else
      begin
        if LMethod = 'sha1' then  {do not localize}
        begin
           Result := TIdOTPCalculator.ToSixWordFormat(TIdOTPCalculator.GenerateKeySHA1(lseed,APassword,LCount))
        end
        else
        begin
          Raise EIdFTPUnknownOTPMethodException.Create(RSFTPOTPMethod);
        end;
      end;
    end;
  end;
end;

procedure TIdFTP.InitComponent;
begin
  inherited;
  //
  FAutoLogin := True;
  FRegularProtPort := IdPORT_FTP;
  FImplicitTLSProtPort := IdPORT_ftps;
  //
  Port := IDPORT_FTP;
  Passive := Id_TIdFTP_Passive;

  FDataPortProtection := Id_TIdFTP_DataPortProtection;
  FUseCCC := DEF_Id_FTP_UseCCC;
  FAUTHCmd := DEF_Id_FTP_AUTH_CMD;

  FDataPort := 0;
  FDataPortMin := 0;
  FDataPortMax := 0;
  FUseExtensionDataPort := DEF_Id_TIdFTP_UseExtendedData;
  FTryNATFastTrack := Id_TIdFTP_UseNATFastTrack;
  FTransferType := Id_TIdFTP_TransferType;
  FTransferTimeout := IdDefTimeout;
  FLoginMsg := TIdReplyFTP.Create(NIL);