📄 ftpcli.pas
字号:
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).
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
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, Graphics, Controls,
Forms, Dialogs, StdCtrls, WSocket;
const
FtpCliVersion = 266;
CopyRight : String = ' TFtpCli (c) 1996-2000 F. Piette V2.66 ';
const
BLOCK_SIZE = 1514;
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,
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);
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;
FUserName : String;
FPassWord : String;
FLocalFileName : String;
FHostFileName : String;
FHostDirName : String;
FDnsResult : String;
FType : Char;
FShareMode : Word;
FDisplayFileMode : TFtpDisplayFileMode;
FConnectionType : TFTPConnectionType;
FProxyServer : 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);
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); virtual;
procedure HandleBackGroundException(E: Exception); virtual;
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);
public
constructor Create(AOwner: TComponent); 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 RestAsync; virtual;
procedure RestGetAsync; virtual;
procedure RestartGetAsync; virtual;
procedure RestPutAsync; virtual;
procedure RestartPutAsync; virtual;
property Handle : HWND read FWindowHandle;
property LastResponse : String read FLastResponse;
property ErrorMessage : String read FErrorMessage;
property DnsResult : String read FDnsResult;
property SizeResult : LongInt read FSizeResult;
property DirResult : String read FDirResult;
property ControlSocket : TWSocket read FControlSocket;
property DataSocket : TWSocket read FDataSocket;
property Connected : Boolean read GetConnected;
property StatusCode : LongInt read FStatusCode;
property ByteCount : LongInt read FByteCount;
property State : TFtpState read FState;
property RequestType : TFtpRequest read FRequestType;
property Options : TFtpOptions read FOptions
write FOptions;
property LocalStream : TStream read FLocalStream
write SetLocalStream;
property ResumeAt : LongInt read FResumeAt
write FResumeAt;
property HostName : String read FHostName
write FHostName;
property Port : String read FPort
write FPort;
property UserName : String read FUserName
write FUserName;
property PassWord : String read FPassWord
write FPassWord;
property HostDirName : String read FHostDirName
write FHostDirName;
property HostFileName : String read FHostFileName
write FHostFileName;
property LocalFileName : String read FLocalFileName
write SetLocalFileName;
property DisplayFileFlag : Boolean read FDisplayFileFlag
write FDisplayFileFlag;
property Binary : Boolean read GetBinary
write SetBinary;
property Passive : Boolean read FPassive
write SetPassive;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -