4347 lines
150 KiB
Plaintext
4347 lines
150 KiB
Plaintext
{
|
||
$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<74>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<65>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<65>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;
|
||
|
||
{
|
||
TODO: Change the FTP demo to demonstrate the use of the new events and add proxy support
|
||
}
|
||
|
||
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
|
||
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
|
||
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 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;
|
||
|
||
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}
|
||
// TODO: move this to IdGlobal or IdGlobalProtocols...
|
||
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}
|
||
// TODO: use the implementation already in IdGlobalProtocols...
|
||
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
|
||
// TODO:
|
||
{
|
||
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
|
||
// TODO:
|
||
{
|
||
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;
|
||
|
||
// ToDo: Change that to properly handle response code (not just success or except)
|
||
// 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
|
||
// TODO: handle embedded quotation marks. RFC 959 allows them to be present
|
||
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}
|
||
{ TODO: Needs to be finished }
|
||
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;
|
||
// TODO: should this be moved inside the 'if UseTLS in ExplicitTLSVals' block?
|
||
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
|
||
{Done like this:
|
||
|
||
USER ProxyUserName$ DestFTPUserName$DestFTPHostName
|
||
|
||
PASS UsereDirectoryPassword$ DestFTPPassword
|
||
|
||
Novell BorderManager 3.8 Proxy and Firewall Overview and Planning Guide
|
||
Copyright <20> 1997-1998, 2001, 2002-2003, 2004 Novell, Inc. All rights reserved.
|
||
===
|
||
From a WS-FTP Pro firescript at:
|
||
|
||
http://support.ipswitch.com/kb/WS-20050315-DM01.htm
|
||
|
||
send ("USER %FwUserId$%HostUserId$%HostAddress")
|
||
|
||
//send ("PASS %FwPassword$%HostPassword")
|
||
|
||
}
|
||
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;
|
||
// TODO: set the FListParserClass as well..
|
||
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 <sp> <client-name> <sp> <client-version> [<sp> <optional platform info>] (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 <20>(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 <sp> pathname [<sp> startposition <sp> 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 <sp> pathname [<sp> startposition <sp> 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.
|
||
|
||
|