📄 ftpcli.pas
字号:
Also casted FTimeOut to LongInt for computation to prevent
overflow with Delphi 1 for long timeout.
Aug 12, 1999 V2.56 HandleError was not correctly handling error message !
thank to Kim M鴏g錼d Nielsen <kmn@bcview.com>
Aug 20, 1999 V2.57 Revised conditional compilation, adapted for BCB4, set
compile options same as TWSocket.
Added DnsResult property as suggested by Heedong Lim
<hdlim@dcenlp.chungbuk.ac.kr>. This property is accessible from
OnStateChange when state is ftpWaitingBanner.
Added checks for FLocalStream being destroyed.
Sep 5, 1999 V2.58 Heedong Lim <hdlim@dcenlp.chungbuk.ac.kr> found a missing
assignation to FRequestResult in ControlSocketSessionConnected.
Sep 11, 1999 V2.59 Added OnBgException. Thanks to William Sorensen
<tzimisce@mwaccess.net> for suggesting it.
Oct 30, 1999 V2.60 Changed TargetPort and DataPort from integer to WORD so
that Delphi 1 is able to handle port greater than 32K. Bug and
and fix by Duncan Gold <Gold@esg-us.com>.
Nov 22, 1999 V2.61 Allow continuation lines in all responses.
Nov 24, 1999 V2.62 RestPut command by Alexander Burlakov <alex@helexis.com>
Added RestartPut. Added ftpNoAutoResumeAt option.
Dec 26, 1999 V2.63 Corrected a bug in DoPutAppendAsync.
Jan 24, 1999 V2.64 Added LongInt cast to all GetTickCount.
Apr 01, 2000 V2.65 Removed any set of integer.
Thanks to Grant Black <grant.black@smartmove.co.nz>,
Davie <smatters@smatters.com> and
Stephen Williams <SWilliams@fm.optus.net.au> for their work on
this subject.
Apr 09, 2000 V2.66 Proxy / Socks / Local streams support added.
Pieter Snyman <pgws@iafrica.com> added proxy and socks support.
Eric <erv@sympatico.ca> added stream support (assign LocalStream
property to switch to stream mode and LocalFileName to switch to
normal file mode).
Jun 10, 2000 V2.67 Added NOFORMS conditional compile to be able to build a
program (console mode, dll or other) without using the forms unit
(because forms unit makes programs much bigger). See NOFORMS
related comments in wsocket.pas source file for correct use.
See also OnMessagePump event and Terminated property.
Jul 15, 2000 V2.68 Added ProxyPort property. Handled non standard port when
connecting thru proxy.
Jul 21, 2000 V2.69 Implemented check for ABOR, STAT and QUIT commands so that
it doesn't check if previous command is done.
By Davie <smatters@smatters.com>.
Tomas Lannestedt <proprat@algonet.se> found a bug when using
streams. Now it correctly handled stream clearing.
Sep 17, 2000 V2.70 Eugene Mayevski <Mayevski@eldos.org> moved Controls use
out of NOFORMS way.
Nov 11, 2000 V2.71 Cleared FErrorMessage in ExecAsync. Thanks to Jake Traynham
<jake@comm-unity.net> for finding this bug.
Nov 30, 2000 V2.72 Added a Sleep in DataSocketPutDataSent, and use CloseDelayed
this will prevent some trucated file transfers.
Feb 17, 2001 V2.73 Better WaitUntilReady: check also ftpInternalReady.
By Davie <smatters@smatters.com>.
Jun 16, 2001 V2.74 Added conditional compile for Delphi 6
Jun 18, 2001 V2.75 Use AllocateHWnd and DeallocateHWnd from wsocket.
Jul 26, 2001 V2.76 Accept range 150-159 for status code after RETR command.
Peter Calum <pemca@tdk.dk> found some FTP server returning
unusual status code (and not conforming to RFC !). I don't like to
work arround other's bugs, but in this case this shouldn't hurt
anything.
Jul 28, 2001 V2.77 Cleared FNextRequest in HighLevelAsync and TriggerRequestDone
as suggested by Davie <smatters@smatters.com>.
Added AbortXfer and AbortXferAsync to abort a running transfert
without breaking connection.
Sep 09, 2001 V2.78 Beat Boegli <leeloo999@bluewin.ch> added LocalAddr property
for multihomed hosts.
Sep 13, 2001 V2.79 Bug fix by Beat Boegli <leeloo999@bluewin.ch> related to
his previous changes. Now works with passive mode put.
Nov 02, 2001 V2.80 Added DisplayLastResponse in ControlSocketDataAvailable to
give continuation lines to OnDisplay event.
Accept 250 answer as well as 257 for MKD command as suggested by
Simon Horup <cas@casdk.com>.
Feb 12, 2001 V2.82 "Soltann" <soltann@wanadoo.fr> added code to extract IP
from passive mode reply so that transfer from another server is
possible (See TargetIP in code).
Apr 06, 2002 V2.83 Added code 257 to allowed code list for CDUpAsync as
suggest by <Davie@smatters.com>.
Fixed a problem in ControlSocketSessionClosed where error code was
not checked. Bug found by <Davie@smatters.com>.
Apr 20, 2002 V2.84 Removed useless units from uses clause.
Jun 28, 2002 V2.85 Removed check for ftpFctPut and FPassive in
TriggerRequestDone which cause trouble with passive mode and sync
operation. Thanks to "Gunnar" <gulb@gmx.de>.
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
unit FtpCli;
{$B-} { Enable partial boolean evaluation }
{$T-} { Untyped pointers }
{$X+} { Enable extended syntax }
{$IFNDEF VER80} { Not for Delphi 1 }
{$H+} { Use long strings }
{$J+} { Allow typed constant to be modified }
{$ENDIF}
{$IFDEF VER110} { C++ Builder V3.0 }
{$ObjExportAll On}
{$ENDIF}
{$IFDEF VER125} { C++ Builder V4.0 }
{$ObjExportAll On}
{$ENDIF}
{_DEFINE TRACE}
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes,
{$IFNDEF NOFORMS}
Forms, Controls,
{$ENDIF}
WSocket;
const
FtpCliVersion = 284;
CopyRight : String = ' TFtpCli (c) 1996-2002 F. Piette V2.84 ';
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
TFtpOption = (ftpAcceptLF, ftpNoAutoResumeAt);
TFtpOptions = set of TFtpOption;
TFtpState = (ftpNotConnected, ftpReady, ftpInternalReady,
ftpDnsLookup, ftpConnected, ftpAbort,
ftpInternalAbort, ftpWaitingBanner, ftpWaitingResponse);
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);
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);
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;
Error : Word) of object;
TFtpReadyToTransmit = procedure(Sender : TObject;
var bCancel : Boolean) of object;
TFtpNextProc = procedure of object;
FtpException = class(Exception);
TCustomFtpCli = class(TComponent)
protected
FWindowHandle : HWND;
FHostName : String;
FPort : String;
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 : TWSocket;
FDataSocket : TWSocket;
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;
FOnBgException : TBgExceptionEvent;
FLocalStream : TStream;
FRequestType : TFtpRequest;
FRequestDoneFlag : Boolean;
FReceiveBuffer : array [0..FTP_RCV_BUF_SIZE - 1] of char;
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 : array [0..BLOCK_SIZE - 1] of char;
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;
procedure SetErrorMessage;
procedure DataSocketGetDataAvailable(Sender: TObject; Error : word);
procedure DataSocketGetSessionConnected(Sender: TObject; Error : word);
procedure DataSocketPutSessionConnected(Sender: TObject; Error : word);
procedure DataSocketGetSessionAvailable(Sender: TObject; Error : word);
procedure DataSocketGetSessionClosed(Sender: TObject; Error : word);
procedure DataSocketPutDataAvailable(Sender: TObject; Error : word);
procedure DataSocketPutDataSent(Sender: TObject; Error : word);
procedure DataSocketPutSessionAvailable(Sender: TObject; Error : word);
procedure DataSocketPutSessionClosed(Sender: TObject; Error : 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;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
function Progress : Boolean; virtual;
procedure ControlSocketDnsLookupDone(Sender: TObject; Error: Word);
procedure ControlSocketSessionConnected(Sender: TObject; Error: Word);
procedure ControlSocketDataAvailable(Sender: TObject; Error: Word);
procedure ControlSocketSessionClosed(Sender: TObject; Error: Word);
procedure TriggerRequestDone(Error: 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);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -