📄 overbyte.ics.ftpclient.pas
字号:
{*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
Author: Fran鏾is PIETTE
Creation: May 1996 (Win32 version)
Version: V2.97
Object: TFtpClient is a FTP client (RFC 959 implementation)
Support FTPS (SSL) if ICS-SSL is used (RFC 2228 implementation)
EMail: http://www.overbyte.be http://www.rtfm.be/fpiette
francois.piette@overbyte.be francois.piette@rtfm.be
francois.piette@pophost.eunet.be
Support: Use the mailing list twsocket@elists.org
Follow "support" link at http://www.overbyte.be for subscription.
Legal issues: Copyright (C) 1996-2005 by Fran鏾is PIETTE
Rue de Grady 24, 4053 Embourg, Belgium. Fax: +32-4-365.74.56
<francois.piette@overbyte.be> <francois.piette@pophost.eunet.be>
This software is provided 'as-is', without any express or
implied warranty. In no event will the author be held liable
for any damages arising from the use of this software.
Permission is granted to anyone to use this software for any
purpose, including commercial applications, and to alter it
and redistribute it freely, subject to the following
restrictions:
1. The origin of this software must not be misrepresented,
you must not claim that you wrote the original software.
If you use this software in a product, an acknowledgment
in the product documentation would be appreciated but is
not required.
2. Altered source versions must be plainly marked as such, and
must not be misrepresented as being the original software.
3. This notice may not be removed or altered from any source
distribution.
4. You must register this software by sending a picture postcard
to the author. Use a nice stamp and mention your name, street
address, EMail address and any comment you like to say.
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit Overbyte.Ics.FtpClient platform;
interface
uses
System.IO,
System.Threading,
Borland.Vcl.Windows,
Borland.Vcl.Messages,
Borland.Vcl.Classes,
Borland.Vcl.SysUtils,
Borland.Vcl.WinUtils,
{$IFNDEF NOFORMS}
Borland.Vcl.Forms,
{$ENDIF}
Overbyte.Ics.Component,
OverByte.Ics.WinSock,
OverByte.Ics.WSocket;
const
FtpCliVersion = 288;
CopyRight : String = ' TFtpCli (c) 1996-2005 F. Piette V2.88 ';
const
BLOCK_SIZE = 1460; { 1514 - TCP header size }
WM_FTP_REQUEST_DONE = WM_USER + 1;
WM_FTP_SENDDATA = WM_USER + 2;
{$IFDEF VER80}
{ Delphi 1 has a 255 characters string limitation }
FTP_RCV_BUF_SIZE = 255;
{$ELSE}
FTP_RCV_BUF_SIZE = 4096;
{$ENDIF}
type
TFtpWSocket = TWSocket;
TFtpOption = (ftpAcceptLF, ftpNoAutoResumeAt);
TFtpOptions = set of TFtpOption;
TFtpState = (ftpNotConnected, ftpReady,
ftpInternalReady, ftpDnsLookup,
ftpConnected, ftpAbort,
ftpInternalAbort, ftpWaitingBanner,
ftpWaitingResponse, ftpPasvReady);
TFtpRequest = (ftpNone, ftpOpenAsync, ftpUserAsync,
ftpPassAsync, ftpCwdAsync, ftpConnectAsync,
ftpReceiveAsync, ftpDirAsync, ftpLsAsync,
ftpPortAsync, ftpGetAsync, ftpDirectoryAsync,
ftpListAsync, ftpSystemAsync, ftpSystAsync,
ftpQuitAsync, ftpAbortXferAsync,
ftpSizeAsync, ftpPutAsync, ftpAppendAsync,
ftpFileSizeAsync, ftpRqAbort, ftpMkdAsync,
ftpRmdAsync, ftpRenameAsync, ftpDeleAsync,
ftpRenAsync, ftpRenToAsync, ftpRenFromAsync,
ftpDeleteAsync, ftpMkdirAsync, ftpRmdirAsync,
ftpPwdAsync, ftpQuoteAsync, ftpCDupAsync,
ftpDoQuoteAsync, ftpTransmitAsync, ftpTypeSetAsync,
ftpRestAsync, ftpRestGetAsync, ftpRestartGetAsync,
ftpRestPutAsync, ftpRestartPutAsync,
ftpMlsdAsync, ftpFeatAsync, ftpMlstAsync,
ftpMdtmAsync, ftpMdtmyyAsync);
TFtpFct = (ftpFctNone, ftpFctOpen, ftpFctUser,
ftpFctPass, ftpFctCwd, ftpFctSize,
ftpFctMkd, ftpFctRmd, ftpFctRenFrom,
ftpFctRenTo, ftpFctGet, ftpFctDir,
ftpFctQuit, ftpFctSyst, ftpFctDele,
ftpFctPwd, ftpFctQuote, ftpFctPut,
ftpFctTypeSet, ftpFctRest, ftpFctCDup,
ftpFctLs, ftpFctAppend, ftpFctPort,
ftpFctAbortXfer, ftpFctMlsd, ftpFctFeat,
ftpFctMlst, ftpFctMdtm, ftpFctMdtmyy);
TFtpFctSet = set of TFtpFct;
TFtpShareMode = (ftpShareCompat, ftpShareExclusive,
ftpShareDenyWrite, ftpShareDenyRead,
ftpShareDenyNone);
TFtpDisplayFileMode = (ftpLineByLine, ftpBinary);
TFtpConnectionType = (ftpDirect, ftpProxy, ftpSocks4,
ftpSocks4A, ftpSocks5);
TFtpDisplay = procedure(Sender : TObject;
var Msg : String) of object;
TFtpProgress = procedure(Sender : TObject;
Count : LongInt;
var Abort : Boolean) of object;
TFtpCommand = procedure(Sender : TObject;
var Cmd : String) of object;
TFtpRequestDone = procedure(Sender : TObject;
RqType : TFtpRequest;
ErrCode : Word) of object;
TFtpReadyToTransmit = procedure(Sender : TObject;
var bCancel : Boolean) of object;
TFtpNextProc = procedure of object;
FtpException = class(Exception);
TCustomFtpCli = class(TIcsComponent)
protected
FHostName : String;
FPort : String;
FDataPortRangeStart : DWORD; {JT}
FDataPortRangeEnd : DWORD; {JT}
FLastDataPort : DWORD; {JT}
FLocalAddr : String; {bb}
FUserName : String;
FPassWord : String;
FLocalFileName : String;
FHostFileName : String;
FHostDirName : String;
FDnsResult : String;
FType : Char;
FShareMode : Word;
FDisplayFileMode : TFtpDisplayFileMode;
FConnectionType : TFTPConnectionType;
FProxyServer : String;
FProxyPort : String;
FAppendFlag : Boolean;
FDisplayFileFlag : Boolean;
FControlSocket : TFtpWSocket;
FDataSocket : TFtpWSocket;
FStartTime : LongInt;
FStopTime : LongInt;
FState : TFtpState;
FStatusCode : LongInt;
FRequestResult : Integer;
FFctSet : TFtpFctSet;
FFctPrv : TFtpFct;
FHighLevelResult : Integer;
FHighLevelFlag : Boolean;
FRestartFlag : Boolean;
FOptions : TFtpOptions;
FOnDisplay : TFtpDisplay;
FOnDisplayFile : TFtpDisplay;
FOnError : TFtpDisplay;
FOnCommand : TFtpCommand;
FOnResponse : TNotifyEvent;
FOnSessionConnected : TSessionConnected;
FOnSessionClosed : TSessionClosed;
FOnStateChange : TNotifyEvent;
FOnRequestDone : TFtpRequestDone;
FOnProgress : TFtpProgress;
FOnReadyToTransmit : TFtpReadyToTransmit;
FLocalStream : TStream;
FRequestType : TFtpRequest;
FRequestDoneFlag : Boolean;
FReceiveBuffer : TBytes;
FReceiveLen : Integer;
FLastResponse : String;
FLastResponseSave : String; { To save FLastResponse when quitting }
FPasvResponse : String; { To fix REST + PASV transfers }
FStatusCodeSave : LongInt; { To save FStatusCode when quitting }
FErrorMessage : String;
FError : Word; { To save Error when data connection closed }
FGetCommand : String;
FConnected : Boolean;
FSendBuffer : TBytes;
FByteCount : LongInt;
FSizeResult : LongInt;
FDirResult : String;
FResumeAt : LongInt;
FNext : TFtpNextProc;
FWhenConnected : TFtpNextProc;
FDoneAsync : TFtpNextProc;
FOkResponses : array [0..15] of Integer;
FNextRequest : TFtpNextProc;
FServerSaidDone : Boolean;
FFileReceived : Boolean;
FFileSent : Boolean;
FPassive : Boolean;
FEofFlag : Boolean;
FStorAnswerRcvd : Boolean;
FPutSessionOpened : Boolean;
FStreamFlag : Boolean;
FSupportMDTMYY : Boolean; { V2.90 does server support set remote date }
FSupportMDTM : Boolean; { V2.90 does server support get remote date }
FSupportMLST : Boolean; { V2.90 does server support new list stuff }
FMLSTFacts : String; { V2.90 specific new list stuff supported }
FSupportSIZE : Boolean; { V2.90 does server support remote file size }
FRemFileDT : TDateTime; { V2.90 date/time for MdtmAsync and MdtmYYYYAsync; }
FRemFacts : String; { V2.90 response to MLST command, facts about remote file }
FLastMultiResponse : String; { V2.90 last command response, may be multiple lines, all with CRLF }
procedure SetErrorMessage;
procedure DataSocketGetDataAvailable(Sender: TObject; ErrCode : word);
procedure DataSocketGetSessionConnected(Sender: TObject; ErrCode : word);
procedure DataSocketPutSessionConnected(Sender: TObject; ErrCode : word);
procedure DataSocketGetSessionAvailable(Sender: TObject; ErrCode : word);
procedure DataSocketGetSessionClosed(Sender: TObject; ErrCode : word);
procedure DataSocketPutDataAvailable(Sender: TObject; ErrCode : word);
procedure DataSocketPutDataSent(Sender: TObject; ErrCode : word);
procedure DataSocketPutSessionAvailable(Sender: TObject; ErrCode : word);
procedure DataSocketPutSessionClosed(Sender: TObject; ErrCode : word);
procedure SendCommand(Cmd : String); virtual;
procedure TriggerDisplay(Msg : String); virtual;
procedure TriggerReadyToTransmit(var bCancel : Boolean); virtual;
procedure TriggerDisplayFile(Msg : String); virtual;
procedure TriggerError(Msg: string); virtual;
procedure DisplayLastResponse;
{$IFDEF ICS_COMPONENT}
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
{$ENDIF}
function Progress : Boolean; virtual;
procedure ControlSocketDnsLookupDone(Sender: TObject; ErrCode: Word);
procedure ControlSocketSessionConnected(Sender: TObject; ErrCode: Word);
procedure ControlSocketDataAvailable(Sender: TObject; ErrCode: Word);
procedure ControlSocketSessionClosed(Sender: TObject; ErrCode: Word);
procedure TriggerRequestDone(ErrCode: Word);
procedure TriggerStateChange;
procedure StateChange(NewState : TFtpState);
procedure PortAsync; virtual;
procedure DoneQuitAsync;
procedure ExecAsync(RqType : TFtpRequest;
Cmd : String;
OkResponses : array of Word;
DoneAsync : TFtpNextProc);
procedure NextExecAsync;
procedure DoGetAsync(RqType : TFtpRequest);
procedure Next1GetAsync;
procedure Next2GetAsync;
procedure Next3GetAsync;
procedure Next1PutAsync;
procedure Next2PutAsync;
procedure Next3PutAsync;
procedure DoHighLevelAsync;
procedure DoPutAppendAsync;
procedure HighLevelAsync(RqType : TFtpRequest; Fcts : TFtpFctSet);
procedure HandleError(const Msg : String);
function CheckReady : Boolean;
procedure TransfertStats; virtual;
procedure ExtractMoreResults;
procedure SetBinary(Value: Boolean);
function GetBinary: Boolean;
function GetConnected: Boolean;
procedure SetShareMode(newValue: TFtpShareMode);
function GetShareMode: TFtpShareMode;
procedure SetDisplayFileMode(NewValue: TFtpDisplayFileMode);
function GetDisplayFileMode: TFtpDisplayFileMode;
procedure SetConnectionType(NewValue: TFtpConnectionType);
function GetConnectionType: TFtpConnectionType;
procedure SetSocksPassword(NewValue: string);
function GetSocksPassword: string;
procedure SetSocksPort(NewValue: string);
function GetSocksPort: string;
procedure SetSocksServer(NewValue: string);
function GetSocksServer: string;
procedure SetSocksUserCode(NewValue: string);
function GetSocksUserCode: string;
procedure SetPassive(NewValue: Boolean);
procedure WndProc(var MsgRec: TMessage); override;
procedure WMFtpRequestDone(var msg: TMessage);
//message WM_FTP_REQUEST_DONE;
procedure WMFtpSendData(var msg: TMessage);
//message WM_FTP_SENDDATA;
procedure DestroyLocalStream;
procedure SetLocalStream (Stream:TStream);
procedure SetLocalFileName (FileName:String);
procedure SetDataPortRangeStart (NewValue:DWord); {JT}
procedure SetDataPortRangeEnd (NewValue:DWord); {JT}
public
constructor Create(AOwner: {$IFDEF ICS_COMPONENT}TComponent
{$ELSE}TObject{$ENDIF}); override;
destructor Destroy; override;
procedure OpenAsync; virtual;
procedure UserAsync; virtual;
procedure PassAsync; virtual;
procedure ConnectAsync; virtual;
procedure QuitAsync; virtual;
procedure AbortAsync; virtual;
procedure GetAsync; virtual;
procedure ExecGetAsync; virtual;
procedure ReceiveAsync; virtual;
procedure PutAsync; virtual;
procedure ExecPutAsync; virtual;
procedure TransmitAsync; virtual;
procedure AppendAsync; virtual;
procedure ExecAppendAsync; virtual;
procedure AppendFileAsync; virtual;
procedure ExecDirAsync; virtual;
procedure DirAsync; virtual;
procedure ExecLsAsync; virtual;
procedure LsAsync; virtual;
procedure TypeSetAsync; virtual;
procedure TypeBinaryAsync; virtual;
procedure TypeAsciiAsync; virtual;
procedure PwdAsync; virtual;
procedure CwdAsync; virtual;
procedure CDupAsync; virtual;
procedure DirectoryAsync; virtual;
procedure ListAsync; virtual;
procedure SystAsync; virtual;
procedure SystemAsync; virtual;
procedure SizeAsync; virtual;
procedure FileSizeAsync; virtual;
procedure MkdAsync; virtual;
procedure MkdirAsync; virtual;
procedure RmdAsync; virtual;
procedure RmdirAsync; virtual;
procedure DeleAsync; virtual;
procedure DeleteAsync; virtual;
procedure RenFromAsync; virtual;
procedure RenToAsync; virtual;
procedure RenAsync; virtual;
procedure RenameAsync; virtual;
procedure QuoteAsync; virtual;
procedure DoQuoteAsync; virtual;
procedure AbortXferAsync; virtual;
procedure RestAsync; virtual;
procedure RestGetAsync; virtual;
procedure RestartGetAsync; virtual;
procedure RestPutAsync; virtual;
procedure RestartPutAsync; virtual;
procedure ExecMlsdAsync; virtual;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -