{ $Project$ $Workfile$ $Revision$ $DateUTC$ $Id$ This file is part of the Indy (Internet Direct) project, and is offered under the dual-licensing agreement described on the Indy website. (http://www.indyproject.org/) Copyright: (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. } { $Log$ } { Rev 1.126 4/28/2005 BTaylor Changed .Size to use Int64 Rev 1.125 4/15/2005 9:10:10 AM JPMugaas Changed the default timeout in TIdFTP to one minute and made a comment about this. Some firewalls don't handle control connections properly during long data transfers. They will timeout the control connection because it's idle and making it worse is that they will chop off a connection instead of closing it causing TIdFTP to wait forever for nothing. Rev 1.124 3/20/2005 10:42:44 PM JPMugaas Marked TIdFTP.Quit as deprecated. We need to keep it only for compatibility. Rev 1.123 3/20/2005 2:44:08 PM JPMugaas Should now send quit. Verified here. Rev 1.122 3/12/2005 6:57:12 PM JPMugaas Attempt to add ACCT support for firewalls. I also used some logic from some WS-FTP Pro about ACCT to be more consistant with those Firescripts. Rev 1.121 3/10/2005 2:41:12 PM JPMugaas Removed the UseTelnetAbort property. It turns out that sending the sequence is causing problems on a few servers. I have made a comment about this in the source-code so someone later on will know why I decided not to send those. Rev 1.120 3/9/2005 10:05:54 PM JPMugaas Minor changes for Indy conventions. Rev 1.119 3/9/2005 9:15:46 PM JPMugaas Changes submitted by Craig Peterson, Scooter Software He noted this: "We had a user who's FTP server prompted for account info after a regular login, so I had to add an explicit Account string property and an OnNeedAccount event that we could use for a prompt." This does break any code using TIdFTP.Account. TODO: See about integrating Account Info into the proxy login sequences. Rev 1.118 3/9/2005 10:40:16 AM JPMugaas Made comment explaining why I had made a workaround in a procedure. Rev 1.117 3/9/2005 10:28:32 AM JPMugaas Fix for Abort problem when uploading. A workaround I made for WS-FTP Pro Server was not done correctly. Rev 1.116 3/9/2005 1:21:38 AM JPMugaas Made refinement to Abort and the data transfers to follow what Kudzu had originally done in Indy 8. I also fixed a problem with ABOR at ftp.ipswitch.com and I fixed a regression at ftp.marist.edu that occured when getting a directory. Rev 1.115 3/8/2005 12:14:50 PM JPMugaas Renamed UseOOBAbort to UseTelnetAbort because that's more accurate. We still don't support Out of Band Data (hopefully, we'll never have to do that). Rev 1.114 3/7/2005 10:40:10 PM JPMugaas Improvements: 1) Removed some duplicate code. 2) ABOR should now be properly handled outside of a data operation. 3) I added a UseOOBAbort read-write public property for controlling how the ABOR command is sent. If true, the Telnet sequences are sent or if false, the ABOR without sequences is sent. This is set to false by default because one FTP client (SmartFTP recently removed the Telnet sequences from their program). This code is expiriemental. Rev 1.113 3/7/2005 5:46:34 PM JPMugaas Reworked FTP Abort code to make it more threadsafe and make abort work. This is PRELIMINARY. Rev 1.112 3/5/2005 3:33:56 PM JPMugaas Fix for some compiler warnings having to do with TStream.Read being platform specific. This was fixed by changing the Compressor API to use TIdStreamVCL instead of TStream. I also made appropriate adjustments to other units for this. Rev 1.111 2/24/2005 6:46:36 AM JPMugaas Clarrified remarks I made and added a few more comments about syntax in particular cases in the set modified file date procedures. That's really been a ball....NOT!!!! Rev 1.110 2/24/2005 6:25:08 AM JPMugaas Attempt to fix problem setting Date with Titan FTP Server. I had made an incorrect assumption about MDTM on that system. It uses Syntax 3 (see my earlier note above the File Date Set problem. Rev 1.109 2/23/2005 6:32:54 PM JPMugaas Made note about MDTM syntax inconsistancy. There's a discussion about it. Rev 1.108 2/12/2005 8:08:04 AM JPMugaas Attempt to fix MDTM bug where msec was being sent. Rev 1.107 1/12/2005 11:26:44 AM JPMugaas Memory Leak fix when processing MLSD output and some minor tweeks Remy had E-Mailed me last night. Rev 1.106 11/18/2004 2:39:32 PM JPMugaas Support for another FTP Proxy type. Rev 1.105 11/18/2004 12:18:50 AM JPMugaas Fixed compile error. Rev 1.104 11/17/2004 3:59:22 PM JPMugaas Fixed a TODO item about FTP Proxy support with a "Transparent" proxy. I think you connect to the regular host and the firewall will intercept its login information. Rev 1.103 11/16/2004 7:31:52 AM JPMugaas Made a comment noting that UserSite is the same as USER after login for later reference. Rev 1.102 11/5/2004 1:54:42 AM JPMugaas Minor adjustment - should not detect TitanFTPD better (tested at: ftp.southrivertech.com). If MLSD is being used, SITE ZONE will not be issued. It's not needed because the MLSD spec indicates the time is based on GMT. Rev 1.101 10/27/2004 12:58:08 AM JPMugaas Improvement from Tobias Giesen http://www.superflexible.com His notation is below: "here's a fix for TIdFTP.IndexOfFeatLine. It does not work the way it is used in TIdFTP.SetModTime, because it only compares the first word of the FeatLine." Rev 1.100 10/26/2004 9:19:10 PM JPMugaas Fixed references. Rev 1.99 9/16/2004 3:24:04 AM JPMugaas TIdFTP now compresses to the IOHandler and decompresses from the IOHandler. Noted some that the ZLib code is based was taken from ZLibEx. Rev 1.98 9/13/2004 12:15:42 AM JPMugaas Now should be able to handle some values better as suggested by Michael J. Leave. Rev 1.97 9/11/2004 10:58:06 AM JPMugaas FTP now decompresses output directly to the IOHandler. Rev 1.96 9/10/2004 7:37:42 PM JPMugaas Fixed a bug. We needed to set Passthrough instead of calling StartSSL. This was causing a SSL problem with upload. Rev 1.95 8/2/04 5:56:16 PM RLebeau Tweaks to TIdFTP.InitDataChannel() Rev 1.94 7/30/2004 1:55:04 AM DSiders Corrected DoOnRetrievedDir naming. Rev 1.93 7/30/2004 12:36:32 AM DSiders Corrected spelling in OnRetrievedDir, DoOnRetrievedDir declarations. Rev 1.92 7/29/2004 2:15:28 AM JPMugaas New property for controlling what AUTH command is sent. Fixed some minor issues with FTP properties. Some were not set to defaults causing unpredictable results -- OOPS!!! Rev 1.91 7/29/2004 12:04:40 AM JPMugaas New events for Get and Put as suggested by Don Sides and to complement an event done by APR. Rev 1.90 7/28/2004 10:16:14 AM JPMugaas New events for determining when a listing is finished and when the dir parsing begins and ends. Dir parsing is done sometimes when DirectoryListing is referenced. Rev 1.89 7/27/2004 2:03:54 AM JPMugaas New property: ExternalIP - used to specify an IP address for the PORT and EPRT commands. This should be blank unless you are behind a NAT and you need to use PORT transfers with SSL. You would set ExternalIP to the NAT's IP address on the Internet. The idea is this: 1) You set up your NAT to forward a range ports ports to your computer behind the NAT. 2) You specify that a port range with the DataPortMin and DataPortMin properties. 3) You set ExternalIP to the NAT's Internet IP address. I have verified this with Indy and WS FTP Pro behind a NAT router. Rev 1.88 7/23/04 7:09:50 PM RLebeau Bug fix for TFileStream access rights in Get() Rev 1.87 7/18/2004 3:00:12 PM DSiders Added localization comments. Rev 1.86 7/16/2004 4:28:40 AM JPMugaas CCC Support in TIdFTP to complement that capability in TIdFTPServer. Rev 1.85 7/13/04 6:48:14 PM RLebeau Added support for new DataPort and DataPortMin/Max properties Rev 1.84 7/6/2004 4:51:46 PM DSiders Corrected spelling of Challenge in properties, methods, types. Rev 1.83 7/3/2004 3:15:50 AM JPMugaas Checked in so everyone else can work on stuff while I'm away. Rev 1.82 6/27/2004 1:45:38 AM JPMugaas Can now optionally support LastAccessTime like Smartftp's FTP Server could. I also made the MLST listing object and parser support this as well. Rev 1.81 6/20/2004 8:31:58 PM JPMugaas New events for reporting greeting and after login banners during the login sequence. Rev 1.80 6/20/2004 6:56:42 PM JPMugaas Start oin attempt to support FXP with Deflate compression. More work will need to be done. Rev 1.79 6/17/2004 3:42:32 PM JPMugaas Adjusted code for removal of dmBlock and dmCompressed. Made TransferMode a property. Note that the Set method is odd because I am trying to keep compatibility with older Indy versions. Rev 1.78 6/14/2004 6:19:02 PM JPMugaas This now refers to TIdStreamVCL when downloading isntead of directly to a memory stream when compressing data. Rev 1.77 6/14/2004 8:34:52 AM JPMugaas Fix for AV on Put with Passive := True. Rev 1.76 6/11/2004 9:34:12 AM DSiders Added "Do not Localize" comments. Rev 1.75 2004.05.20 11:37:16 AM czhower IdStreamVCL Rev 1.74 5/6/2004 6:54:26 PM JPMugaas FTP Port transfers with TransparentProxies is enabled. This only works if the TransparentProxy supports a "bind" request. Rev 1.73 5/4/2004 11:16:28 AM JPMugaas TransferTimeout property added and enabled (Bug 96). Rev 1.72 5/4/2004 11:07:12 AM JPMugaas Timeouts should now be reenabled in TIdFTP. Rev 1.71 4/19/2004 5:05:02 PM JPMugaas Class rework Kudzu wanted. Rev 1.70 2004.04.16 9:31:42 PM czhower Remove unnecessary duplicate string parsing and replaced with .assign. Rev 1.69 2004.04.15 7:09:04 PM czhower .NET overloads Rev 1.68 4/15/2004 9:46:48 AM JPMugaas List no longer requires a TStrings. It turns out that it was an optional parameter. Rev 1.67 2004.04.15 2:03:28 PM czhower Removed login param from connect and made it a prop like POP3. Rev 1.66 3/3/2004 5:57:40 AM JPMugaas Some IFDEF excluses were removed because the functionality is now in DotNET. Rev 1.65 2004.03.03 11:54:26 AM czhower IdStream change Rev 1.64 2/20/2004 1:01:06 PM JPMugaas Preliminary FTP PRET command support for using PASV with a distributed FTP server (Distributed PASV - http://drftpd.org/wiki/wiki.phtml?title=Distributed_PASV). Rev 1.63 2/17/2004 12:25:52 PM JPMugaas The client now supports MODE Z (deflate) uploads and downloads as specified by http://www.ietf.org/internet-drafts/draft-preston-ftpext-deflate-00.txt Rev 1.62 2004.02.03 5:45:10 PM czhower Name changes Rev 1.61 2004.02.03 2:12:06 PM czhower $I path change Rev 1.60 1/27/2004 10:17:10 PM JPMugaas Fix from Steve Loft for a server that sends something like this: "227 Passive mode OK (195,92,195,164,4,99 )" Rev 1.59 1/27/2004 3:59:28 PM SPerry StringStream ->IdStringStream Rev 1.58 24/01/2004 19:13:58 CCostelloe Cleaned up warnings Rev 1.57 1/21/2004 2:27:50 PM JPMugaas Bullete Proof FTPD and Titan FTP support SITE ZONE. Saw this in a command database in StaffFTP. InitComponent. Rev 1.56 1/19/2004 9:05:38 PM JPMugaas Fixes to FTP Set Date functionality. Introduced properties for Time Zone information from the server. The way it works is this, if TIdFTP detects you are using "Serv-U" or SITE ZONE is listed in the FEAT reply, Indy obtains the time zone information with the SITE ZONE command and makes the appropriate calculation. Indy then uses this information to calculate a timestamp to send to the server with the MDTM command. You can also use the Time Zone information yourself to convert the FTP directory listing item timestamps into GMT and than convert that to your local time. FTP Voyager uses SITE ZONE as I've described. Rev 1.55 1/19/2004 4:39:08 AM JPMugaas You can now set the time for a file on the server. Note that these methods try to treat the time as relative to GMT. Rev 1.54 1/17/2004 9:09:30 PM JPMugaas Should now compile. Rev 1.53 1/17/2004 7:48:02 PM JPMugaas FXP site to site transfer code was redone for improvements with FXP with TLS. It actually works and I verified with RaidenFTPD (http://www.raidenftpd.com/) and the Indy FTP server components. I also lowered the requirements for TLS FXP transfers. The requirements now are: 1) Only server (either the recipient or the sendor) has to support SSCN or 2) The server receiving a PASV must support CPSV and the transfer is done with IPv4. Rev 1.52 1/9/2004 2:51:26 PM JPMugaas Started IPv6 support. Rev 1.51 11/27/2003 4:55:28 AM JPMugaas Made STOU functionality separate from PUT functionality. Put now requires a destination filename except where a source-file name is given. In that case, the default is the filename from the source string. Rev 1.50 10/26/2003 04:28:50 PM JPMugaas Reworked Status. The old one was problematic because it assumed that STAT was a request to send a directory listing through the control channel. This assumption is not correct. It provides a way to get a freeform status report from a server. With a Path parameter, it should work like a LIST command except that the control connection is used. We don't support that feature and you should use our LIst method to get the directory listing anyway, IMAO. Rev 1.49 10/26/2003 9:17:46 PM BGooijen Compiles in DotNet, and partially works there Rev 1.48 10/24/2003 12:43:48 PM JPMugaas Should work again. Rev 1.47 2003.10.24 10:43:04 AM czhower TIdSTream to dos Rev 1.46 10/20/2003 03:06:10 PM JPMugaas SHould now work. Rev 1.45 10/20/2003 01:00:38 PM JPMugaas EIdException no longer raised. Some things were being gutted needlessly. Rev 1.44 10/19/2003 12:58:20 PM DSiders Added localization comments. Rev 1.43 2003.10.14 9:56:50 PM czhower Compile todos Rev 1.42 2003.10.12 3:50:40 PM czhower Compile todos Rev 1.41 10/10/2003 11:32:26 PM SPerry - Rev 1.40 10/9/2003 10:17:02 AM JPMugaas Added overload for GetLoginPassword for providing a challanage string which doesn't have to the last command reply. Added CLNT support. Rev 1.39 10/7/2003 05:46:20 AM JPMugaas SSCN Support added. Rev 1.38 10/6/2003 08:56:44 PM JPMugaas Reworked the FTP list parsing framework so that the user can obtain the list of capabilities from a parser class with TIdFTP. This should permit the user to present a directory listing differently for each parser (some FTP list parsers do have different capabilities). Rev 1.37 10/1/2003 12:51:18 AM JPMugaas SSL with active (PORT) transfers now should work again. Rev 1.36 9/30/2003 09:50:38 PM JPMugaas FTP with TLS should work better. It turned out that we were negotiating it several times causing a hang. I also made sure that we send PBSZ 0 and PROT P for both implicit and explicit TLS. Data ports should work in PASV again. Rev 1.35 9/28/2003 11:41:06 PM JPMugaas Reworked Eldos's proposed FTP fix as suggested by Henrick Hellström by moving all of the IOHandler creation code to InitDataChannel. This should reduce the likelihood of error. Rev 1.33 9/18/2003 11:22:40 AM JPMugaas Removed a temporary workaround for an OnWork bug that was in the Indy Core. That bug was fixed so there's no sense in keeping a workaround here. Rev 1.32 9/12/2003 08:05:30 PM JPMugaas A temporary fix for OnWork events not firing. The bug is that OnWork events aren't used in IOHandler where ReadStream really is located. Rev 1.31 9/8/2003 02:33:00 AM JPMugaas OnCustomFTPProxy added to allow Indy to support custom FTP proxies. When using this event, you are responsible for programming the FTP Proxy and FTP Server login sequence. GetLoginPassword method function for returning the password used when logging into a FTP server which handles OTP calculation. This way, custom firewall support can handle One-Time-Password system transparently. You do have to send the User ID before calling this function because the OTP challenge is part of the reply. Rev 1.30 6/10/2003 11:10:00 PM JPMugaas Made comments about our loop that tries several AUTH command variations. Some servers may only accept AUTH SSL while other servers only accept AUTH TLS. Rev 1.29 5/26/2003 12:21:54 PM JPMugaas Rev 1.28 5/25/2003 03:54:20 AM JPMugaas Rev 1.27 5/19/2003 08:11:32 PM JPMugaas Now should compile properly with new code in Core. Rev 1.26 5/8/2003 11:27:42 AM JPMugaas Moved feature negoation properties down to the ExplicitTLSClient level as feature negotiation goes hand in hand with explicit TLS support. Rev 1.25 4/5/2003 02:06:34 PM JPMugaas TLS handshake itself can now be handled. Rev 1.24 4/4/2003 8:01:32 PM BGooijen now creates iohandler for dataconnection Rev 1.23 3/31/2003 08:40:18 AM JPMugaas Fixed problem with QUIT command. Rev 1.22 3/27/2003 3:41:28 PM BGooijen Changed because some properties are moved to IOHandler Rev 1.21 3/27/2003 05:46:24 AM JPMugaas Updated framework with an event if the TLS negotiation command fails. Cleaned up some duplicate code in the clients. Rev 1.20 3/26/2003 04:19:20 PM JPMugaas Cleaned-up some code and illiminated some duplicate things. Rev 1.19 3/24/2003 04:56:10 AM JPMugaas A typecast was incorrect and could cause a potential source of instability if a TIdIOHandlerStack was not used. Rev 1.18 3/16/2003 06:09:58 PM JPMugaas Fixed port setting bug. Rev 1.17 3/16/2003 02:40:16 PM JPMugaas FTP client with new design. Rev 1.16 3/16/2003 1:02:44 AM BGooijen Added 2 events to give the user more control to the dataconnection, moved SendTransferType, enabled ssl Rev 1.15 3/13/2003 09:48:58 AM JPMugaas Now uses an abstract SSL base class instead of OpenSSL so 3rd-party vendors can plug-in their products. Rev 1.14 3/7/2003 11:51:52 AM JPMugaas Fixed a writeln bug and an IOError issue. Rev 1.13 3/3/2003 07:06:26 PM JPMugaas FFreeIOHandlerOnDisconnect to FreeIOHandlerOnDisconnect at Bas's instruction Rev 1.12 2/21/2003 06:54:36 PM JPMugaas The FTP list processing has been restructured so that Directory output is not done by IdFTPList. This now also uses the IdFTPListParserBase for parsing so that the code is more scalable. Rev 1.11 2/17/2003 04:45:36 PM JPMugaas Now temporarily change the transfer mode to ASCII when requesting a DIR. TOPS20 does not like transfering dirs in binary mode and it might be a good idea to do it anyway. Rev 1.10 2/16/2003 03:22:20 PM JPMugaas Removed the Data Connection assurance stuff. We figure things out from the draft specificaiton, the only servers we found would not send any data after the new commands were sent, and there were only 2 server types that supported it anyway. Rev 1.9 2/16/2003 10:51:08 AM JPMugaas Attempt to implement: http://www.ietf.org/internet-drafts/draft-ietf-ftpext-data-connection-assuranc e-00.txt Currently commented out because it does not work. Rev 1.8 2/14/2003 11:40:16 AM JPMugaas Fixed compile error. Rev 1.7 2/14/2003 10:38:32 AM JPMugaas Removed a problematic override for GetInternelResponse. It was messing up processing of the FEAT. Rev 1.6 12-16-2002 20:48:10 BGooijen now uses TIdIOHandler.ConstructIOHandler to construct iohandlers IPv6 works again Independant of TIdIOHandlerStack again Rev 1.5 12-15-2002 23:27:26 BGooijen now compiles on Indy 10, but some things like IPVersion still need to be changed Rev 1.4 12/15/2002 04:07:02 PM JPMugaas Started port to Indy 10. Still can not complete it though. Rev 1.3 12/6/2002 05:29:38 PM JPMugaas Now decend from TIdTCPClientCustom instead of TIdTCPClient. Rev 1.2 12/1/2002 04:18:02 PM JPMugaas Moved all dir parsing code to one place. Reworked to use more than one line for determining dir format type along with flfNextLine dir format type. Rev 1.1 11/14/2002 04:02:58 PM JPMugaas Removed cludgy code that was a workaround for the RFC Reply limitation. That is no longer limited. Rev 1.0 11/14/2002 02:20:00 PM JPMugaas 2002-10-25 - J. Peter Mugaas - added XCRC support - specified by "GlobalSCAPE Secure FTP Server User’s Guide" which is available at http://www.globalscape.com and also explained at http://www.southrivertech.com/support/titanftp/webhelp/titanftp.htm - added COMB support - specified by "GlobalSCAPE Secure FTP Server User’s Guide" which is available at http://www.globalscape.com and also explained at http://www.southrivertech.com/support/titanftp/webhelp/titanftp.htm 2002-10-24 - J. Peter Mugaas - now supports RFC 2640 - FTP Internalization 2002-09-18 _ added AFromBeginning parameter to InternalPut to correctly honor the AAppend parameter of Put 2002-09-05 - J. Peter Mugaas - now complies with RFC 2389 - Feature negotiation mechanism for the File Transfer Protocol - now complies with RFC 2428 - FTP Extensions for IPv6 and NATs 2002-08-27 - Andrew P.Rybin - proxy support fix (non-standard ftp port's) 2002-01-xx - Andrew P.Rybin - Proxy support, OnAfterGet (ex:decrypt, set srv timestamp) - J.Peter Mugaas: not readonly ProxySettings A Neillans - 10/17/2001 Merged changes submitted by Andrew P.Rybin Correct command case problems - some servers expect commands in Uppercase only. SP - 06/08/2001 Added a few more functions Doychin - 02/18/2001 OnAfterLogin event handler and Login method OnAfterLogin is executed after successfull login but before setting up the connection properties. This event can be used to provide FTP proxy support from the user application. Look at the FTP demo program for more information on how to provide such support. Doychin - 02/17/2001 New onFTPStatus event New Quote method for executing commands not implemented by the compoent -CleanDir contributed by Amedeo Lanza } unit IdFTP; interface {$i IdCompilerDefines.inc} uses Classes, IdAssignedNumbers, IdGlobal, IdCustomTransparentProxy, IdExceptionCore, IdExplicitTLSClientServerBase, IdFTPCommon, IdFTPList, IdFTPListParseBase, IdException, IdIOHandler, IdIOHandlerSocket, IdReplyFTP, IdBaseComponent, IdReplyRFC, IdReply, IdSocketHandle, IdTCPConnection, IdTCPClient, IdThreadSafe, IdZLibCompressorBase; type //APR 011216: TIdFtpProxyType = ( fpcmNone,//Connect method: fpcmUserSite, //Send command USER user@hostname - USER after login (see: http://isservices.tcd.ie/internet/command_config.php) fpcmSite, //Send command SITE (with logon) fpcmOpen, //Send command OPEN fpcmUserPass,//USER user@firewalluser@hostname / PASS pass@firewallpass fpcmTransparent, //First use the USER and PASS command with the firewall username and password, and then with the target host username and password. fpcmUserHostFireWallID, //USER hostuserId@hostname firewallUsername fpcmNovellBorder, //Novell BorderManager Proxy fpcmHttpProxyWithFtp, //HTTP Proxy with FTP support. Will be supported in Indy 10 fpcmCustomProxy // use OnCustomFTPProxy to customize the proxy login ); //TIdFtpProxyType //This has to be in the same order as TLS_AUTH_NAMES TAuthCmd = (tAuto, tAuthTLS, tAuthSSL, tAuthTLSC, tAuthTLSP); const Id_TIdFTP_TransferType = {ftBinary} ftASCII; // RLebeau 1/22/08: per RFC 959 Id_TIdFTP_Passive = False; Id_TIdFTP_UseNATFastTrack = False; Id_TIdFTP_HostPortDelimiter = ':'; Id_TIdFTP_DataConAssurance = False; Id_TIdFTP_DataPortProtection = ftpdpsClear; // DEF_Id_TIdFTP_Implicit = False; DEF_Id_FTP_UseExtendedDataPort = False; DEF_Id_TIdFTP_UseExtendedData = False; DEF_Id_TIdFTP_UseMIS = True; DEF_Id_FTP_UseCCC = False; DEF_Id_FTP_AUTH_CMD = tAuto; DEF_Id_FTP_ListenTimeout = 10000; // ten seconds { Soem firewalls don't handle control connections properly during long data transfers. They will timeout the control connection because it's idle and making it worse is that they will chop off a connection instead of closing it causing TIdFTP to wait forever for nothing. } DEF_Id_FTP_READTIMEOUT = 60000; //one minute DEF_Id_FTP_UseHOST = True; DEF_Id_FTP_PassiveUseControlHost = False; DEF_Id_FTP_AutoIssueFEAT = True; DEF_Id_FTP_AutoLogin = True; type //Added by SP TIdCreateFTPList = procedure(ASender: TObject; var VFTPList: TIdFTPListItems) of object; //TIdCheckListFormat = procedure(ASender: TObject; const ALine: String; var VListFormat: TIdFTPListFormat) of object; TOnAfterClientLogin = TNotifyEvent; TIdFtpAfterGet = procedure(ASender: TObject; AStream: TStream) of object; //APR TIdOnDataChannelCreate = procedure(ASender: TObject; ADataChannel: TIdTCPConnection) of object; TIdOnDataChannelDestroy = procedure(ASender: TObject; ADataChannel: TIdTCPConnection) of object; TIdNeedAccountEvent = procedure(ASender: TObject; var VAcct: string) of object; TIdFTPBannerEvent = procedure (ASender: TObject; const AMsg : String) of object; TIdFTPClientIdentifier = class (TPersistent) protected FClientName : String; FClientVersion : String; FPlatformDescription : String; procedure SetClientName(const AValue: String); procedure SetClientVersion(const AValue: String); procedure SetPlatformDescription(const AValue: String); function GetClntOutput: String; public procedure Assign(Source: TPersistent); override; property ClntOutput : String read GetClntOutput; published property ClientName : String read FClientName write SetClientName; property ClientVersion : String read FClientVersion write SetClientVersion; property PlatformDescription : String read FPlatformDescription write SetPlatformDescription; end; TIdFtpProxySettings = class (TPersistent) protected FHost, FUserName, FPassword: String; FProxyType: TIdFtpProxyType; FPort: TIdPort; public procedure Assign(Source: TPersistent); override; published property ProxyType: TIdFtpProxyType read FProxyType write FProxyType; property Host: String read FHost write FHost; property UserName: String read FUserName write FUserName; property Password: String read FPassword write FPassword; property Port: TIdPort read FPort write FPort; end; TIdFTPTZInfo = class(TPersistent) protected FGMTOffset : TDateTime; FGMTOffsetAvailable : Boolean; public procedure Assign(Source: TPersistent); override; published property GMTOffset : TDateTime read FGMTOffset write FGMTOffset; property GMTOffsetAvailable : Boolean read FGMTOffsetAvailable write FGMTOffsetAvailable; end; TIdFTPKeepAlive = class(TPersistent) protected FUseKeepAlive: Boolean; FIdleTimeMS: Integer; FIntervalMS: Integer; public procedure Assign(Source: TPersistent); override; published // be enabled on the command connection for its entire lifetime, not just // during transfers, and maybe also add an option to enable keepalives on // the data connections as well... property UseKeepAlive: Boolean read FUseKeepAlive write FUseKeepAlive; property IdleTimeMS: Integer read FIdleTimeMS write FIdleTimeMS; property IntervalMS: Integer read FIntervalMS write FIntervalMS; end; TIdFTP = class(TIdExplicitTLSClient) protected FAutoLogin: Boolean; FAutoIssueFEAT : Boolean; FCurrentTransferMode : TIdFTPTransferMode; FClientInfo : TIdFTPClientIdentifier; FDataSettingsSent: Boolean; // only send SSL data settings once per connection FUsingSFTP : Boolean; //enable SFTP internel flag FUsingCCC : Boolean; //are we using FTP with SSL on a clear control channel? FUseHOST: Boolean; FServerHOST: String; FCanUseMLS : Boolean; //can we use MLISx instead of LIST FUsingExtDataPort : Boolean; //are NAT Extensions (RFC 2428 available) flag FUsingNATFastTrack : Boolean;//are we using NAT fastrack feature FCanResume: Boolean; FListResult: TStrings; FLoginMsg: TIdReplyFTP; FPassive: Boolean; FPassiveUseControlHost: Boolean; FDataPortProtection : TIdFTPDataPortSecurity; FAUTHCmd : TAuthCmd; FDataPort: TIdPort; FDataPortMin: TIdPort; FDataPortMax: TIdPort; FDefStringEncoding: IIdTextEncoding; FExternalIP : String; FResumeTested: Boolean; FServerDesc: string; FSystemDesc: string; FTransferType: TIdFTPTransferType; FTransferTimeout : Integer; FListenTimeout : Integer; FDataChannel: TIdTCPConnection; FDirectoryListing: TIdFTPListItems; FDirFormat : String; FListParserClass : TIdFTPListParseClass; FOnAfterClientLogin: TNotifyEvent; FOnCreateFTPList: TIdCreateFTPList; FOnBeforeGet: TNotifyEvent; FOnBeforePut: TIdFtpAfterGet; //in case someone needs to do something special with the data being uploaded FOnAfterGet: TIdFtpAfterGet; //APR FOnAfterPut: TNotifyEvent; //JPM at Don Sider's suggestion FOnNeedAccount: TIdNeedAccountEvent; FOnCustomFTPProxy : TNotifyEvent; FOnDataChannelCreate: TIdOnDataChannelCreate; FOnDataChannelDestroy: TIdOnDataChannelDestroy; FProxySettings: TIdFtpProxySettings; FUseExtensionDataPort : Boolean; FTryNATFastTrack : Boolean; FUseMLIS : Boolean; FLangsSupported : TStrings; FUseCCC: Boolean; //is the SSCN Client method on for this connection? FSSCNOn : Boolean; FIsCompressionSupported : Boolean; FOnBannerBeforeLogin : TIdFTPBannerEvent; FOnBannerAfterLogin : TIdFTPBannerEvent; FOnBannerWarning : TIdFTPBannerEvent; FTZInfo : TIdFTPTZInfo; {$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} 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; //we probably need an Abort flag so we know when an abort is sent. //It turns out that one server will send a 550 or 451 error followed by an //ABOR successfull FAbortFlag : TIdThreadSafeBoolean; FAccount: string; FNATKeepAlive: TIdFTPKeepAlive; // procedure DoOnDataChannelCreate; procedure DoOnDataChannelDestroy; procedure DoOnRetrievedDir; procedure DoOnDirParseStart; procedure DoOnDirParseEnd; procedure FinalizeDataOperation; 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: TIdPort); procedure SendCPassive(var VIP: string; var VPort: TIdPort); function FindAuthCmd : String; // function GetReplyClass: TIdReplyClass; override; // procedure ParseFTPList; 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 : TStrings); procedure DoOnBannerBeforeLogin(AText : TStrings); procedure DoOnBannerWarning(AText : TStrings); 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: TStream; AResume: Boolean = false); procedure InternalPut(const ACommand: string; ASource: TStream; AFromBeginning: Boolean = True; AResume: Boolean = False); // procedure SetOnParseCustomListFormat(const AValue: TIdOnParseCustomListFormat); procedure SendPassive(var VIP: string; var VPort: TIdPort); procedure SendPort(AHandle: TIdSocketHandle); overload; procedure SendPort(const AIP : String; const APort : TIdPort); overload; procedure ParseEPSV(const AReply : String; var VIP : String; var VPort : TIdPort); //These two are for RFC 2428.txt procedure SendEPort(AHandle: TIdSocketHandle); overload; procedure SendEPort(const AIP : String; const APort : TIdPort; const AIPVersion : TIdIPVersion); overload; procedure SendEPassive(var VIP: string; var VPort: TIdPort); function SendHost: Int16; procedure SetProxySettings(const Value: TIdFtpProxySettings); procedure SetClientInfo(const AValue: TIdFTPClientIdentifier); procedure SetCompressor(AValue: TIdZLibCompressorBase); procedure SendTransferType(AValue: TIdFTPTransferType); procedure SetTransferType(AValue: TIdFTPTransferType); procedure DoBeforeGet; virtual; procedure DoBeforePut(AStream: TStream); virtual; procedure DoAfterGet(AStream: TStream); virtual; //APR procedure DoAfterPut; virtual; class procedure FXPSetTransferPorts(AFromSite, AToSite: TIdFTP; const ATargetUsesPasv : Boolean); class procedure FXPSendFile(AFromSite, AToSite: TIdFTP; const ASourceFile, ADestFile: String); class function InternalEncryptedTLSFXP(AFromSite, AToSite: TIdFTP; const ASourceFile, ADestFile: String; const ATargetUsesPasv : Boolean) : Boolean; class function InternalUnencryptedFXP(AFromSite, AToSite: TIdFTP; const ASourceFile, ADestFile: String; const ATargetUsesPasv : Boolean): Boolean; class 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 SetDefStringEncoding(AValue: IIdTextEncoding); procedure SetUseCCC(const AValue: Boolean); procedure SetNATKeepAlive(AValue: TIdFTPKeepAlive); procedure IssueFEAT; //specific server detection function IsOldServU: Boolean; function IsBPFTP : Boolean; function IsTitan : Boolean; function IsWSFTP : Boolean; function IsIIS: Boolean; function CheckAccount: Boolean; function IsAccountNeeded : Boolean; function GetSupportsVerification : Boolean; public {$IFDEF WORKAROUND_INLINE_CONSTRUCTORS} constructor Create(AOwner: TComponent); reintroduce; overload; {$ENDIF} procedure GetInternalResponse(AEncoding: IIdTextEncoding = nil); override; function CheckResponse(const AResponse: Int16; const AAllowedResponses: array of Int16): Int16; override; function IsExtSupported(const ACmd : String):Boolean; procedure ExtractFeatFacts(const ACmd : String; AResults : TStrings); //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 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: TStream; AResume: Boolean = false); overload; procedure Get(const ASourceFile, ADestFile: string; const ACanOverwrite: boolean = false; AResume: Boolean = false); overload; procedure Help(AHelpContents: TStrings; ACommand: String = ''); procedure KillDataChannel; virtual; //.NET Overload procedure List; overload; //.NET Overload procedure List(const ASpecifier: string; ADetails: Boolean = True); overload; procedure List(ADest: TStrings; const ASpecifier: string = ''; ADetails: Boolean = True); overload; procedure ExtListDir(ADest: TStrings = nil; const ADirectory: string = ''); procedure ExtListItem(ADest: TStrings; AFList : TIdFTPListItems; const AItem: string=''); overload; procedure ExtListItem(ADest: TStrings; 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: TStream; const ADestFile: string; const AAppend: Boolean = False; const AStartPos: TIdStreamSize = -1); overload; procedure Put(const ASourceFile: string; const ADestFile: string = ''; const AAppend: Boolean = False; const AStartPos: TIdStreamSize = -1); overload; procedure StoreUnique(const ASource: TStream; const AStartPos: TIdStreamSize = -1); overload; procedure StoreUnique(const ASourceFile: string; const AStartPos: TIdStreamSize = -1); overload; procedure SiteToSiteUpload(const AToSite : TIdFTP; const ASourceFile : String; const ADestFile : String = ''); procedure SiteToSiteDownload(const AFromSite: TIdFTP; const ASourceFile : String; const ADestFile : String = ''); procedure DisconnectNotifyPeer; override; procedure Quit; {$IFDEF HAS_DEPRECATED}deprecated{$IFDEF HAS_DEPECATED_MSG} 'Use Disconnect() instead'{$ENDIF};{$ENDIF} function Quote(const ACommand: String): Int16; 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): Int64; procedure Status(AStatusList: TStrings); procedure StructureMount(APath: String); procedure TransferMode(ATransferMode: TIdFTPTransferMode); procedure ReInitialize(ADelay: UInt32 = 10); procedure SetLang(const ALangTag : String); function CRC(const AFIleName : String; const AStartPoint : Int64 = 0; const AEndPoint : Int64=0) : Int64; //verify file was uploaded, this is more comprehensive than the above function VerifyFile(ALocalFile : TStream; const ARemoteFile : String; const AStartPoint : TIdStreamSize = 0; const AByteCount : TIdStreamSize = 0) : Boolean; overload; function VerifyFile(const ALocalFile, ARemoteFile : String; const AStartPoint : TIdStreamSize = 0; const AByteCount : TIdStreamSize = 0) : Boolean; overload; //file parts must be in order in TStrings parameter //GlobalScape FTP Pro uses this for multipart simultanious file uploading procedure CombineFiles(const ATargetFile : String; AFileParts : TStrings); //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 IsCompressionSupported : Boolean read FIsCompressionSupported; // property SupportsVerification : Boolean read GetSupportsVerification; property CanResume: Boolean read ResumeSupported; property CanUseMLS : Boolean read FCanUseMLS; property DirectoryListing: TIdFTPListItems read GetDirectoryListing; property DirFormat : String read FDirFormat; property LangsSupported : TStrings read FLangsSupported; property ListParserClass : TIdFTPListParseClass read FListParserClass write FListParserClass; property LoginMsg: TIdReplyFTP read FLoginMsg; property ListResult: TStrings 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 {$IFDEF DOTNET} {$IFDEF DOTNET_2_OR_ABOVE} property IPVersion; {$ENDIF} {$ELSE} property IPVersion; {$ENDIF} property AutoIssueFEAT : Boolean read FAutoIssueFEAT write FAutoIssueFEAT default DEF_Id_FTP_AutoIssueFEAT; property AutoLogin: Boolean read FAutoLogin write FAutoLogin default DEF_Id_FTP_AutoLogin; // This is an object that can compress and decompress FTP Deflate encoding property Compressor : TIdZLibCompressorBase read FCompressor write SetCompressor; 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 PassiveUseControlHost: Boolean read FPassiveUseControlHost write FPassiveUseControlHost default DEF_Id_FTP_PassiveUseControlHost; 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 ConnectTimeout; property DataPort: TIdPort read FDataPort write FDataPort default 0; property DataPortMin: TIdPort read FDataPortMin write FDataPortMin default 0; property DataPortMax: TIdPort read FDataPortMax write FDataPortMax default 0; property DefStringEncoding : IIdTextEncoding read FDefStringEncoding write SetDefStringEncoding; 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 ListenTimeout : Integer read FListenTimeout write FListenTimeout default DEF_Id_FTP_ListenTimeout; 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 NATKeepAlive: TIdFTPKeepAlive read FNATKeepAlive write SetNATKeepAlive; property ProxySettings: TIdFtpProxySettings read FProxySettings write SetProxySettings; property Account: string read FAccount write FAccount; property ClientInfo : TIdFTPClientIdentifier read FClientInfo write SetClientInfo; property UseHOST: Boolean read FUseHOST write FUseHOST default DEF_Id_FTP_UseHOST; property ServerHOST: String read FServerHOST write FServerHOST; property UseTLS; property OnTLSNotAvailable; property OnBannerBeforeLogin : TIdFTPBannerEvent read FOnBannerBeforeLogin write FOnBannerBeforeLogin; property OnBannerAfterLogin : TIdFTPBannerEvent read FOnBannerAfterLogin write FOnBannerAfterLogin; property OnBannerWarning : TIdFTPBannerEvent read FOnBannerWarning write FOnBannerWarning; property OnBeforeGet: TNotifyEvent read FOnBeforeGet write FOnBeforeGet; property OnBeforePut: TIdFtpAfterGet read FOnBeforePut write FOnBeforePut; property OnAfterClientLogin: TOnAfterClientLogin read FOnAfterClientLogin write FOnAfterClientLogin; property OnCreateFTPList: TIdCreateFTPList read FOnCreateFTPList write FOnCreateFTPList; property OnAfterGet: TIdFtpAfterGet read FOnAfterGet write FOnAfterGet; //APR property OnAfterPut: TNotifyEvent read FOnAfterPut write FOnAfterPut; property OnNeedAccount: TIdNeedAccountEvent read FOnNeedAccount write FOnNeedAccount; 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; property ReadTimeout default DEF_Id_FTP_READTIMEOUT; 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); 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); EIdFTPMissingCompressor = class(EIdFTPException); EIdFTPCompressorNotReady = class(EIdFTPException); EIdFTPUnsupportedTransferMode = class(EIdFTPException); EIdFTPUnsupportedTransferType = class(EIdFTPException); implementation uses //facilitate inlining only. {$IFDEF KYLIXCOMPAT} Libc, {$ENDIF} {$IFDEF USE_VCL_POSIX} Posix.SysSelect, Posix.SysTime, Posix.Unistd, {$ENDIF} {$IFDEF WINDOWS} //facilitate inlining only. Windows, {$ENDIF} {$IFDEF DOTNET} {$IFDEF USE_INLINE} System.IO, System.Threading, {$ENDIF} {$ENDIF} IdComponent, IdFIPS, IdResourceStringsCore, IdIOHandlerStack, IdResourceStringsProtocols, IdSSL, IdGlobalProtocols, IdHash, IdHashCRC, IdHashSHA, IdHashMessageDigest, IdStack, IdStackConsts, IdSimpleServer, IdOTPCalculator, SysUtils; const cIPVersions: array[TIdIPVersion] of String = ('1', '2'); {do not localize} type TIdFTPListResult = class(TStringList) private FDetails: Boolean; //Did the developer use the NLST command for the last list command FUsedMLS : Boolean; //Did the developer use MLSx commands for the last list command public property Details: Boolean read FDetails; property UsedMLS: Boolean read FUsedMLS; end; {$IFDEF WORKAROUND_INLINE_CONSTRUCTORS} constructor TIdFTP.Create(AOwner: TComponent); begin inherited Create(AOwner); end; {$ENDIF} procedure TIdFTP.InitComponent; begin inherited InitComponent; // FAutoLogin := DEF_Id_FTP_AutoLogin; FRegularProtPort := IdPORT_FTP; FImplicitTLSProtPort := IdPORT_ftps; // Port := IDPORT_FTP; Passive := Id_TIdFTP_Passive; FPassiveUseControlHost := DEF_Id_FTP_PassiveUseControlHost; FDataPortProtection := Id_TIdFTP_DataPortProtection; FUseCCC := DEF_Id_FTP_UseCCC; FAUTHCmd := DEF_Id_FTP_AUTH_CMD; FUseHOST := DEF_Id_FTP_UseHOST; FDataPort := 0; FDataPortMin := 0; FDataPortMax := 0; FDefStringEncoding := IndyTextEncoding_8Bit; FUseExtensionDataPort := DEF_Id_TIdFTP_UseExtendedData; FTryNATFastTrack := Id_TIdFTP_UseNATFastTrack; FTransferType := Id_TIdFTP_TransferType; FTransferTimeout := IdDefTimeout; FListenTimeout := DEF_Id_FTP_ListenTimeout; FLoginMsg := TIdReplyFTP.Create(nil); FListResult := TIdFTPListResult.Create; FLangsSupported := TStringList.Create; FCanResume := False; FResumeTested := False; FProxySettings:= TIdFtpProxySettings.Create; //APR FClientInfo := TIdFTPClientIdentifier.Create; FTZInfo := TIdFTPTZInfo.Create; FTZInfo.FGMTOffsetAvailable := False; FUseMLIS := DEF_Id_TIdFTP_UseMIS; FCanUseMLS := False; //initialize MLIS flags //Settings specified by // http://www.ietf.org/internet-drafts/draft-preston-ftpext-deflate-00.txt FZLibCompressionLevel := DEF_ZLIB_COMP_LEVEL; FZLibWindowBits := DEF_ZLIB_WINDOW_BITS; //-15 - no extra headers FZLibMemLevel := DEF_ZLIB_MEM_LEVEL; FZLibStratagy := DEF_ZLIB_STRATAGY; // - default // FAbortFlag := TIdThreadSafeBoolean.Create; FAbortFlag.Value := False; { Some firewalls don't handle control connections properly during long data transfers. They will timeout the control connection because it is idle and making it worse is that they will chop off a connection instead of closing it, causing TIdFTP to wait forever for nothing. } FNATKeepAlive := TIdFTPKeepAlive.Create; ReadTimeout := DEF_Id_FTP_READTIMEOUT; FAutoIssueFEAT := DEF_Id_FTP_AutoIssueFEAT; end; {$IFNDEF HAS_TryEncodeTime} function TryEncodeTime(Hour, Min, Sec, MSec: Word; out VTime: TDateTime): Boolean; begin try VTime := EncodeTime(Hour, Min, Sec, MSec); Result := True; except Result := False; end; end; {$ENDIF} {$IFNDEF HAS_TryStrToInt} function TryStrToInt(const S: string; out Value: Integer): Boolean; {$IFDEF USE_INLINE}inline;{$ENDIF} var E: Integer; begin Val(S, Value, E); Result := E = 0; end; {$ENDIF} procedure TIdFTP.Connect; var LHost: String; LPort: TIdPort; LBuf : String; LSendQuitOnError: Boolean; LOffs: Integer; LRetryWithoutHOST: Boolean; begin LSendQuitOnError := False; FCurrentTransferMode := dmStream; FTZInfo.FGMTOffsetAvailable := False; //FSSCNOn should be set to false to prevent problems. FSSCNOn := False; FUsingSFTP := False; FUsingCCC := False; FDataSettingsSent := False; if FUseExtensionDataPort then begin FUsingExtDataPort := True; end; FUsingNATFastTrack := False; FCapabilities.Clear; try //APR 011216: proxy support LHost := FHost; LPort := FPort; try //I think fpcmTransparent means to connect to the regular host and the firewalll //intercepts the login information. if (ProxySettings.ProxyType <> fpcmNone) and (ProxySettings.ProxyType <> fpcmTransparent) and (Length(ProxySettings.Host) > 0) then begin FHost := ProxySettings.Host; FPort := ProxySettings.Port; end; if FUseTLS = utUseImplicitTLS then begin //at this point, we treat implicit FTP as if it were explicit FTP with TLS FUsingSFTP := True; end; inherited Connect; finally FHost := LHost; FPort := LPort; end; // RLebeau: must not send/receive UTF-8 before negotiating for it... IOHandler.DefStringEncoding := FDefStringEncoding; {$IFDEF STRING_IS_ANSI} IOHandler.DefAnsiEncoding := IndyTextEncoding_OSDefault; {$ENDIF} // RLebeau: RFC 959 says that the greeting can be preceeded by a 1xx // reply and that the client should wait for the 220 reply when this // happens. Also, the RFC says that 120 should be used, but some // servers use other 1xx codes, such as 130, so handle 1xx generically // calling GetInternalResponse() directly to avoid duplicate calls // to CheckResponse() for the initial response if it is not 1xx GetInternalResponse; if (LastCmdResult.NumericCode div 100) = 1 then begin DoOnBannerWarning(LastCmdResult.FormattedReply); GetResponse(220); end else begin CheckResponse(LastCmdResult.NumericCode, [220]); end; LSendQuitOnError := True; FGreeting.Assign(LastCmdResult); // Save initial greeting for server identification in case FGreeting changes // in response to the HOST command if FGreeting.Text.Count > 0 then begin FServerDesc := FGreeting.Text[0]; end else begin FServerDesc := ''; end; // Implement HOST command as specified by // http://tools.ietf.org/html/draft-hethmon-mcmurray-ftp-hosts-01 // Do not check the response for failures. The draft suggests allowing // 220 (success) and 500/502 (unsupported), but vsftpd returns 530, and // whatever ftp.microsoft.com is running returns 504. if UseHOST then begin // RLebeau: WS_FTP Server 5.x disconnects if the command fails, // whereas WS_FTP Server 6+ does not. If the server disconnected // here, let's mimic FTP Voyager by reconnecting without using // the HOST command again... // // RLebeau 11/18/2013: some other servers also disconnect on a failed // HOST command, so no longer retrying connect for WSFTP exclusively... // // RLebeau 11/22/2014: encountered one case where the server disconnects // before the reply is received. So checking for that as well... // LRetryWithoutHOST := False; try if SendHost() <> 220 then begin IOHandler.CheckForDisconnect(True, True); end; except on E: EIdConnClosedGracefully do begin LRetryWithoutHOST := True; end; on E: EIdSocketError do begin if (E.LastError = Id_WSAECONNABORTED) or (E.LastError = Id_WSAECONNRESET) then begin LRetryWithoutHOST := True; end else begin raise; end; end; end; if LRetryWithoutHOST then begin Disconnect(False); if Assigned(IOHandler) then begin IOHandler.InputBuffer.Clear; end; UseHOST := False; try Connect; finally UseHOST := True; end; Exit; end; end else begin FGreeting.Assign(LastCmdResult); end; DoOnBannerBeforeLogin (FGreeting.FormattedReply); // RLebeau: having an AutoIssueFeat property doesn't make sense to // me. There are commands below that require FEAT's response, but // if the user sets AutoIssueFeat to False, these commands will not // be allowed to execute! if AutoLogin then begin Login; DoAfterLogin; //Fast track is set only one time per connection and no more, even //with REINIT if TryNATFastTrack then begin DoTryNATFastTrack; end; if FUseTLS = utUseImplicitTLS then begin //at this point, we treat implicit FTP as if it were explicit FTP with TLS FUsingSFTP := True; end; // OpenVMS 7.1 replies with 200 instead of 215 - What does the RFC say about this? // if SendCmd('SYST', [200, 215, 500]) = 500 then begin {do not localize} //Do not fault if SYST was not understood by the server. Novel Netware FTP //may not understand SYST. if SendCmd('SYST') = 500 then begin {do not localize} FSystemDesc := RSFTPUnknownHost; end else begin FSystemDesc := LastCmdResult.Text[0]; end; if IsSiteZONESupported then begin if SendCmd('SITE ZONE') = 210 then begin {do not localize} if LastCmdResult.Text.Count > 0 then begin LBuf := LastCmdResult.Text[0]; // some servers (Serv-U, etc) use a 'UTC' offset string, ie // "UTC-300", specifying the number of minutes from UTC. Other // servers (Apache) use a GMT offset string instead, ie "-0300". if TextStartsWith(LBuf, 'UTC-') then begin {do not localize} // Titan FTP 6.26.634 incorrectly returns UTC-2147483647 when it's // first installed. FTZInfo.FGMTOffsetAvailable := TryStrToInt(Copy(LBuf, 4, MaxInt), LOffs) and TryEncodeTime(Abs(LOffs) div 60, Abs(LOffs) mod 60, 0, 0, FTZInfo.FGMTOffset); if FTZInfo.FGMTOffsetAvailable and (LOffs < 0) then FTZInfo.FGMTOffset := -FTZInfo.FGMTOffset end else begin FTZInfo.FGMTOffsetAvailable := True; FTZInfo.GMTOffset := GmtOffsetStrToDateTime(LBuf); end; end; end; end; SendTransferType(FTransferType); DoStatus(ftpReady, [RSFTPStatusReady]); end else begin // OpenVMS 7.1 replies with 200 instead of 215 - What does the RFC say about this? // if SendCmd('SYST', [200, 215, 500]) = 500 then begin {do not localize} //Do not fault if SYST was not understood by the server. Novel Netware FTP //may not understand SYST. if SendCmd('SYST') = 500 then begin {do not localize} FSystemDesc := RSFTPUnknownHost; end else begin FSystemDesc := LastCmdResult.Text[0]; end; if FAutoIssueFEAT then begin IssueFEAT; end; end; except Disconnect(LSendQuitOnError); // RLebeau: do not send the QUIT command if the greeting was not received raise; end; end; function TIdFTP.SendHost: Int16; var LHost: String; begin LHost := FServerHOST; if LHost = '' then begin LHost := FHost; end; if Socket <> nil then begin if LHost = Socket.Binding.PeerIP then begin LHost := '[' + LHost + ']'; {do not localize} end; end; Result := SendCmd('HOST ' + LHost); {do not localize} end; procedure TIdFTP.SetTransferType(AValue: TIdFTPTransferType); begin if AValue <> FTransferType then begin if not Assigned(FDataChannel) then begin if Connected then begin SendTransferType(AValue); end; FTransferType := AValue; end; end; end; procedure TIdFTP.SendTransferType(AValue: TIdFTPTransferType); var s: string; begin s := ''; case AValue of ftAscii: s := 'A'; {do not localize} ftBinary: s := 'I'; {do not localize} else raise EIdFTPUnsupportedTransferType.Create(RSFTPUnsupportedTransferType); end; SendCmd('TYPE ' + s, 200); {do not localize} end; function TIdFTP.ResumeSupported: Boolean; begin if not FResumeTested then begin FResumeTested := True; FCanResume := Quote('REST 1') = 350; {do not localize} Quote('REST 0'); {do not localize} end; Result := FCanResume; end; procedure TIdFTP.Get(const ASourceFile: string; ADest: TStream; AResume: Boolean = False); begin //for SSL FXP, we have to do it here because InternalGet is used by the LIST command //where SSCN is ignored. ClearSSCN; AResume := AResume and CanResume; DoBeforeGet; // RLebeau 7/26/06: do not do this! It breaks the ability to resume files // ADest.Position := 0; InternalGet('RETR ' + ASourceFile, ADest, AResume); DoAfterGet(ADest); end; procedure TIdFTP.Get(const ASourceFile, ADestFile: string; const ACanOverwrite: Boolean = False; AResume: Boolean = False); var LDestStream: TStream; begin AResume := AResume and CanResume; if ACanOverwrite and (not AResume) then begin SysUtils.DeleteFile(ADestFile); LDestStream := TIdFileCreateStream.Create(ADestFile); end else if (not ACanOverwrite) and AResume then begin LDestStream := TIdAppendFileStream.Create(ADestFile); end else if not FileExists(ADestFile) then begin LDestStream := TIdFileCreateStream.Create(ADestFile); end else begin raise EIdFTPFileAlreadyExists.Create(RSDestinationFileAlreadyExists); end; try Get(ASourceFile, LDestStream, AResume); finally FreeAndNil(LDestStream); end; end; procedure TIdFTP.DoBeforeGet; begin if Assigned(FOnBeforeGet) then begin FOnBeforeGet(Self); end; end; procedure TIdFTP.DoBeforePut(AStream: TStream); begin if Assigned(FOnBeforePut) then begin FOnBeforePut(Self, AStream); end; end; procedure TIdFTP.DoAfterGet(AStream: TStream);//APR begin if Assigned(FOnAfterGet) then begin FOnAfterGet(Self, AStream); end; end; procedure TIdFTP.DoAfterPut; begin if Assigned(FOnAfterPut) then begin FOnAfterPut(Self); end; end; procedure TIdFTP.ConstructDirListing; begin if not Assigned(FDirectoryListing) then begin if not IsDesignTime then begin DoFTPList; end; if not Assigned(FDirectoryListing) then begin FDirectoryListing := TIdFTPListItems.Create; end; end else begin FDirectoryListing.Clear; end; end; procedure TIdFTP.List(ADest: TStrings; const ASpecifier: string = ''; ADetails: Boolean = True); {do not localize} var LDest: TMemoryStream; LTrans : TIdFTPTransferType; begin if ADetails and UseMLIS and FCanUseMLS then begin ExtListDir(ADest, ASpecifier); Exit; end; // Note that for LIST, it might be best to put the connection in ASCII mode // because some old servers such as TOPS20 might require this. We restore // it if the original mode was not ASCII. It's a good idea to do this // anyway because some clients still do this such as WS_FTP Pro and // Microsoft's FTP Client. LTrans := TransferType; if LTrans <> ftASCII then begin Self.TransferType := ftASCII; end; try LDest := TMemoryStream.Create; try InternalGet(Trim(iif(ADetails, 'LIST', 'NLST') + ' ' + ASpecifier), LDest); {do not localize} FreeAndNil(FDirectoryListing); FDirFormat := ''; LDest.Position := 0; FListResult.Text := ReadStringFromStream(LDest, -1, IOHandler.DefStringEncoding{$IFDEF STRING_IS_ANSI}, IOHandler.DefAnsiEncoding{$ENDIF}); TIdFTPListResult(FListResult).FDetails := ADetails; TIdFTPListResult(FListResult).FUsedMLS := False; // FDirFormat will be updated in ParseFTPList... finally FreeAndNil(LDest); end; if ADest <> nil then begin ADest.Assign(FListResult); end; DoOnRetrievedDir; finally if LTrans <> ftASCII then begin TransferType := LTrans; end; end; end; const AbortedReplies : array [0..5] of Int16 = (226,426, 450,451,425,550); //226 was added because one server will return that twice if you aborted //during an upload. AcceptableAbortReplies : array [0..8] of Int16 = (225, 226, 250, 426, 450,451,425,550,552); //GlobalScape Secure FTP Server returns a 552 for an aborted file procedure TIdFTP.FinalizeDataOperation; var LResponse : Int16; begin DoOnDataChannelDestroy; if FDataChannel <> nil then begin {$IFNDEF USE_OBJECT_ARC} FDataChannel.IOHandler.Free; {$ENDIF} FDataChannel.IOHandler := nil; FreeAndNil(FDataChannel); end; { This is a bug fix for servers will do something like this: [2] Mon 06Jun05 13:33:28 - (000007) PASV [6] Mon 06Jun05 13:33:28 - (000007) 227 Entering Passive Mode (192,168,1,107,4,22) [2] Mon 06Jun05 13:33:28 - (000007) RETR test.txt.txt [6] Mon 06Jun05 13:33:28 - (000007) 550 /test.txt.txt: No such file or directory. [2] Mon 06Jun05 13:34:28 - (000007) QUIT [6] Mon 06Jun05 13:34:28 - (000007) 221 Goodbye! [5] Mon 06Jun05 13:34:28 - (000007) Closing connection for user TEST (00:01:08 connected) } if (LastCmdResult.NumericCode div 100) > 2 then begin DoStatus(ftpAborted, [RSFTPStatusAbortTransfer]); Exit; end; DoStatus(ftpReady, [RSFTPStatusDoneTransfer]); // 226 = download successful, 225 = Abort successful} if FAbortFlag.Value then begin LResponse := GetResponse(AcceptableAbortReplies); //Experimental - if PosInSmallIntArray(LResponse,AbortedReplies) > -1 then begin GetResponse([226, 225]); end; //IMPORTANT!!! KEEP THIS COMMENT!!! // //This is a workaround for a problem. When uploading a file on //one FTP server and aborting that upload, I got this: // //Sent 3/9/2005 10:34:58 AM: STOR -------- //Recv 3/9/2005 10:34:58 AM: 150 Opening BINARY mode data connection for [3513]Red_Glas.zip //Sent 3/9/2005 10:34:59 AM: ABOR //Recv 3/9/2005 10:35:00 AM: 226 Transfer complete. //Recv 3/9/2005 10:35:00 AM: 226 Abort successful // //but at ftp.ipswitch.com (a WS_FTP Server 5.0.4 (2555009845) server ), //I was getting this when aborting a download // //Sent 3/9/2005 12:43:41 AM: RETR imail6.pdf //Recv 3/9/2005 12:43:41 AM: 150 Opening BINARY data connection for imail6.pdf (2150082 bytes) //Sent 3/9/2005 12:43:42 AM: ABOR //Recv 3/9/2005 12:43:42 AM: 226 abort successful //Recv 3/9/2005 12:43:43 AM: 425 transfer canceled // if LResponse = 226 then begin if IOHandler.Readable(10) then begin GetResponse(AbortedReplies); end; end; DoStatus(ftpAborted, [RSFTPStatusAbortTransfer]); //end experimental section end else begin //ftp.marist.edu returns 250 GetResponse([226, 225, 250]); end; end; procedure TIdFTP.InternalPut(const ACommand: string; ASource: TStream; AFromBeginning: Boolean = True; AResume: Boolean = False); {$IFNDEF MSWINDOWS} procedure WriteStreamFromBeginning; var LBuffer: TIdBytes; LBufSize: Integer; begin // Copy entire stream without relying on ASource.Size so Unix-to-DOS // conversion can be done on the fly. BeginWork(wmWrite, ASource.Size); try SetLength(LBuffer, FDataChannel.IOHandler.SendBufferSize); while True do begin LBufSize := ASource.Read(LBuffer[0], Length(LBuffer)); if LBufSize > 0 then FDataChannel.IOHandler.Write(LBuffer, LBufSize) else Break; end; finally EndWork(wmWrite); end; end; {$ENDIF} var LIP: string; LPort: TIdPort; LPasvCl : TIdTCPClient; LPortSv : TIdSimpleServer; // under ARC, convert a weak reference to a strong reference before working with it LCompressor : TIdZLibCompressorBase; begin FAbortFlag.Value := False; LCompressor := nil; if FCurrentTransferMode = dmDeflate then begin LCompressor := FCompressor; if not Assigned(LCompressor) then begin raise EIdFTPMissingCompressor.Create(RSFTPMissingCompressor); end; if not LCompressor.IsReady then begin raise EIdFTPCompressorNotReady.Create(RSFTPCompressorNotReady); end; end; //for SSL FXP, we have to do it here because there is no command were a client //submits data through a data port where the SSCN setting is ignored. ClearSSCN; DoStatus(ftpTransfer, [RSFTPStatusStartTransfer]); // try if FPassive then begin SendPret(ACommand); if FUsingExtDataPort then begin SendEPassive(LIP, LPort); end else begin SendPassive(LIP, LPort); end; if AResume then begin Self.SendCmd('REST ' + IntToStr(ASource.Position), [350]); {do not localize} end; IOHandler.WriteLn(ACommand); if Socket <> nil then begin FDataChannel := TIdTCPClient.Create(nil); end else begin FDataChannel := nil; end; LPasvCl := TIdTCPClient(FDataChannel); try InitDataChannel; if (Self.Socket <> nil) and PassiveUseControlHost then begin //Do not use an assignment from Self.Host //because a DNS name may not resolve to the same //IP address every time. This is the case where //the workload is distributed around several servers. //Besides, we already know the Peer's IP address so //why waste time querying it. LIP := Self.Socket.Binding.PeerIP; end; if LPasvCl <> nil then begin LPasvCl.Host := LIP; LPasvCl.Port := LPort; DoOnDataChannelCreate; LPasvCl.Connect; end; try Self.GetResponse([110, 125, 150]); try if FDataChannel <> nil then begin if FUsingSFTP and (FDataPortProtection = ftpdpsPrivate) then begin TIdSSLIOHandlerSocketBase(FDataChannel.IOHandler).Passthrough := False; end; if Assigned(LCompressor) then begin LCompressor.CompressFTPToIO(ASource, FDataChannel.IOHandler, FZLibCompressionLevel, FZLibWindowBits, FZLibMemLevel, FZLibStratagy); end else begin if AFromBeginning then begin {$IFNDEF MSWINDOWS} WriteStreamFromBeginning; {$ELSE} FDataChannel.IOHandler.Write(ASource, 0, False); // from beginning {$ENDIF} end else begin FDataChannel.IOHandler.Write(ASource, -1, False); // from current position end; end; end; except on E: EIdSocketError do begin // If 10038 - abort was called. Server will return 225 if E.LastError <> 10038 then begin raise; end; end; end; finally if LPasvCl <> nil then begin LPasvCl.Disconnect(False); end; end; finally FinalizeDataOperation; end; end else begin if Socket <> nil then begin FDataChannel := TIdSimpleServer.Create(nil); end else begin FDataChannel := nil; end; LPortSv := TIdSimpleServer(FDataChannel); try InitDataChannel; if LPortSv <> nil then begin LPortSv.BoundIP := Self.Socket.Binding.IP; LPortSv.BoundPort := FDataPort; LPortSv.BoundPortMin := FDataPortMin; LPortSv.BoundPortMax := FDataPortMax; DoOnDataChannelCreate; LPortSv.BeginListen; if FUsingExtDataPort then begin SendEPort(LPortSv.Binding); end else begin SendPort(LPortSv.Binding); end; end else begin { if FUsingExtDataPort then begin SendEPort(?); end else begin SendPort(?); end; } end; if AResume then begin Self.SendCmd('REST ' + IntToStr(ASource.Position), [350]); {do not localize} end; Self.SendCmd(ACommand, [125, 150]); if LPortSv <> nil then begin LPortSv.Listen(ListenTimeout); if FUsingSFTP and (FDataPortProtection = ftpdpsPrivate) then begin TIdSSLIOHandlerSocketBase(FDataChannel.IOHandler).PassThrough := False; end; if Assigned(LCompressor) then begin LCompressor.CompressFTPToIO(ASource, FDataChannel.IOHandler, FZLibCompressionLevel, FZLibWindowBits, FZLibMemLevel, FZLibStratagy); end else begin if AFromBeginning then begin {$IFNDEF MSWINDOWS} WriteStreamFromBeginning; {$ELSE} FDataChannel.IOHandler.Write(ASource, 0, False); // from beginning {$ENDIF} end else begin FDataChannel.IOHandler.Write(ASource, -1, False); // from current position end; end; end; finally FinalizeDataOperation; end; end; { This will silently ignore the STOR request if the server has forcibly disconnected (kicked or timed out) before the request starts except //Note that you are likely to get an exception you abort a transfer //hopefully, this will make things work better. on E: EIdConnClosedGracefully do begin end; end;} { commented out because we might need to revert back to this if new code fails. if (LResponse = 426) or (LResponse = 450) then begin // some servers respond with 226 on ABOR GetResponse([226, 225]); DoStatus(ftpAborted, [RSFTPStatusAbortTransfer]); end; } end; procedure TIdFTP.InternalGet(const ACommand: string; ADest: TStream; AResume: Boolean = false); var LIP: string; LPort: TIdPort; LPasvCl : TIdTCPClient; LPortSv : TIdSimpleServer; // under ARC, convert a weak reference to a strong reference before working with it LCompressor: TIdZLibCompressorBase; begin FAbortFlag.Value := False; LCompressor := nil; if FCurrentTransferMode = dmDeflate then begin LCompressor := FCompressor; if not Assigned(LCompressor) then begin raise EIdFTPMissingCompressor.Create(RSFTPMissingCompressor); end; if not LCompressor.IsReady then begin raise EIdFTPCompressorNotReady.Create(RSFTPCompressorNotReady); end; end; DoStatus(ftpTransfer, [RSFTPStatusStartTransfer]); if FPassive then begin SendPret(ACommand); //PASV or EPSV if FUsingExtDataPort then begin SendEPassive(LIP, LPort); end else begin SendPassive(LIP, LPort); end; if Socket <> nil then begin FDataChannel := TIdTCPClient.Create(nil); end else begin FDataChannel := nil; end; LPasvCl := TIdTCPClient(FDataChannel); try InitDataChannel; if (Self.Socket <> nil) and PassiveUseControlHost then begin //Do not use an assignment from Self.Host //because a DNS name may not resolve to the same //IP address every time. This is the case where //the workload is distributed around several servers. //Besides, we already know the Peer's IP address so //why waste time querying it. LIP := Self.Socket.Binding.PeerIP; end; if LPasvCl <> nil then begin LPasvCl.Host := LIP; LPasvCl.Port := LPort; DoOnDataChannelCreate; LPasvCl.Connect; end; try if AResume then begin Self.SendCmd('REST ' + IntToStr(ADest.Position), [350]); {do not localize} end; // APR: Ericsson Switch FTP // // RLebeau: some servers send 450 when no files are // present, so do not read the stream in that case if Self.SendCmd(ACommand, [125, 150, 154, 450]) <> 450 then begin if LPasvCl <> nil then begin if FUsingSFTP and (FDataPortProtection = ftpdpsPrivate) then begin TIdSSLIOHandlerSocketBase(FDataChannel.IOHandler).Passthrough := False; end; if Assigned(LCompressor) then begin LCompressor.DecompressFTPFromIO(LPasvCl.IOHandler, ADest, FZLibWindowBits); end else begin LPasvCl.IOHandler.ReadStream(ADest, -1, True); end; end; end; finally if LPasvCl <> nil then begin LPasvCl.Disconnect(False); end; end; finally FinalizeDataOperation; end; end else begin // PORT or EPRT if Socket <> nil then begin FDataChannel := TIdSimpleServer.Create(nil); end else begin FDataChannel := nil; end; LPortSv := TIdSimpleServer(FDataChannel); try InitDataChannel; if LPortSv <> nil then begin LPortSv.BoundIP := Self.Socket.Binding.IP; LPortSv.BoundPort := FDataPort; LPortSv.BoundPortMin := FDataPortMin; LPortSv.BoundPortMax := FDataPortMax; DoOnDataChannelCreate; LPortSv.BeginListen; if FUsingExtDataPort then begin SendEPort(LPortSv.Binding); end else begin SendPort(LPortSv.Binding); end; end else begin { if FUsingExtDataPort then begin SendEPort(?); end else begin SendPort(?); end; } end; if AResume then begin SendCmd('REST ' + IntToStr(ADest.Position), [350]); {do not localize} end; SendCmd(ACommand, [125, 150, 154]); //APR: Ericsson Switch FTP); if LPortSv <> nil then begin LPortSv.Listen(ListenTimeout); if FUsingSFTP and (FDataPortProtection = ftpdpsPrivate) then begin TIdSSLIOHandlerSocketBase(FDataChannel.IOHandler).PassThrough := False; end; if Assigned(LCompressor) then begin LCompressor.DecompressFTPFromIO(LPortSv.IOHandler, ADest, FZLibWindowBits); end else begin FDataChannel.IOHandler.ReadStream(ADest, -1, True); end; end; finally FinalizeDataOperation; end; end; // 226 = download successful, 225 = Abort successful} //commented out in case we need to revert back to this. { LResponse := GetResponse([225, 226, 250, 426, 450]); if (LResponse = 426) or (LResponse = 450) then begin GetResponse([226, 225]); DoStatus(ftpAborted, [RSFTPStatusAbortTransfer]); end; } end; procedure TIdFTP.DoOnDataChannelCreate; begin // While the Control Channel is idle, Enable/disable TCP/IP keepalives. // They're very small (40-byte) packages and will be sent every // NATKeepAlive.IntervalMS after the connection has been idle for // NATKeepAlive.IdleTimeMS. Prior to Windows 2000, the idle and // timeout values are system wide and have to be set in the registry; // the default is idle = 2 hours, interval = 1 second. if (Socket <> nil) and NATKeepAlive.UseKeepAlive then begin Socket.Binding.SetKeepAliveValues(True, NATKeepAlive.IdleTimeMS, NATKeepAlive.IntervalMS); end; if Assigned(FOnDataChannelCreate) then begin OnDataChannelCreate(Self, FDataChannel); end; end; procedure TIdFTP.DoOnDataChannelDestroy; begin if Assigned(FOnDataChannelDestroy) then begin OnDataChannelDestroy(Self, FDataChannel); end; if (Socket <> nil) and NATKeepAlive.UseKeepAlive then begin Socket.Binding.SetKeepAliveValues(False, 0, 0); end; end; procedure TIdFTP.SetNATKeepAlive(AValue: TIdFTPKeepAlive); begin FNATKeepAlive.Assign(AValue); end; { TIdFtpKeepAlive } procedure TIdFtpKeepAlive.Assign(Source: TPersistent); var LSource: TIdFTPKeepAlive; begin if Source is TIdFTPKeepAlive then begin LSource := TIdFTPKeepAlive(Source); FUseKeepAlive := LSource.UseKeepAlive; FIdleTimeMS := LSource.IdleTimeMS; FIntervalMS := LSource.IntervalMS; end else begin inherited Assign(Source); end; end; procedure TIdFTP.DisconnectNotifyPeer; begin if IOHandler.Connected then begin IOHandler.WriteLn('QUIT'); {do not localize} IOHandler.CheckForDataOnSource(100); if not IOHandler.InputBufferIsEmpty then begin GetInternalResponse; end; end; end; {$I IdDeprecatedImplBugOff.inc} procedure TIdFTP.Quit; {$I IdDeprecatedImplBugOn.inc} begin Disconnect; end; procedure TIdFTP.KillDataChannel; begin // Had kill the data channel () if Assigned(FDataChannel) then begin FDataChannel.Disconnect(False); //FDataChannel.IOHandler.DisconnectSocket; {//BGO} end; end; // IMPORTANT!!! THis is for later reference. // // Note that we do not send the Telnet IP and Sync as suggestedc by RFC 959. // We do not do so because some servers will mistakenly assume that the sequences // are part of the command and than give a syntax error. // I noticed this with FTPSERVE IBM VM Level 510, Microsoft FTP Service (Version 5.0), // GlobalSCAPE Secure FTP Server (v. 2.0), and Pure-FTPd [privsep] [TLS]. // // Thus, I feel that sending sequences is just going to aggravate this situation. // It is probably the reason why some FTP clients no longer are sending Telnet IP // and Sync with the ABOR command. procedure TIdFTP.Abort; begin // only send the abort command. The Data channel is supposed to disconnect if Connected then begin IOHandler.WriteLn('ABOR'); {do not localize} end; // Kill the data channel: usually, the server doesn't close it by itself KillDataChannel; if Assigned(FDataChannel) then begin FAbortFlag.Value := True; end else begin GetResponse([]); end; end; procedure TIdFTP.SendPort(AHandle: TIdSocketHandle); begin if FExternalIP <> '' then begin SendPort(FExternalIP, AHandle.Port); end else begin SendPort(AHandle.IP, AHandle.Port); end; end; procedure TIdFTP.SendPort(const AIP: String; const APort: TIdPort); begin SendDataSettings; SendCmd('PORT ' + ReplaceAll(AIP, '.', ',') {do not localize} + ',' + IntToStr(APort div 256) + ',' + IntToStr(APort mod 256), [200]); {do not localize} end; procedure TIdFTP.InitDataChannel; var LSSL : TIdSSLIOHandlerSocketBase; begin if FDataChannel = nil then begin Exit; end; if FDataPortProtection = ftpdpsPrivate then begin LSSL := TIdSSLIOHandlerSocketBase(IOHandler); FDataChannel.IOHandler := LSSL.Clone; //we have to delay the actual negotiation until we get the reply and //and just before the readString TIdSSLIOHandlerSocketBase(FDataChannel.IOHandler).Passthrough := True; end else begin FDataChannel.IOHandler := TIdIOHandler.MakeDefaultIOHandler(Self); end; if FDataChannel is TIdTCPClient then begin TIdTCPClient(FDataChannel).IPVersion := IPVersion; TIdTCPClient(FDataChannel).ReadTimeout := FTransferTimeout; //Now SocksInfo are multi-thread safe FDataChannel.IOHandler.ConnectTimeout := IOHandler.ConnectTimeout; end else if FDataChannel is TIdSimpleServer then begin TIdSimpleServer(FDataChannel).IPVersion := IPVersion; end; if Assigned(FDataChannel.Socket) and Assigned(Socket) then begin FDataChannel.Socket.TransparentProxy := Socket.TransparentProxy; end; FDataChannel.IOHandler.ReadTimeout := FTransferTimeout; FDataChannel.IOHandler.SendBufferSize := IOHandler.SendBufferSize; FDataChannel.IOHandler.RecvBufferSize := IOHandler.RecvBufferSize; FDataChannel.IOHandler.LargeStream := True; // FDataChannel.IOHandler.DefStringEncoding := IndyTextEncoding_8Bit; // FDataChannel.IOHandler.DefAnsiEncoding := IndyTextEncoding_OSDefault; FDataChannel.WorkTarget := Self; end; procedure TIdFTP.Put(const ASource: TStream; const ADestFile: string; const AAppend: Boolean = False; const AStartPos: TIdStreamSize = -1); begin if ADestFile = '' then begin raise EIdFTPUploadFileNameCanNotBeEmpty.Create(RSFTPFileNameCanNotBeEmpty); end; if AStartPos > -1 then begin ASource.Position := AStartPos; end; DoBeforePut(ASource); //APR); if AAppend then begin InternalPut('APPE ' + ADestFile, ASource, False, False); {Do not localize} end else begin InternalPut('STOR ' + ADestFile, ASource, AStartPos = -1, AStartPos > -1); {Do not localize} end; DoAfterPut; end; procedure TIdFTP.Put(const ASourceFile: string; const ADestFile: string = ''; const AAppend: Boolean = False; const AStartPos: TIdStreamSize = -1); var LSourceStream: TStream; LDestFileName : String; begin LDestFileName := ADestFile; if LDestFileName = '' then begin LDestFileName := ExtractFileName(ASourceFile); end; LSourceStream := TIdReadFileNonExclusiveStream.Create(ASourceFile); try Put(LSourceStream, LDestFileName, AAppend, AStartPos); finally FreeAndNil(LSourceStream); end; end; procedure TIdFTP.StoreUnique(const ASource: TStream; const AStartPos: TIdStreamSize = -1); begin if AStartPos > -1 then begin ASource.Position := AStartPos; end; DoBeforePut(ASource); InternalPut('STOU', ASource, AStartPos = -1, False); {Do not localize} DoAfterPut; end; procedure TIdFTP.StoreUnique(const ASourceFile: string; const AStartPos: TIdStreamSize = -1); var LSourceStream: TStream; begin LSourceStream := TIdReadFileExclusiveStream.Create(ASourceFile); try StoreUnique(LSourceStream, AStartPos); finally FreeAndNil(LSourceStream); end; end; procedure TIdFTP.SendInternalPassive(const ACmd: String; var VIP: string; var VPort: TIdPort); function IsRoutableAddress(AIP: string): Boolean; begin Result := not TextStartsWith(AIP, '127') and // Loopback 127.0.0.0-127.255.255.255 not TextStartsWith(AIP, '10.') and // Private 10.0.0.0-10.255.255.255 not TextStartsWith(AIP, '169.254') and // Link-local 169.254.0.0-169.254.255.255 not TextStartsWith(AIP, '192.168') and // Private 192.168.0.0-192.168.255.255 not (TextStartsWith(AIP, '172') and (AIP[7] = '.') and // Private 172.16.0.0-172.31.255.255 (IndyStrToInt(Copy(AIP, 5, 2)) in [16..31])) end; var i, bLeft, bRight: integer; s: string; begin SendDataSettings; SendCmd(ACmd, 227); {do not localize} s := Trim(LastCmdResult.Text[0]); // Case 1 (Normal) // 227 Entering passive mode(100,1,1,1,23,45) bLeft := IndyPos('(', s); {do not localize} bRight := IndyPos(')', s); {do not localize} // Microsoft FTP Service may include a leading ( but not a trailing ), // so handle any combination of "(..)", "(..", "..)", and ".." if bLeft = 0 then bLeft := RPos(#32, S); if bRight = 0 then bRight := Length(S) + 1; S := Copy(S, bLeft + 1, bRight - bLeft - 1); VIP := ''; {do not localize} for i := 1 to 4 do begin VIP := VIP + '.' + Fetch(s, ','); {do not localize} end; IdDelete(VIP, 1, 1); // Server sent an unroutable address (private/reserved/etc). Use the IP we // connected to instead if not IsRoutableAddress(VIP) and IsRoutableAddress(Socket.Binding.PeerIP) then begin VIP := Socket.Binding.PeerIP; end; // Determine port VPort := TIdPort(IndyStrToInt(Fetch(s, ',')) and $FF) shl 8; {do not localize} //use trim as one server sends something like this: //"227 Passive mode OK (195,92,195,164,4,99 )" VPort := VPort or TIdPort(IndyStrToInt(Fetch(s, ',')) and $FF); {Do not translate} end; procedure TIdFTP.SendPassive(var VIP: string; var VPort: TIdPort); begin SendInternalPassive('PASV', VIP, VPort); {do not localize} end; procedure TIdFTP.SendCPassive(var VIP: string; var VPort: TIdPort); begin SendInternalPassive('CPSV', VIP, VPort); {do not localize} end; procedure TIdFTP.Noop; begin SendCmd('NOOP', 200); {do not localize} end; procedure TIdFTP.MakeDir(const ADirName: string); begin SendCmd('MKD ' + ADirName, 257); {do not localize} end; function TIdFTP.RetrieveCurrentDir: string; begin SendCmd('PWD', 257); {do not localize} Result := LastCmdResult.Text[0]; IdDelete(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; procedure TIdFTP.RemoveDir(const ADirName: string); begin SendCmd('RMD ' + ADirName, 250); {do not localize} end; procedure TIdFTP.Delete(const AFilename: string); begin // Linksys NSLU2 NAS returns 200, Ultimodule IDAL returns 257 SendCmd('DELE ' + AFilename, [200, 250, 257]); {do not localize} end; (* CHANGE WORKING DIRECTORY (CWD) This command allows the user to work with a different directory or dataset for file storage or retrieval without altering his login or accounting information. Transfer parameters are similarly unchanged. The argument is a pathname specifying a directory or other system dependent file group designator. CWD 250 500, 501, 502, 421, 530, 550 *) procedure TIdFTP.ChangeDir(const ADirName: string); begin SendCmd('CWD ' + ADirName, [200, 250, 257]); //APR: Ericsson Switch FTP {do not localize} end; (* CHANGE TO PARENT DIRECTORY (CDUP) This command is a special case of CWD, and is included to simplify the implementation of programs for transferring directory trees between operating systems having different syntaxes for naming the parent directory. The reply codes shall be identical to the reply codes of CWD. See Appendix II for further details. CDUP 200 500, 501, 502, 421, 530, 550 *) procedure TIdFTP.ChangeDirUp; begin // RFC lists 200 as the proper response, but in another section says that it can return the // same as CWD, which expects 250. That is it contradicts itself. // MS in their infinite wisdom chnaged IIS 5 FTP to return 250. SendCmd('CDUP', [200, 250]); {do not localize} end; procedure TIdFTP.Site(const ACommand: string); begin SendCmd('SITE ' + ACommand, 200); {do not localize} end; procedure TIdFTP.Rename(const ASourceFile, ADestFile: string); begin SendCmd('RNFR ' + ASourceFile, 350); {do not localize} SendCmd('RNTO ' + ADestFile, 250); {do not localize} end; function TIdFTP.Size(const AFileName: String): Int64; var LTrans : TIdFTPTransferType; SizeStr: String; begin Result := -1; // RLebeau 03/13/2009: some servers refuse to accept the SIZE command in // ASCII mode, returning a "550 SIZE not allowed in ASCII mode" reply. // We put the connection in BINARY mode, even though no data connection is // actually being used. We restore it if the original mode was not BINARY. // It's a good idea to do this anyway because some other clients do this // as well. LTrans := TransferType; if LTrans <> ftBinary then begin Self.TransferType := ftBinary; end; try if SendCmd('SIZE ' + AFileName) = 213 then begin {do not localize} SizeStr := Trim(LastCmdResult.Text.Text); IdDelete(SizeStr, 1, IndyPos(' ', SizeStr)); // delete the response {do not localize} Result := IndyStrToInt64(SizeStr, -1); end; finally if LTrans <> ftBinary then begin TransferType := LTrans; end; end; end; //Added by SP procedure TIdFTP.ReInitialize(ADelay: UInt32 = 10); begin IndySleep(ADelay); //Added if SendCmd('REIN', [120, 220, 500]) <> 500 then begin {do not localize} FLoginMsg.Clear; FCanResume := False; if Assigned(FDirectoryListing) then begin FDirectoryListing.Clear; end; FUsername := ''; {do not localize} FPassword := ''; {do not localize} FPassive := Id_TIdFTP_Passive; FCanResume := False; FResumeTested := False; FSystemDesc := ''; FTransferType := Id_TIdFTP_TransferType; IOHandler.DefStringEncoding := IndyTextEncoding_8Bit; {$IFDEF STRING_IS_ANSI} IOHandler.DefAnsiEncoding := IndyTextEncoding_OSDefault; {$ENDIF} if FUsingSFTP and (FUseTLS <> utUseImplicitTLS) then begin (IOHandler as TIdSSLIOHandlerSocketBase).PassThrough := True; FUsingSFTP := False; FUseCCC := False; end; end; end; procedure TIdFTP.Allocate(AAllocateBytes: Integer); begin SendCmd('ALLO ' + IntToStr(AAllocateBytes), [200]); {do not localize} end; procedure TIdFTP.Status(AStatusList: TStrings); begin if SendCmd('STAT', [211, 212, 213, 500]) <> 500 then begin {do not localize} AStatusList.Text := LastCmdResult.Text.Text; end; end; procedure TIdFTP.Help(AHelpContents: TStrings; ACommand: String = ''); {do not localize} begin if SendCmd(Trim('HELP ' + ACommand), [211, 214, 500]) <> 500 then begin {do not localize} AHelpContents.Text := LastCmdResult.Text.Text; end; end; function TIdFTP.CheckAccount: Boolean; begin if (FAccount = '') and Assigned(FOnNeedAccount) then begin FOnNeedAccount(Self, FAccount); end; Result := FAccount <> ''; end; procedure TIdFTP.StructureMount(APath: String); begin SendCmd('SMNT ' + APath, [202, 250, 500]); {do not localize} end; procedure TIdFTP.FileStructure(AStructure: TIdFTPDataStructure); const StructureTypes: array[TIdFTPDataStructure] of String = ('F', 'R', 'P'); {do not localize} begin SendCmd('STRU ' + StructureTypes[AStructure], [200, 500]); {do not localize} end; procedure TIdFTP.TransferMode(ATransferMode: TIdFTPTransferMode); var s: String; begin if FCurrentTransferMode <> ATransferMode then begin s := ''; case ATransferMode of // dmBlock: begin // s := 'B'; {do not localize} // end; // dmCompressed: begin // s := 'C'; {do not localize} // end; dmStream: begin s := 'S'; {do not localize} end; dmDeflate: begin if not Assigned(FCompressor) then begin raise EIdFTPMissingCompressor.Create(RSFTPMissingCompressor); end; if Self.IsCompressionSupported then begin s := 'Z'; {Do not localize} end; end; end; if s = '' then begin raise EIdFTPUnsupportedTransferMode.Create(RSFTPUnsupportedTransferMode); end; SendCmd('MODE ' + s, 200); {do not localize} FCurrentTransferMode := ATransferMode; end; end; destructor TIdFTP.Destroy; begin FreeAndNil(FClientInfo); FreeAndNil(FListResult); FreeAndNil(FLoginMsg); FreeAndNil(FDirectoryListing); FreeAndNil(FLangsSupported); FreeAndNil(FProxySettings); //APR FreeAndNil(FTZInfo); FreeAndNil(FAbortFlag); FreeAndNil(FNATKeepAlive); inherited Destroy; end; function TIdFTP.Quote(const ACommand: String): Int16; begin Result := SendCmd(ACommand); end; procedure TIdFTP.IssueFEAT; var LClnt: String; LBuf : String; i : Integer; begin //Feat data SendCmd('FEAT'); {do not localize} FCapabilities.Clear; //Ipswitch's FTP WS-FTP Server may issue 221 as success if LastCmdResult.NumericCode in [211,221] then begin FCapabilities.AddStrings(LastCmdResult.Text); //we remove the first and last lines because we only want the list if FCapabilities.Count > 0 then begin FCapabilities.Delete(0); end; if FCapabilities.Count > 0 then begin FCapabilities.Delete(FCapabilities.Count-1); end; end; if FUsingExtDataPort then begin FUsingExtDataPort := IsExtSupported('EPRT') and IsExtSupported('EPSV'); {do not localize} end; FCanUseMLS := IsExtSupported('MLSD') or IsExtSupported('MLST'); {do not localize} ExtractFeatFacts('LANG', FLangsSupported); {do not localize} //see if compression is supported. //we parse this way because IxExtensionSupported can only work //with one word. FIsCompressionSupported := False; for i := 0 to FCapabilities.Count-1 do begin LBuf := Trim(FCapabilities[i]); if LBuf = 'MODE Z' then begin {do not localize} FIsCompressionSupported := True; Break; end; end; // send the CLNT command before sending the OPTS UTF8 command. // some servers need this in order to work around a bug in // Microsoft Internet Explorer's UTF-8 handling if IsExtSupported('CLNT') then begin {do not localize} LClnt := FClientInfo.ClntOutput; if LClnt = '' then begin LClnt := gsIdProductName + ' ' + gsIdVersion; end; SendCmd('CLNT ' + LClnt); {do not localize} end; if IsExtSupported('UTF8') then begin {do not localize} // RLebeau 10/1/13: per RFC 2640, OPTS commands are no longer used to // activate UTF-8. If the server reports the 'UTF8' capability, it is // required to detect and accept UTF-8 encoded paths/filenames... { // trying non-standard UTF-8 extension first, many servers use this... // Cerberus and RaidenFTP return 220, but TitanFTP and Gene6 return 200 instead... if not SendCmd('OPTS UTF8 ON') in [200, 220] then begin {do not localize // trying draft-ietf-ftpext-utf-8-option-00.txt next... if SendCmd('OPTS UTF-8 NLST') <> 200 then begin {do not localize Exit; end; end; } IOHandler.DefStringEncoding := IndyTextEncoding_UTF8; end; end; procedure TIdFTP.Login; var i : Integer; LResp : Word; LCmd : String; function FtpHost: String; begin if FPort = IDPORT_FTP then begin Result := FHost; end else begin Result := FHost + Id_TIdFTP_HostPortDelimiter + IntToStr(FPort); end; end; begin //This has to be here because the Rein command clears encryption. //RFC 4217 //TLS part FUsingSFTP := False; if UseTLS in ExplicitTLSVals then begin if FAUTHCmd = tAuto then begin {Note that we can not call SupportsTLS at all. That depends upon the FEAT response and unfortunately, some servers such as WS_FTP Server 4.0.0 (78162662) will not accept a FEAT command until you login. In other words, you have to do this by trial and error. } //334 has to be accepted because of a broekn implementation //see: http://www.ford-hutchinson.com/~fh-1-pfh/ftps-ext.html#bad {Note that we have to try several commands because some servers use AUTH TLS while others use AUTH SSL. GlobalScape's FTP Server only uses AUTH SSL while IpSwitch's uses AUTH TLS (the correct behavior). We try two other commands for historical reasons. } for i := 0 to 3 do begin LResp := SendCmd('AUTH ' + TLS_AUTH_NAMES[i]); {do not localize} if (LResp = 234) or (LResp = 334) then begin //okay. do the handshake TLSHandshake; FUsingSFTP := True; //we are done with the negotiation, let's close this. Break; end; //see if the error was not any type of syntax error code //if it wasn't, we fail the command. if (LResp div 500) <> 1 then begin ProcessTLSNegCmdFailed; Break; end; end; end else begin LResp := SendCmd('AUTH ' + TLS_AUTH_NAMES[Ord(FAUTHCmd)-1]); {do not localize} if (LResp = 234) or (LResp = 334) then begin //okay. do the handshake TLSHandshake; FUsingSFTP := True; end else begin ProcessTLSNegCmdFailed; end; end; end; if not FUsingSFTP then begin ProcessTLSNotAvail; end; //login case ProxySettings.ProxyType of fpcmNone: begin LCmd := MakeXAUTCmd( Greeting.Text.Text , FUserName, GetLoginPassword); if (LCmd <> '') and (not GetFIPSMode ) then begin if SendCmd(LCmd, [230, 232, 331]) = 331 then begin {do not localize} if IsAccountNeeded then begin if CheckAccount then begin SendCmd('ACCT ' + FAccount, [202, 230, 500]); {do not localize} end else begin RaiseExceptionForLastCmdResult; end; end; end; end else begin if SendCmd('USER ' + FUserName, [230, 232, 331]) = 331 then begin {do not localize} SendCmd('PASS ' + GetLoginPassword, [230, 332]); {do not localize} if IsAccountNeeded then begin if CheckAccount then begin SendCmd('ACCT ' + FAccount, [202, 230, 500]); {do not localize} end else begin RaiseExceptionForLastCmdResult; end; end; end; end; end; fpcmUserSite: begin //This also supports WinProxy if Length(ProxySettings.UserName) > 0 then begin if SendCmd('USER ' + ProxySettings.UserName, [230, 331]) = 331 then begin {do not localize} SendCmd('PASS ' + ProxySettings.Password, 230); {do not localize} if IsAccountNeeded then begin if CheckAccount then begin SendCmd('ACCT ' + FAccount, [202, 230, 500]); {do not localize} end else begin RaiseExceptionForLastCmdResult; end; end; end; end; if SendCmd('USER ' + FUserName + '@' + FtpHost, [230, 232, 331]) = 331 then begin {do not localize} SendCmd('PASS ' + GetLoginPassword, [230, 331]); {do not localize} if IsAccountNeeded then begin if CheckAccount then begin SendCmd('ACCT ' + FAccount, [202, 230, 500]); {do not localize} end else begin RaiseExceptionForLastCmdResult; end; end; end; end; fpcmSite: begin if Length(ProxySettings.UserName) > 0 then begin if SendCmd('USER ' + ProxySettings.UserName, [230, 331]) = 331 then begin {do not localize} SendCmd('PASS ' + ProxySettings.Password, 230); {do not localize} end; end; SendCmd('SITE ' + FtpHost); // ? Server Reply? 220? {do not localize} if SendCmd('USER ' + FUserName, [230, 232, 331]) = 331 then begin {do not localize} SendCmd('PASS ' + GetLoginPassword, [230, 332]); {do not localize} if IsAccountNeeded then begin if CheckAccount then begin SendCmd('ACCT ' + FAccount, [202, 230, 500]); {do not localize} end else begin RaiseExceptionForLastCmdResult; end; end; end; end; fpcmOpen: begin if Length(ProxySettings.UserName) > 0 then begin if SendCmd('USER ' + ProxySettings.UserName, [230, 331]) = 331 then begin {do not localize} SendCmd('PASS ' + GetLoginPassword, [230, 332]); {do not localize} if IsAccountNeeded then begin if CheckAccount then begin SendCmd('ACCT ' + FAccount, [202, 230, 500]); {do not localize} end else begin RaiseExceptionForLastCmdResult; end; end; end; end; SendCmd('OPEN ' + FtpHost);//? Server Reply? 220? {do not localize} if SendCmd('USER ' + FUserName, [230, 232, 331]) = 331 then begin {do not localize} SendCmd('PASS ' + GetLoginPassword, [230, 332]); {do not localize} if IsAccountNeeded then begin if CheckAccount then begin SendCmd('ACCT ' + FAccount, [202, 230, 500]); {do not localize} end else begin RaiseExceptionForLastCmdResult; end; end; end; end; fpcmUserPass: //USER user@firewalluser@hostname / PASS pass@firewallpass begin if SendCmd(IndyFormat('USER %s@%s@%s', [FUserName, ProxySettings.UserName, FtpHost]), [230, 232, 331]) = 331 then begin {do not localize} if Length(ProxySettings.Password) > 0 then begin SendCmd('PASS ' + GetLoginPassword + '@' + ProxySettings.Password, [230, 332]); {do not localize} end else begin //// needs otp //// SendCmd('PASS ' + GetLoginPassword, [230,332]); {do not localize} end; if IsAccountNeeded then begin if CheckAccount then begin SendCmd('ACCT ' + FAccount, [202, 230, 500]); {do not localize} end else begin RaiseExceptionForLastCmdResult; end; end; end; end; fpcmTransparent: begin //I think fpcmTransparent means to connect to the regular host and the firewalll //intercepts the login information. if Length(ProxySettings.UserName) > 0 then begin if SendCmd('USER ' + ProxySettings.UserName, [230, 331]) = 331 then begin {do not localize} SendCmd('PASS ' + ProxySettings.Password, [230,332]); {do not localize} end; end; if SendCmd('USER ' + FUserName, [230, 232, 331]) = 331 then begin {do not localize} SendCmd('PASS ' + GetLoginPassword, [230,332]); {do not localize} if IsAccountNeeded then begin if CheckAccount then begin SendCmd('ACCT ' + FAccount, [202, 230, 500]); end else begin RaiseExceptionForLastCmdResult; end; end; end; end; fpcmUserHostFireWallID : //USER hostuserId@hostname firewallUsername begin if SendCmd(Trim('USER ' + Username + '@' + FtpHost + ' ' + ProxySettings.UserName), [230, 331]) = 331 then begin {do not localize} if SendCmd('PASS ' + GetLoginPassword, [230,232,202,332]) = 332 then begin SendCmd('ACCT ' + ProxySettings.Password, [230,232,332]); if IsAccountNeeded then begin if CheckAccount then begin SendCmd('ACCT ' + FAccount, [202, 230, 500]); {do not localize} end else begin RaiseExceptionForLastCmdResult; end; end; end; end; end; fpcmNovellBorder : //Novell Border PRoxy begin if SendCmd(Trim('USER ' + ProxySettings.UserName + '$' + Username + '$' + FtpHost), [230, 331]) = 331 then begin {do not localize} if SendCmd('PASS ' + ProxySettings.UserName + '$' + GetLoginPassword, [230,232,202,332]) = 332 then begin if IsAccountNeeded then begin if CheckAccount then begin SendCmd('ACCT ' + FAccount, [202, 230, 500]); {do not localize} end else begin RaiseExceptionForLastCmdResult; end; end; end; end; end; fpcmHttpProxyWithFtp : begin {GET ftp://XXX:YYY@indy.nevrona.com/ HTTP/1.0 Host: indy.nevrona.com User-Agent: Mozilla/4.0 (compatible; Wincmd; Windows NT) Proxy-Authorization: Basic B64EncodedUserPass== Connection: close} raise EIdSocksServerCommandError.Create(RSSocksServerCommandError); end;//fpcmHttpProxyWithFtp fpcmCustomProxy : begin DoCustomFTPProxy; end; end;//case FLoginMsg.Assign(LastCmdResult); DoOnBannerAfterLogin(FLoginMsg.FormattedReply); //should be here because this can be issued more than once per connection. if FAutoIssueFEAT then begin IssueFEAT; end; SendTransferType(FTransferType); end; procedure TIdFTP.DoAfterLogin; begin if Assigned(FOnAfterClientLogin) then begin OnAfterClientLogin(Self); end; end; procedure TIdFTP.DoFTPList; begin if Assigned(FOnCreateFTPList) then begin FOnCreateFTPList(Self, FDirectoryListing); end; end; function TIdFTP.GetDirectoryListing: TIdFTPListItems; begin if FDirectoryListing = nil then begin if Assigned(FOnDirParseStart) then begin FOnDirParseStart(Self); end; ConstructDirListing; ParseFTPList; end; Result := FDirectoryListing; end; procedure TIdFTP.SetProxySettings(const Value: TIdFtpProxySettings); begin FProxySettings.Assign(Value); end; { TIdFtpProxySettings } procedure TIdFtpProxySettings.Assign(Source: TPersistent); var LSource: TIdFtpProxySettings; begin if Source is TIdFtpProxySettings then begin LSource := TIdFtpProxySettings(Source); FProxyType := LSource.ProxyType; FHost := LSource.Host; FUserName := LSource.UserName; FPassword := LSource.Password; FPort := LSource.Port; end else begin inherited Assign(Source); end; end; procedure TIdFTP.SendPBSZ; begin {NOte that PBSZ - protection buffer size must always be zero for FTP TLS} if FUsingSFTP or (FUseTLS = utUseImplicitTLS) then begin //protection buffer size SendCmd('PBSZ 0'); {do not localize} end; end; procedure TIdFTP.SendPROT; begin case FDataPortProtection of ftpdpsClear : SendCmd('PROT C', 200); //'C' - Clear - neither Integrity nor Privacy {do not localize} // NOT USED - 'S' - Safe - Integrity without Privacy // NOT USED - 'E' - Confidential - Privacy without Integrity // 'P' - Private - Integrity and Privacy ftpdpsPrivate : SendCmd('PROT P', 200); {do not localize} end; end; procedure TIdFTP.SendDataSettings; begin if FUsingSFTP then begin if not FDataSettingsSent then begin FDataSettingsSent := True; SendPBSZ; SendPROT; if FUseCCC then begin FUsingCCC := (SendCmd('CCC') div 100) = 2; {do not localize} if FUsingCCC then begin (IOHandler as TIdSSLIOHandlerSocketBase).PassThrough := True; end; end; end; end; end; procedure TIdFTP.SetIOHandler(AValue: TIdIOHandler); begin inherited SetIOHandler(AValue); // UseExtensionDataPort must be true for IPv6 connections. // PORT and PASV can not communicate IPv6 Addresses if Socket <> nil then begin if Socket.IPVersion = Id_IPv6 then begin FUseExtensionDataPort := True; end; end; end; procedure TIdFTP.SetUseExtensionDataPort(const AValue: Boolean); begin if (not AValue) and (IPVersion = Id_IPv6) then begin raise EIdFTPMustUseExtWithIPv6.Create(RSFTPMustUseExtWithIPv6); end; if TryNATFastTrack then begin raise EIdFTPMustUseExtWithNATFastTrack.Create(RSFTPMustUseExtWithNATFastTrack); end; FUseExtensionDataPort := AValue; end; procedure TIdFTP.ParseEPSV(const AReply : String; var VIP : String; var VPort : TIdPort); var bLeft, bRight, LPort: Integer; delim : Char; s : String; begin s := Trim(AReply); // "229 Entering Extended Passive Mode (|||59028|)" bLeft := IndyPos('(', s); {do not localize} bRight := IndyPos(')', s); {do not localize} s := Copy(s, bLeft + 1, bRight - bLeft - 1); delim := s[1]; // normally is | but the RFC say it may be different Fetch(S, delim); Fetch(S, delim); VIP := Fetch(S, delim); if VIP = '' then begin VIP := Host; end; s := Trim(Fetch(S, delim)); LPort := IndyStrToInt(s, 0); if (LPort < 1) or (LPort > 65535) then begin raise EIdFTPServerSentInvalidPort.CreateFmt(RSFTPServerSentInvalidPort, [s]); end; VPort := TIdPort(LPort and $FFFF); end; procedure TIdFTP.SendEPassive(var VIP: string; var VPort: TIdPort); begin SendDataSettings; //Note that for FTP Proxies, it is not desirable for the server to choose //the EPSV data port IP connection type. We try to if we can. if FProxySettings.ProxyType <> fpcmNone then begin if SendCMD('EPSV ' + cIPVersions[IPVersion]) <> 229 then begin {do not localize} //Raidon and maybe a few others may honor EPSV but not with the proto numbers SendCMD('EPSV'); {do not localize} end; end else begin SendCMD('EPSV'); {do not localize} end; if LastCmdResult.NumericCode <> 229 then begin SendPassive(VIP, VPort); FUsingExtDataPort := False; Exit; end; try ParseEPSV(LastCmdResult.Text[0], VIP, VPort); except SendCmd('ABOR'); {do not localize} raise; end; end; procedure TIdFTP.SendEPort(AHandle: TIdSocketHandle); begin SendDataSettings; if FExternalIP <> '' then begin SendEPort(FExternalIP, AHandle.Port, AHandle.IPVersion); end else begin SendEPort(AHandle.IP, AHandle.Port, AHandle.IPVersion); end; end; procedure TIdFTP.SendEPort(const AIP: String; const APort: TIdPort; const AIPVersion: TIdIPVersion); begin if SendCmd('EPRT |' + cIPVersions[AIPVersion] + '|' + AIP + '|' + IntToStr(APort) + '|') <> 200 then begin {do not localize} SendPort(AIP, APort); FUsingExtDataPort := False; end; end; procedure TIdFTP.SetPassive(const AValue: Boolean); begin if (not AValue) and TryNATFastTrack then begin raise EIdFTPPassiveMustBeTrueWithNATFT.Create(RSFTPFTPPassiveMustBeTrueWithNATFT); end; FPassive := AValue; end; procedure TIdFTP.SetTryNATFastTrack(const AValue: Boolean); begin FTryNATFastTrack := AValue; if FTryNATFastTrack then begin FPassive := True; FUseExtensionDataPort := True; end; end; procedure TIdFTP.DoTryNATFastTrack; begin if IsExtSupported('EPSV') then begin {do not localize} if SendCmd('EPSV ALL') = 229 then begin {do not localize} //Surge FTP treats EPSV ALL as if it were a standard EPSV //We send ABOR in that case so it can close the data connection it created SendCmd('ABOR'); {do not localize} end; FUsingNATFastTrack := True; end; end; procedure TIdFTP.SetCmdOpt(const ACmd, AOptions: String); begin SendCmd('OPTS ' + ACmd + ' ' + AOptions, 200); {do not localize} end; procedure TIdFTP.ExtListDir(ADest: TStrings = nil; const ADirectory: string = ''); var LDest: TMemoryStream; LEncoding: IIdTextEncoding; begin // RLebeau 6/4/2009: According to RFC 3659 Section 7.2: // // The data connection opened for a MLSD response shall be a connection // as if the "TYPE L 8", "MODE S", and "STRU F" commands had been given, // whatever FTP transfer type, mode and structure had actually been set, // and without causing those settings to be altered for future commands. // That is, this transfer type shall be set for the duration of the data // connection established for this command only. While the content of // the data sent can be viewed as a series of lines, implementations // should note that there is no maximum line length defined. // Implementations should be prepared to deal with arbitrarily long // lines. LDest := TMemoryStream.Create; try InternalGet(Trim('MLSD ' + ADirectory), LDest); {do not localize} FreeAndNil(FDirectoryListing); FDirFormat := ''; DoOnRetrievedDir; LDest.Position := 0; // RLebeau: using IndyTextEncoding_8Bit here. TIdFTPListParseBase will // decode UTF-8 sequences later on... LEncoding := IndyTextEncoding_8Bit; FListResult.Text := ReadStringFromStream(LDest, -1, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF}); LEncoding := nil; TIdFTPListResult(FListResult).FDetails := True; TIdFTPListResult(FListResult).FUsedMLS := True; FDirFormat := MLST; finally FreeAndNil(LDest); end; if Assigned(ADest) then begin //APR: User can use ListResult and DirectoryListing ADest.Assign(FListResult); end; end; procedure TIdFTP.ExtListItem(ADest: TStrings; AFList : TIdFTPListItems; const AItem: string); var i : Integer; begin ADest.Clear; SendCmd(Trim('MLST ' + AItem), 250, IndyTextEncoding_8Bit); {do not localize} for i := 0 to LastCmdResult.Text.Count -1 do begin if IndyPos(';', LastCmdResult.Text[i]) > 0 then begin ADest.Add(LastCmdResult.Text[i]); end; end; if Assigned(AFList) then begin IdFTPListParseBase.ParseListing(ADest, AFList, 'MLST'); {do not localize} end; end; procedure TIdFTP.ExtListItem(ADest: TStrings; const AItem: string); begin ExtListItem(ADest, nil, AItem); end; procedure TIdFTP.ExtListItem(AFList: TIdFTPListItems; const AItem: String); var LBuf : TStrings; begin LBuf := TStringList.Create; try ExtListItem(LBuf, AFList, AItem); finally FreeAndNil(LBuf); end; end; function TIdFTP.IsExtSupported(const ACmd: String): Boolean; var i : Integer; LBuf : String; begin Result := False; for i := 0 to FCapabilities.Count -1 do begin LBuf := TrimLeft(FCapabilities[i]); if TextIsSame(Fetch(LBuf), ACmd) then begin Result := True; Exit; end; end; end; function TIdFTP.FileDate(const AFileName: String; const AsGMT: Boolean): TDateTime; var LBuf : String; begin //Do not use the FEAT list because some servers //may support it even if FEAT isn't supported if SendCmd('MDTM ' + AFileName) = 213 then begin {do not localize} LBuf := LastCmdResult.Text[0]; LBuf := Trim(LBuf); if AsGMT then begin Result := FTPMLSToGMTDateTime(LBuf); end else begin Result := FTPMLSToLocalDateTime(LBuf); end; end else begin Result := 0; end; end; procedure TIdFTP.SiteToSiteUpload(const AToSite : TIdFTP; const ASourceFile : String; const ADestFile : String = ''); { SiteToSiteUpload From: PASV To: PORT - ATargetUsesPasv = False From: RETR To: STOR SiteToSiteDownload From: PORT To: PASV - ATargetUsesPasv = True From: RETR To: STOR } begin if ValidateInternalIsTLSFXP(Self, AToSite, True) then begin InternalEncryptedTLSFXP(Self, AToSite, ASourceFile, ADestFile, True); end else begin InternalUnencryptedFXP(Self, AToSite, ASourceFile, ADestFile, True); end; end; procedure TIdFTP.SiteToSiteDownload(const AFromSite: TIdFTP; const ASourceFile : String; const ADestFile : String = ''); { The only use of this function is to get the passive mode on the other connection. Because not all hosts allow it. This way you get a second chance. If uploading from host A doesn't work, try downloading from host B } begin if ValidateInternalIsTLSFXP(AFromSite, Self, True) then begin InternalEncryptedTLSFXP(AFromSite, Self, ASourceFile, ADestFile, False); end else begin InternalUnencryptedFXP(AFromSite, Self, ASourceFile, ADestFile, False); end; end; procedure TIdFTP.ExtractFeatFacts(const ACmd: String; AResults: TStrings); var i : Integer; LBuf, LFact : String; begin AResults.Clear; for i := 0 to FCapabilities.Count -1 do begin LBuf := FCapabilities[i]; if TextIsSame(Fetch(LBuf), ACmd) then begin LBuf := Trim(LBuf); while LBuf <> '' do begin LFact := Trim(Fetch(LBuf, ';')); if LFact <> '' then begin AResults.Add(LFact); end; end; Exit; end; end; end; procedure TIdFTP.SetLang(const ALangTag: String); begin if IsExtSupported('LANG') then begin {do not localize} SendCMD('LANG ' + ALangTag, 200); {do not localize} end; end; function TIdFTP.CRC(const AFIleName : String; const AStartPoint : Int64 = 0; const AEndPoint : Int64 = 0) : Int64; var LCmd : String; LCRC : String; begin Result := -1; if IsExtSupported('XCRC') then begin {do not localize} LCmd := 'XCRC "' + AFileName + '"'; {do not localize} if AStartPoint <> 0 then begin LCmd := LCmd + ' ' + IntToStr(AStartPoint); if AEndPoint <> 0 then begin LCmd := LCmd + ' ' + IntToStr(AEndPoint); end; end; if SendCMD(LCMD) = 250 then begin LCRC := Trim(LastCmdResult.Text.Text); IdDelete(LCRC, 1, IndyPos(' ', LCRC)); // delete the response Result := IndyStrToInt64('$' + LCRC, -1); end; end; end; procedure TIdFTP.CombineFiles(const ATargetFile: String; AFileParts: TStrings); var i : Integer; LCmd: String; begin if IsExtSupported('COMB') and (AFileParts.Count > 0) then begin {do not localize} LCmd := 'COMB "' + ATargetFile + '"'; {do not localize} for i := 0 to AFileParts.Count -1 do begin LCmd := LCmd + ' ' + AFileParts[i]; end; SendCmd(LCmd, 250); end; end; procedure TIdFTP.ParseFTPList; begin DoOnDirParseStart; try // Parse directory listing if FListResult.Count > 0 then begin if TIdFTPListResult(FListResult).UsedMLS then begin FDirFormat := MLST; IdFTPListParseBase.ParseListing(FListResult, FDirectoryListing, MLST); end else begin CheckListParseCapa(FListResult, FDirectoryListing, FDirFormat, FListParserClass, SystemDesc, TIdFTPListResult(FListResult).Details); end; end else begin FDirFormat := ''; end; finally DoOnDirParseEnd; end; end; function TIdFTP.GetSupportsTLS: Boolean; begin Result := (FindAuthCmd <> ''); end; function TIdFTP.FindAuthCmd: String; var i : Integer; LBuf : String; LWord : String; begin Result := ''; for i := 0 to FCapabilities.Count -1 do begin LBuf := TrimLeft(FCapabilities[i]); if TextIsSame(Fetch(LBuf), 'AUTH') then begin {do not localize} repeat LWord := Trim(Fetch(LBuf, ';')); if PosInStrArray(LWord, TLS_AUTH_NAMES, False) > -1 then begin Result := 'AUTH ' + LWord; {do not localize} Exit; end; until LBuf = ''; Break; end; end; end; procedure TIdFTP.DoCustomFTPProxy; begin if Assigned(FOnCustomFTPProxy) then begin FOnCustomFTPProxy(Self); end else begin raise EIdFTPOnCustomFTPProxyRequired.Create(RSFTPOnCustomFTPProxyReq); end; end; function TIdFTP.GetLoginPassword: String; begin Result := GetLoginPassword(LastCmdResult.Text.Text); end; function TIdFTP.GetLoginPassword(const APrompt: String): String; begin if TIdOTPCalculator.IsValidOTPString(APrompt) then begin TIdOTPCalculator.GenerateSixWordKey(APrompt, FPassword, Result); end else begin Result := FPassword; end; end; function TIdFTP.SetSSCNToOn : Boolean; begin Result := FUsingSFTP; if not Result then begin Exit; end; Result := (DataPortProtection = ftpdpsPrivate); if not Result then begin Exit; end; Result := not IsExtSupported(SCCN_FEAT); if not Result then begin Exit; end; if not FSSCNOn then begin SendCmd(SSCN_ON, SSCN_OK_REPLY); FSSCNOn := True; end; end; procedure TIdFTP.ClearSSCN; begin if FSSCNOn then begin SendCmd(SSCN_OFF, SSCN_OK_REPLY); end; end; procedure TIdFTP.SetClientInfo(const AValue: TIdFTPClientIdentifier); begin FClientInfo.Assign(AValue); end; procedure TIdFTP.SetCompressor(AValue: TIdZLibCompressorBase); var // under ARC, convert a weak reference to a strong reference before working with it LCompressor: TIdZLibCompressorBase; begin LCompressor := FCompressor; if LCompressor <> AValue then begin // under ARC, all weak references to a freed object get nil'ed automatically {$IFNDEF USE_OBJECT_ARC} if Assigned(LCompressor) then begin LCompressor.RemoveFreeNotification(Self); end; {$ENDIF} FCompressor := AValue; if Assigned(AValue) then begin {$IFNDEF USE_OBJECT_ARC} AValue.FreeNotification(Self); {$ENDIF} end else if Connected then begin TransferMode(dmStream); end; end; end; procedure TIdFTP.GetInternalResponse(AEncoding: IIdTextEncoding = nil); var LLine: string; LResponse: TStringList; LReplyCode: string; begin CheckConnected; LResponse := TStringList.Create; try // Some servers with bugs send blank lines before reply. Dont remember // which ones, but I do remember we changed this for a reason // // RLebeau 9/14/06: this can happen in between lines of the reply as well // RLebeau 3/9/09: according to RFC 959, when reading a multi-line reply, // we are supposed to look at the first line's reply code and then keep // reading until that specific reply code is encountered again, and // everything in between is the text. So, do not just look for arbitrary // 3-digit values on each line, but instead look for the specific reply // code... LLine := IOHandler.ReadLnWait(MaxInt, AEncoding); LResponse.Add(LLine); if CharEquals(LLine, 4, '-') then begin LReplyCode := Copy(LLine, 1, 3); repeat LLine := IOHandler.ReadLnWait(MaxInt, AEncoding); LResponse.Add(LLine); until TIdReplyFTP(FLastCmdResult).IsEndReply(LReplyCode, LLine); end; //Note that FormattedReply uses an assign in it's property set method. FLastCmdResult.FormattedReply := LResponse; finally FreeAndNil(LResponse); end; end; function TIdFTP.CheckResponse(const AResponse: Int16; const AAllowedResponses: array of Int16): Int16; var i: Integer; begin // any FTP command can return a 421 reply if the server is going to shut // down the command connection. This way, we can close the connection // immediately instead of waiting for a future action that would raise // an EIdConnClosedGracefully exception instead... if AResponse = 421 then begin // check if the caller explicitally wants to handle 421 replies... if High(AAllowedResponses) > -1 then begin for i := Low(AAllowedResponses) to High(AAllowedResponses) do begin if AResponse = AAllowedResponses[i] then begin Result := AResponse; Exit; end; end; end; Disconnect(False); if IOHandler <> nil then begin IOHandler.InputBuffer.Clear; end; RaiseExceptionForLastCmdResult; end; Result := inherited CheckResponse(AResponse, AAllowedResponses); end; function TIdFTP.GetReplyClass: TIdReplyClass; begin Result := TIdReplyFTP; end; procedure TIdFTP.SetIPVersion(const AValue: TIdIPVersion); begin if AValue <> FIPVersion then begin inherited SetIPVersion(AValue); if IPVersion = Id_IPv6 then begin UseExtensionDataPort := True; end; end; end; class function TIdFTP.InternalEncryptedTLSFXP(AFromSite, AToSite: TIdFTP; const ASourceFile, ADestFile: String; const ATargetUsesPasv : Boolean): Boolean; { SiteToSiteUpload From: PASV To: PORT - ATargetUsesPasv = False From: RETR To: STOR SiteToSiteDownload From: PORT To: PASV - ATargetUsesPasv = True From: RETR To: STOR To do FXP transfers with TLS FTP, you have to have one computer do the TLS handshake as a client (ssl_connect). Thus, one of the following conditions must be meet. 1) SSCN must be supported on one of the FTP servers or 2) If IPv4 is used, the computer receiving a "PASV" command must support CPSV. CPSV will NOT work with IPv6. IMAO, when doing FXP transfers, you should use SSCN whenever possible as SSCN will support IPv6 and SSCN may be in wider use than CPSV. CPSV should only be used as a fallback if SSCN isn't supported by both servers and IPv4 is being used. } var LIP : String; LPort : TIdPort; begin Result := True; if AFromSite.SetSSCNToOn then begin AToSite.ClearSSCN; end else if AToSite.SetSSCNToOn then begin AFromSite.ClearSSCN; end else if AToSite.IPVersion = Id_IPv4 then begin if ATargetUsesPasv then begin AToSite.SendCPassive(LIP, LPort); AFromSite.SendPort(LIP, LPort); end else begin AFromSite.SendCPassive(LIP, LPort); AToSite.SendPort(LIP, LPort); end; end; FXPSendFile(AFromSite, AToSite, ASourceFile, ADestFile); end; class function TIdFTP.InternalUnencryptedFXP(AFromSite, AToSite: TIdFTP; const ASourceFile, ADestFile: String; const ATargetUsesPasv : Boolean): Boolean; { SiteToSiteUpload From: PASV To: PORT - ATargetUsesPasv = False From: RETR To: STOR SiteToSiteDownload From: PORT To: PASV - ATargetUsesPasv = True From: RETR To: STOR } begin FXPSetTransferPorts(AFromSite, AToSite, ATargetUsesPasv); FXPSendFile(AFromSite, AToSite, ASourceFile, ADestFile); Result := True; end; class function TIdFTP.ValidateInternalIsTLSFXP(AFromSite, AToSite: TIdFTP; const ATargetUsesPasv : Boolean): Boolean; { SiteToSiteUpload From: PASV To: PORT - ATargetUsesPasv = False From: RETR To: STOR SiteToSiteDownload From: PORT To: PASV - ATargetUsesPasv = True From: RETR To: STOR This will raise an exception if FXP can not be done. Result = True for encrypted or False for unencrypted. Note: The following is required: SiteToSiteUpload Source must do P } begin if ATargetUsesPasv then begin if AToSite.UsingNATFastTrack then begin raise EIdFTPSToSNATFastTrack.Create(RSFTPNoSToSWithNATFastTrack); end; end else begin if AFromSite.UsingNATFastTrack then begin raise EIdFTPSToSNATFastTrack.Create(RSFTPNoSToSWithNATFastTrack); end; end; if AFromSite.IPVersion <> AToSite.IPVersion then begin raise EIdFTPStoSIPProtoMustBeSame.Create(RSFTPSToSProtosMustBeSame); end; if AFromSite.CurrentTransferMode <> AToSite.CurrentTransferMode then begin raise EIdFTPSToSTransModesMustBeSame.Create(RSFTPSToSTransferModesMusbtSame); end; if AFromSite.FUsingSFTP <> AToSite.FUsingSFTP then begin raise EIdFTPSToSNoDataProtection.Create(RSFTPSToSNoDataProtection); end; Result := AFromSite.FUsingSFTP and AToSite.FUsingSFTP; if Result then begin if not (AFromSite.IsExtSupported('SSCN') or AToSite.IsExtSupported('SSCN')) then begin {do not localize} //Second chance fallback, is CPSV supported on the server where PASV would // be sent if AToSite.IPVersion = Id_IPv4 then begin if ATargetUsesPasv then begin if not AToSite.IsExtSupported('CPSV') then begin {do not localize} raise EIdFTPSToSNATFastTrack.Create(RSFTPSToSSSCNNotSupported); end; end else begin if not AFromSite.IsExtSupported('CPSV') then begin {do not localize} raise EIdFTPSToSNATFastTrack.Create(RSFTPSToSSSCNNotSupported); end; end; end; end; end; end; class procedure TIdFTP.FXPSendFile(AFromSite, AToSite: TIdFTP; const ASourceFile, ADestFile: String); var LDestFile : String; begin LDestFile := ADestFile; if LDestFile = '' then begin LDestFile := ASourceFile; end; AToSite.SendCmd('STOR ' + LDestFile, [110, 125, 150]); {do not localize} try AFromSite.SendCmd('RETR ' + ASourceFile, [110, 125, 150]); {do not localize} except AToSite.Abort; raise; end; AToSite.GetInternalResponse; AFromSite.GetInternalResponse; AToSite.CheckResponse(AToSite.LastCmdResult.NumericCode, [225, 226, 250]); AFromSite.CheckResponse(AFromSite.LastCmdResult.NumericCode, [225, 226, 250]); end; class procedure TIdFTP.FXPSetTransferPorts(AFromSite, AToSite: TIdFTP; const ATargetUsesPasv: Boolean); var LIP : String; LPort : TIdPort; { { SiteToSiteUpload From: PASV To: PORT - ATargetUsesPasv = False From: RETR To: STOR SiteToSiteDownload From: PORT To: PASV - ATargetUsesPasv = True From: RETR To: STOR } begin if ATargetUsesPasv then begin if AToSite.UsingExtDataPort then begin AToSite.SendEPassive(LIP, LPort); end else begin AToSite.SendPassive(LIP, LPort); end; if AFromSite.UsingExtDataPort then begin AFromSite.SendEPort(LIP, LPort, AToSite.IPVersion); end else begin AFromSite.SendPort(LIP, LPort); end; end else begin if AFromSite.UsingExtDataPort then begin AFromSite.SendEPassive(LIP, LPort); end else begin AFromSite.SendPassive(LIP, LPort); end; if AToSite.UsingExtDataPort then begin AToSite.SendEPort(LIP, LPort, AFromSite.IPVersion); end else begin AToSite.SendPort(LIP, LPort); end; end; end; { TIdFTPClientIdentifier } procedure TIdFTPClientIdentifier.Assign(Source: TPersistent); var LSource: TIdFTPClientIdentifier; begin if Source is TIdFTPClientIdentifier then begin LSource := TIdFTPClientIdentifier(Source); ClientName := LSource.ClientName; ClientVersion := LSource.ClientVersion; PlatformDescription := LSource.PlatformDescription; end else begin inherited Assign(Source); end; end; //assume syntax such as this: //214 Syntax: CLNT [ ] (Set client name) function TIdFTPClientIdentifier.GetClntOutput: String; begin if FClientName <> '' then begin Result := FClientName; if FClientVersion <> '' then begin Result := Result + ' ' + FClientVersion; if FPlatformDescription <> '' then begin Result := Result + ' ' + FPlatformDescription; end; end; end else begin Result := ''; end; end; procedure TIdFTPClientIdentifier.SetClientName(const AValue: String); begin FClientName := Trim(AValue); // Don't call Fetch; it prevents multi-word client names end; procedure TIdFTPClientIdentifier.SetClientVersion(const AValue: String); begin FClientVersion := Trim(AValue); end; procedure TIdFTPClientIdentifier.SetPlatformDescription(const AValue: String); begin FPlatformDescription := AValue; end; {Note about SetTime procedures: The first syntax is one used by current Serv-U versions and servers that report "MDTM YYYYMMDDHHMMSS[+-TZ];filename " in their FEAT replies is: 1) MDTM [Time in GMT format] Filename some Bullete Proof FTPD versions, Indy's FTP Server component, and servers reporting "MDTM YYYYMMDDHHMMSS[+-TZ] filename" in their FEAT replies uses an older Syntax which is: 2) MDTM yyyymmddhhmmss[+-minutes from Universal Time] Filename and then there is the classic 3) MDTM [local timestamp] Filename So for example, if I was a file dated Jan 3, 5:00:00 pm from my computer in the Eastern Standard Time (-5 hours from Universal Time), the 3 syntaxes Indy would use are: Syntax 1: 1) MDTM 0103220000 MyFile.exe  (notice the 22 hour) Syntax 2: 2) MDTM 0103170000-300 MyFile.exe (notice the 17 hour and the -300 offset) Syntax 3; 3) MDTM 0103170000 MyFile.exe (notice the 17 hour) Note from: http://www.ftpvoyager.com/releasenotes10x.asp ==== Added support for RFC change and the MDTM. MDTM requires sending the server GMT (UTC) instead of a "fixed" date and time. FTP Voyager supports this with Serv-U automatically by checking the Serv-U version number and by checking the response to the FEAT command for MDTM. Servers returning "MDTM" or "MDTM YYYYMMDDHHMMSS[+-TZ] filename" will use the old method. Servers returning "MDTM YYYYMMDDHHMMSS" only will use the new method where the date a and time is GMT (UTC). === } procedure TIdFTP.SetModTime(const AFileName: String; const ALocalTime: TDateTime); var LCmd: String; begin //use MFMT instead of MDTM because that always takes the time as Universal //time (the most accurate). if IsExtSupported('MFMT') then begin {do not localize} LCmd := 'MFMT ' + FTPLocalDateTimeToMLS(ALocalTime, False) + ' ' + AFileName; {do not localize} end //Syntax 1 - MDTM [Time in GMT format] Filename else if (IndexOfFeatLine('MDTM YYYYMMDDHHMMSS[+-TZ];filename') > 0) or IsIIS then begin {do not localize} //we use the new method LCmd := 'MDTM ' + FTPLocalDateTimeToMLS(ALocalTime, False) + ' ' + AFileName; {do not localize} end //Syntax 2 - MDTM yyyymmddhhmmss[+-minutes from Universal Time] Filename //use old method for old versions of Serv-U and BPFTP Server else if (IndexOfFeatLine('MDTM YYYYMMDDHHMMSS[+-TZ] filename') > 0) or IsOldServU or IsBPFTP then begin {do not localize} LCmd := 'MDTM '+ FTPDateTimeToMDTMD(ALocalTime, False, True) + ' ' + AFileName; {do not localize} end //syntax 3 - MDTM [local timestamp] Filename else if FTZInfo.FGMTOffsetAvailable then begin //send it relative to the server's time-zone LCmd := 'MDTM '+ FTPDateTimeToMDTMD(ALocalTime - OffSetFromUTC + FTZInfo.FGMTOffset, False, False) + ' ' + AFileName; {do not localize} end else begin LCmd := 'MDTM '+ FTPDateTimeToMDTMD(ALocalTime, False, False) + ' ' + AFileName; {do not localize} end; // When using MDTM, Titan FTP 5 returns 200 and vsFTPd returns 213 SendCmd(LCmd, [200, 213, 253]); end; { Note from: http://www.ftpvoyager.com/releasenotes10x.asp ==== Added support for RFC change and the MDTM. MDTM requires sending the server GMT (UTC) instead of a "fixed" date and time. FTP Voyager supports this with Serv-U automatically by checking the Serv-U version number and by checking the response to the FEAT command for MDTM. Servers returning "MDTM" or "MDTM YYYYMMDDHHMMSS[+-TZ] filename" will use the old method. Servers returning "MDTM YYYYMMDDHHMMSS" only will use the new method where the date a and time is GMT (UTC). === } procedure TIdFTP.SetModTimeGMT(const AFileName : String; const AGMTTime: TDateTime); var LCmd: String; begin //use MFMT instead of MDTM because that always takes the time as Universal //time (the most accurate). if IsExtSupported('MFMT') then begin {do not localize} LCmd := 'MFMT ' + FTPGMTDateTimeToMLS(AGMTTime) + ' ' + AFileName; {do not localize} end //Syntax 1 - MDTM [Time in GMT format] Filename else if (IndexOfFeatLine('MDTM YYYYMMDDHHMMSS[+-TZ];filename') > 0) or IsIIS then begin {do not localize} //we use the new method LCmd := 'MDTM ' + FTPGMTDateTimeToMLS(AGMTTime, False) + ' ' + AFileName; {do not localize} end //Syntax 2 - MDTM yyyymmddhhmmss[+-minutes from Universal Time] Filename //use old method for old versions of Serv-U and BPFTP Server else if (IndexOfFeatLine('MDTM YYYYMMDDHHMMSS[+-TZ] filename') > 0) or IsOldServU or IsBPFTP then begin {do not localize} LCmd := 'MDTM '+ FTPDateTimeToMDTMD(AGMTTime + OffSetFromUTC, False, True) + ' ' + AFileName; {do not localize} end //syntax 3 - MDTM [local timestamp] Filename else if FTZInfo.FGMTOffsetAvailable then begin //send it relative to the server's time-zone LCmd := 'MDTM '+ FTPDateTimeToMDTMD(AGMTTime + FTZInfo.FGMTOffset, False, False) + ' ' + AFileName; {do not localize} end else begin LCmd := 'MDTM '+ FTPDateTimeToMDTMD(AGMTTime + OffSetFromUTC, False, False) + ' ' + AFileName; {do not localize} end; // When using MDTM, Titan FTP 5 returns 200 and vsFTPd returns 213 SendCmd(LCmd, [200, 213, 253]); end; {Improvement from Tobias Giesen http://www.superflexible.com His notation is below: "here's a fix for TIdFTP.IndexOfFeatLine. It does not work the way it is used in TIdFTP.SetModTime, because it only compares the first word of the FeatLine." } function TIdFTP.IndexOfFeatLine(const AFeatLine: String): Integer; var LBuf : String; LNoSpaces: Boolean; begin LNoSpaces := IndyPos(' ', AFeatLine) = 0; for Result := 0 to FCapabilities.Count -1 do begin LBuf := TrimLeft(FCapabilities[Result]); // RLebeau: why Fetch() if no spaces are present? if LNoSpaces then begin LBuf := Fetch(LBuf); end; if TextIsSame(AFeatLine, LBuf) then begin Exit; end; end; Result := -1; end; { TIdFTPTZInfo } procedure TIdFTPTZInfo.Assign(Source: TPersistent); var LSource: TIdFTPTZInfo; begin if Source is TIdFTPTZInfo then begin LSource := TIdFTPTZInfo(Source); FGMTOffset := LSource.GMTOffset; FGMTOffsetAvailable := LSource.GMTOffsetAvailable; end else begin inherited Assign(Source); end; end; function TIdFTP.IsSiteZONESupported: Boolean; var LFacts : TStrings; i : Integer; begin Result := False; if IsServerMDTZAndListTForm then begin Result := True; Exit; end; LFacts := TStringList.Create; try ExtractFeatFacts('SITE', LFacts); for i := 0 to LFacts.Count-1 do begin if TextIsSame(LFacts[i], 'ZONE') then begin {do not localize} Result := True; Exit; end; end; finally FreeAndNil(LFacts); end; end; procedure TIdFTP.SetTZInfo(const Value: TIdFTPTZInfo); begin FTZInfo.Assign(Value); end; function TIdFTP.IsOldServU: Boolean; begin Result := TextStartsWith(FServerDesc, 'Serv-U '); {do not localize} end; function TIdFTP.IsBPFTP : Boolean; begin Result := TextStartsWith(FServerDesc, 'BPFTP Server '); {do not localize} end; function TIdFTP.IsTitan : Boolean; begin Result := TextStartsWith(FServerDesc, 'TitanFTP server ') or {do not localize} TextStartsWith(FServerDesc, 'Titan FTP Server '); {do not localize} end; function TIdFTP.IsWSFTP : Boolean; begin Result := IndyPos('WS_FTP Server', FServerDesc) > 0; {do not localize} end; function TIdFTP.IsIIS: Boolean; begin Result := TextStartsWith(FServerDesc, 'Microsoft FTP Service'); {do not localize} end; function TIdFTP.IsServerMDTZAndListTForm: Boolean; begin Result := IsOldServU or IsBPFTP or IsTitan; end; procedure TIdFTP.Notification(AComponent: TComponent; Operation: TOperation); begin if (Operation = opRemove) and (AComponent = FCompressor) then begin SetCompressor(nil); end; inherited Notification(AComponent, Operation); end; procedure TIdFTP.SendPret(const ACommand: String); begin if IsExtSupported('PRET') then begin {do not localize} //note that we don't check for success or failure here //as some servers might fail and then succede with the transfer. //Pret might not work for some commands. SendCmd('PRET ' + ACommand); {do not localize} end; end; procedure TIdFTP.List; begin List(nil); end; procedure TIdFTP.List(const ASpecifier: string; ADetails: Boolean); begin List(nil, ASpecifier, ADetails); end; procedure TIdFTP.DoOnBannerAfterLogin(AText: TStrings); begin if Assigned(OnBannerAfterLogin) then begin OnBannerAfterLogin(Self, AText.Text); end; end; procedure TIdFTP.DoOnBannerBeforeLogin(AText: TStrings); begin if Assigned(OnBannerBeforeLogin) then begin OnBannerBeforeLogin(Self, AText.Text); end; end; procedure TIdFTP.DoOnBannerWarning(AText: TStrings); begin if Assigned(OnBannerWarning) then begin OnBannerWarning(Self, AText.Text); end; end; procedure TIdFTP.SetDataPortProtection(AValue: TIdFTPDataPortSecurity); begin if IsLoading then begin FDataPortProtection := AValue; Exit; end; if FDataPortProtection <> AValue then begin if FUseTLS = utNoTLSSupport then begin raise EIdFTPNoDataPortProtectionWOEncryption.Create(RSFTPNoDataPortProtectionWOEncryption); end; if FUsingCCC then begin raise EIdFTPNoDataPortProtectionAfterCCC.Create(RSFTPNoDataPortProtectionAfterCCC); end; FDataPortProtection := AValue; end; end; procedure TIdFTP.SetAUTHCmd(const AValue : TAuthCmd); begin if IsLoading then begin FAUTHCmd := AValue; Exit; end; if FAUTHCmd <> AValue then begin if FUseTLS = utNoTLSSupport then begin raise EIdFTPNoAUTHWOSSL.Create(RSFTPNoAUTHWOSSL); end; if FUsingSFTP then begin raise EIdFTPCanNotSetAUTHCon.Create(RSFTPNoAUTHCon); end; FAUTHCmd := AValue; end; end; procedure TIdFTP.SetDefStringEncoding(AValue: IIdTextEncoding); begin FDefStringEncoding := AValue; if IOHandler <> nil then begin IOHandler.DefStringEncoding := FDefStringEncoding; end; end; procedure TIdFTP.SetUseTLS(AValue: TIdUseTLS); begin inherited SetUseTLS(AValue); if IsLoading then begin Exit; end; if AValue = utNoTLSSupport then begin FDataPortProtection := Id_TIdFTP_DataPortProtection; FUseCCC := DEF_Id_FTP_UseCCC; FAUTHCmd := DEF_Id_FTP_AUTH_CMD; end; end; procedure TIdFTP.SetUseCCC(const AValue: Boolean); begin if (not IsLoading) and (FUseTLS = utNoTLSSupport) then begin raise EIdFTPNoCCCWOEncryption.Create(RSFTPNoCCCWOEncryption); end; FUseCCC := AValue; end; procedure TIdFTP.DoOnRetrievedDir; begin if Assigned(OnRetrievedDir) then begin OnRetrievedDir(Self); end; end; procedure TIdFTP.DoOnDirParseEnd; begin if Assigned(FOnDirParseEnd) then begin FOnDirParseEnd(Self); end; end; procedure TIdFTP.DoOnDirParseStart; begin if Assigned(FOnDirParseStart) then begin FOnDirParseStart(Self); end; end; //we do this to match some WS-FTP Pro firescripts I saw function TIdFTP.IsAccountNeeded: Boolean; begin Result := LastCmdResult.NumericCode = 332; if not Result then begin if IndyPos('ACCOUNT', LastCmdResult.Text.Text) > 0 then begin {do not localize} Result := FAccount <> ''; end; end; end; //we can use one of three commands for verifying a file or stream function TIdFTP.GetSupportsVerification: Boolean; begin Result := Connected; if Result then begin Result := TIdHashSHA512.IsAvailable and IsExtSupported('XSHA512'); if not Result then begin Result := TIdHashSHA256.IsAvailable and IsExtSupported('XSHA256'); end; if not Result then begin Result := IsExtSupported('XSHA1') or (IsExtSupported('XMD5') and (not GetFIPSMode)) or IsExtSupported('XCRC'); end; end; end; function TIdFTP.VerifyFile(const ALocalFile, ARemoteFile: String; const AStartPoint, AByteCount: TIdStreamSize): Boolean; var LLocalStream: TStream; LRemoteFileName : String; begin LRemoteFileName := ARemoteFile; if LRemoteFileName = '' then begin LRemoteFileName := ExtractFileName(ALocalFile); end; LLocalStream := TIdReadFileExclusiveStream.Create(ALocalFile); try Result := VerifyFile(LLocalStream, LRemoteFileName, AStartPoint, AByteCount); finally FreeAndNil(LLocalStream); end; end; { This procedure can use three possible commands to verify file integriety and the syntax does very amoung these. The commands are: XSHA1 - get SHA1 checksum for a file or file part XMD5 - get MD5 checksum for a file or file part XCRC - get CRC32 checksum The command preference is from first to last (going from longest length to shortest). } function TIdFTP.VerifyFile(ALocalFile: TStream; const ARemoteFile: String; const AStartPoint, AByteCount: TIdStreamSize): Boolean; var LRemoteCRC : String; LLocalCRC : String; LCmd : String; LRemoteFile: String; LStartPoint : TIdStreamSize; LByteCount : TIdStreamSize; //used instead of AByteCount so we don't exceed the file size LHashClass: TIdHashClass; LHash: TIdHash; begin LLocalCRC := ''; LRemoteCRC := ''; if AStartPoint > -1 then begin ALocalFile.Position := AStartPoint; end; LStartPoint := ALocalFile.Position; LByteCount := ALocalFile.Size - LStartPoint; if (LByteCount > AByteCount) and (AByteCount > 0) then begin LByteCount := AByteCount; end; //just in case the server doesn't support file names in quotes. if IndyPos(' ', ARemoteFile) > 0 then begin LRemoteFile := '"' + ARemoteFile + '"'; end else begin LRemoteFile := ARemoteFile; end; if TIdHashSHA512.IsAvailable and IsExtSupported('XSHA512') then begin //XSHA256 pathname [ startposition endposition] LCmd := 'XSHA512 ' + LRemoteFile; if AByteCount > 0 then begin LCmd := LCmd + ' ' + IntToStr(LStartPoint) + ' ' + IntToStr(LByteCount); end else if AStartPoint > 0 then begin LCmd := LCmd + ' ' + IntToStr(LStartPoint); end; LHashClass := TIdHashSHA512; end else if TIdHashSHA256.IsAvailable and IsExtSupported('XSHA256') then begin //XSHA256 pathname [ startposition endposition] LCmd := 'XSHA256 ' + LRemoteFile; if AByteCount > 0 then begin LCmd := LCmd + ' ' + IntToStr(LStartPoint) + ' ' + IntToStr(LByteCount); end else if AStartPoint > 0 then begin LCmd := LCmd + ' ' + IntToStr(LStartPoint); end; LHashClass := TIdHashSHA256; end else if IsExtSupported('XSHA1') then begin //XMD5 "filename" startpos endpos //I think there's two syntaxes to this: // //Raiden Syntax if FEAT line contains " XMD5 filename;start;end" // //or what's used by some other servers if "FEAT line contains XMD5" // //XCRC "filename" [startpos] [number of bytes to calc] if IndexOfFeatLine('XSHA1 filename;start;end') > -1 then begin LCmd := 'XSHA1 ' + LRemoteFile + ' ' + IntToStr(LStartPoint) + ' ' + IntToStr(LStartPoint + LByteCount-1); end else begin //BlackMoon FTP Server uses this one. LCmd := 'XSHA1 ' + LRemoteFile; if AByteCount > 0 then begin LCmd := LCmd + ' ' + IntToStr(LStartPoint) + ' ' + IntToStr(LByteCount); end else if AStartPoint > 0 then begin LCmd := LCmd + ' ' + IntToStr(LStartPoint); end; end; LHashClass := TIdHashSHA1; end else if IsExtSupported('XMD5') and (not GetFIPSMode) then begin //XMD5 "filename" startpos endpos //I think there's two syntaxes to this: // //Raiden Syntax if FEAT line contains " XMD5 filename;start;end" // //or what's used by some other servers if "FEAT line contains XMD5" // //XCRC "filename" [startpos] [number of bytes to calc] if IndexOfFeatLine('XMD5 filename;start;end') > -1 then begin LCmd := 'XMD5 ' + LRemoteFile + ' ' + IntToStr(LStartPoint) + ' ' + IntToStr(LStartPoint + LByteCount-1); end else begin //BlackMoon FTP Server uses this one. LCmd := 'XMD5 ' + LRemoteFile; if AByteCount > 0 then begin LCmd := LCmd + ' ' + IntToStr(LStartPoint) + ' ' + IntToStr(LByteCount); end else if AStartPoint > 0 then begin LCmd := LCmd + ' ' + IntToStr(LStartPoint); end; end; LHashClass := TIdHashMessageDigest5; end else begin LCmd := 'XCRC ' + LRemoteFile; if AByteCount > 0 then begin LCmd := LCmd + ' ' + IntToStr(LStartPoint) + ' ' + IntToStr(LByteCount); end else if AStartPoint > 0 then begin LCmd := LCmd + ' ' + IntToStr(LStartPoint); end; LHashClass := TIdHashCRC32; end; LHash := LHashClass.Create; try LLocalCRC := LHash.HashStreamAsHex(ALocalFile, LStartPoint, LByteCount); finally LHash.Free; end; if SendCmd(LCmd) = 250 then begin LRemoteCRC := Trim(LastCmdResult.Text.Text); IdDelete(LRemoteCRC, 1, IndyPos(' ', LRemoteCRC)); // delete the response Result := TextIsSame(LLocalCRC, LRemoteCRC); end else begin Result := False; end; end; end.