📄 idftpserver.pas
字号:
{ $HDR$}
{**********************************************************************}
{ Unit archived using Team Coherence }
{ Team Coherence is Copyright 2002 by Quality Software Components }
{ }
{ For further information / comments, visit our WEB site at }
{ http://www.TeamCoherence.com }
{**********************************************************************}
{}
{ $Log: 10167: IdFTPServer.pas
{
Rev 1.3 1/23/2003 9:09:18 PM BGooijen
Changed ABOR to fix the command while uploading
}
{
{ Rev 1.2 1-9-2003 11:44:42 BGooijen
{ Added ABOR command with telnet escape characters
{ Fixed hanging of ABOR command
{ STOR and STOU now use REST-position
}
{
{ Rev 1.1 12/10/2002 07:43:04 AM JPMugaas
{ Merged fix for a problem were resume cause the entire file to be sent instead
{ of the part requrested.
}
{
{ Rev 1.0 2002.11.12 10:39:06 PM czhower
}
unit IdFTPServer;
{
Original Author: Sergio Perry
Date: 04/21/2001
Fixes and modifications: Doychin Bondzhev
Date: 08/10/2001
Further Extensive changes by Chad Z. Hower (Kudzu)
TODO:
- Change events to use DoXXXX
}
interface
uses
Classes,
SysUtils, IdAssignedNumbers,
IdException, IdFTPList, IdTCPServer, IdTCPConnection, IdUserAccounts,
IdFTPCommon, IdThread, IdRFCReply;
type
TIdFTPUserType = (utNone, utAnonymousUser, utNormalUser);
TIdFTPSystems = (ftpsOther, ftpsDOS, ftpsUNIX, ftpsVAX);
TIdFTPOperation = (ftpRetr, ftpStor);
const
Id_DEF_AllowAnon = False;
Id_DEF_PassStrictCheck = True;
Id_DEF_SystemType = ftpsDOS;
type
TIdFTPServerThread = class;
TOnUserLoginEvent = procedure(ASender: TIdFTPServerThread; const AUsername, APassword: string;
var AAuthenticated: Boolean) of object;
TOnAfterUserLoginEvent = procedure(ASender: TIdFTPServerThread) of object;
TOnDirectoryEvent = procedure(ASender: TIdFTPServerThread; var VDirectory: string) of object;
TOnGetFileSizeEvent = procedure(ASender: TIdFTPServerThread; const AFilename: string;
var VFileSize: Int64) of object;
TOnListDirectoryEvent = procedure(ASender: TIdFTPServerThread; const APath: string;
ADirectoryListing: TIdFTPListItems) of object;
TOnFileEvent = procedure(ASender: TIdFTPServerThread; const APathName: string) of object;
TOnRenameFileEvent = procedure(ASender: TIdFTPServerThread; const ARenameFromFile,ARenameToFile: string) of object;
TOnRetrieveFileEvent = procedure(ASender: TIdFTPServerThread; const AFileName: string;
var VStream: TStream) of object;
TOnStoreFileEvent = procedure(ASender: TIdFTPServerThread; const AFileName: string;
AAppend: Boolean; var VStream: TStream) of object;
EIdFTPServerException = class(EIdException);
EIdFTPServerNoOnListDirectory = class(EIdFTPServerException);
TIdDataChannelThread = class(TIdThread)
protected
FControlChannel: TIdTCPServerConnection;
FDataChannel: TIdTCPConnection;
FErrorReply: TIdRFCReply;
FFtpOperation: TIdFTPOperation;
FOKReply: TIdRFCReply;
//
procedure Run; override;
procedure SetErrorReply(const AValue: TIdRFCReply);
procedure SetOKReply(const AValue: TIdRFCReply);
public
constructor Create(APASV: Boolean; AControlConnection: TIdTCPServerConnection; const ADefaultDataPort : Integer = IdPORT_FTP_DATA); reintroduce;
destructor Destroy; override;
procedure StartThread(AOperation: TIdFTPOperation);
procedure SetupDataChannel(const AIP: string; APort: Integer);
//
property OKReply: TIdRFCReply read FOKReply write SetOKReply;
property ErrorReply: TIdRFCReply read FErrorReply write SetErrorReply;
end;
TIdFTPServerThread = class(TIdPeerThread)
protected
FUserType: TIdFTPUserType;
FAuthenticated: Boolean;
FALLOSize: Integer;
FCurrentDir: string;
FDataType: TIdFTPTransferType;
FDataMode: TIdFTPTransferMode;
FDefaultDataPort : Integer;
FDataPort: Integer;
FDataStruct: TIdFTPDataStructure;
FDataChannelThread: TIdDataChannelThread;
FHomeDir: string;
FUsername: string;
FPassword: string;
FPASV: Boolean;
FRESTPos: Integer;
FRNFR: string;
//
procedure CreateDataChannel(APASV: Boolean = False);
function IsAuthenticated(ASender: TIdCommand): Boolean;
procedure KillDataChannel;
procedure TerminateAndFreeDataChannel;
procedure ReInitialize;
public
constructor Create(ACreateSuspended: Boolean = True; const ADefaultDataPort : Integer = IdPORT_FTP_DATA); reintroduce;
destructor Destroy; override;
//
property Authenticated: Boolean read FAuthenticated write FAuthenticated;
property ALLOSize: Integer read FALLOSize write FALLOSize;
property CurrentDir: string read FCurrentDir write FCurrentDir;
property DataChannelThread: TIdDataChannelThread read FDataChannelThread
write FDataChannelThread;
property DataType: TIdFTPTransferType read FDataType write FDataType;
property DataMode: TIdFTPTransferMode read FDataMode write FDataMode;
property DataPort: Integer read FDataPort write FDataPort;
property DataStruct: TIdFTPDataStructure read FDataStruct write FDataStruct;
property HomeDir: string read FHomeDir write FHomeDir;
property Password: string read FPassword write FPassword;
property PASV: Boolean read FPASV write FPASV;
property RESTPos: Integer read FRESTPos write FRESTPos;
property Username: string read FUsername write FUsername;
property UserType: TIdFTPUserType read FUserType write FUserType;
end;
TIdFTPServer = class;
TIdOnGetCustomListFormat = procedure(ASender: TIdFTPServer; AItem: TIdFTPListItem;
var VText: string) of object;
{ FTP Server }
TIdFTPServer = class(TIdTCPServer)
protected
FAnonymousAccounts: TstringList;
FAllowAnonymousLogin: Boolean;
FAnonymousPassStrictCheck: Boolean;
FCmdHandlerList: TIdCommandHandler;
FCmdHandlerNlst: TIdCommandHandler;
FEmulateSystem: TIdFTPSystems;
FHelpReply: Tstrings;
FSystemType: string;
FDefaultDataPort : Integer;
FUserAccounts: TIdUserManager;
FOnAfterUserLogin: TOnAfterUserLoginEvent;
FOnGetCustomListFormat: TIdOnGetCustomListFormat;
FOnUserLogin: TOnUserLoginEvent;
FOnChangeDirectory: TOnDirectoryEvent;
FOnGetFileSize: TOnGetFileSizeEvent;
FOnListDirectory: TOnListDirectoryEvent;
FOnRenameFile: TOnRenameFileEvent;
FOnDeleteFile: TOnFileEvent;
FOnRetrieveFile: TOnRetrieveFileEvent;
FOnStoreFile: TOnStoreFileEvent;
FOnMakeDirectory: TOnDirectoryEvent;
FOnRemoveDirectory: TOnDirectoryEvent;
//Command replies
procedure CommandUSER(ASender: TIdCommand);
procedure CommandPASS(ASender: TIdCommand);
procedure CommandCWD(ASender: TIdCommand);
procedure CommandCDUP(ASender: TIdCommand);
procedure CommandREIN(ASender: TIdCommand);
procedure CommandPORT(ASender: TIdCommand);
procedure CommandPASV(ASender: TIdCommand);
procedure CommandTYPE(ASender: TIdCommand);
procedure CommandSTRU(ASender: TIdCommand);
procedure CommandMODE(ASender: TIdCommand);
procedure CommandRETR(ASender: TIdCommand);
procedure CommandSSAP(ASender: TIdCommand);
procedure CommandALLO(ASender: TIdCommand);
procedure CommandREST(ASender: TIdCommand);
procedure CommandRNFR(ASender: TIdCommand);
procedure CommandRNTO(ASender: TIdCommand);
procedure CommandABOR(ASender: TIdCommand);
procedure CommandDELE(ASender: TIdCommand);
procedure CommandRMD(ASender: TIdCommand);
procedure CommandMKD(ASender: TIdCommand);
procedure CommandPWD(ASender: TIdCommand);
procedure CommandLIST(ASender: TIdCommand);
procedure CommandSITE(ASender: TIdCommand);
procedure CommandSYST(ASender: TIdCommand);
procedure CommandSTAT(ASender: TIdCommand);
procedure CommandSIZE(ASender: TIdCommand);
procedure CommandFEAT(ASender: TIdCommand);
procedure CommandOPTS(ASender: TIdCommand);
//
procedure DoChangeDirectory(AThread: TIdFTPServerThread; var VDirectory: string);
procedure DoMakeDirectory(AThread: TIdFTPServerThread; var VDirectory: string);
procedure DoRemoveDirectory(AThread: TIdFTPServerThread; var VDirectory: string);
procedure DoGetCustomListFormat(AItem: TIdFTPListItem; var VText: string);
procedure InitializeCommandHandlers; override;
procedure ListDirectory(ASender: TIdFTPServerThread; ADirectory: string;
var ADirContents: TstringList; ADetails: Boolean);
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure SetAnonymousAccounts(const AValue: TstringList);
procedure SetHelpReply(const AValue: Tstrings);
procedure SetUserAccounts(const AValue: TIdUserManager);
procedure SetEmulateSystem(const AValue: TIdFTPSystems);
procedure ThreadException(AThread: TIdThread; AException: Exception);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property AllowAnonymousLogin: Boolean read FAllowAnonymousLogin write FAllowAnonymousLogin default Id_DEF_AllowAnon;
property AnonymousAccounts: TStringList read FAnonymousAccounts write SetAnonymousAccounts;
property AnonymousPassStrictCheck: Boolean read FAnonymousPassStrictCheck
write FAnonymousPassStrictCheck default Id_DEF_PassStrictCheck;
property DefaultDataPort : Integer read FDefaultDataPort write FDefaultDataPort default IdPORT_FTP_DATA;
property EmulateSystem: TIdFTPSystems read FEmulateSystem write SetEmulateSystem default Id_DEF_SystemType;
property HelpReply: Tstrings read FHelpReply write SetHelpReply;
property UserAccounts: TIdUserManager read FUserAccounts write SetUserAccounts;
property SystemType: string read FSystemType write FSystemType;
property OnAfterUserLogin: TOnAfterUserLoginEvent read FOnAfterUserLogin
write FOnAfterUserLogin;
property OnChangeDirectory: TOnDirectoryEvent read FOnChangeDirectory write FOnChangeDirectory;
property OnGetCustomListFormat: TIdOnGetCustomListFormat read FOnGetCustomListFormat
write FOnGetCustomListFormat;
property OnGetFileSize: TOnGetFileSizeEvent read FOnGetFileSize write FOnGetFileSize;
property OnUserLogin: TOnUserLoginEvent read FOnUserLogin write FOnUserLogin;
property OnListDirectory: TOnListDirectoryEvent read FOnListDirectory write FOnListDirectory;
property OnRenameFile: TOnRenameFileEvent read FOnRenameFile write FOnRenameFile;
property OnDeleteFile: TOnFileEvent read FOnDeleteFile write FOnDeleteFile;
property OnRetrieveFile: TOnRetrieveFileEvent read FOnRetrieveFile write FOnRetrieveFile;
property OnStoreFile: TOnStoreFileEvent read FOnStoreFile write FOnStoreFile;
property OnMakeDirectory: TOnDirectoryEvent read FOnMakeDirectory write FOnMakeDirectory;
property OnRemoveDirectory: TOnDirectoryEvent read FOnRemoveDirectory write FOnRemoveDirectory;
end;
implementation
uses
IdGlobal,
IdIOHandlerSocket,
IdResourcestrings,
IdSimpleServer,
IdSocketHandle,
Idstrings,
IdTCPClient,
IdEMailAddress;
{ TIdDataChannelThread }
constructor TIdDataChannelThread.Create(APASV: Boolean; AControlConnection: TIdTCPServerConnection; const ADefaultDataPort : Integer = IdPORT_FTP_DATA);
begin
inherited Create;
StopMode := smSuspend;
FOKReply := TIdRFCReply.Create(nil);
FErrorReply := TIdRFCReply.Create(nil);
FControlChannel := AControlConnection;
if APASV then begin
FDataChannel := TIdSimpleServer.Create(nil);
TIdSimpleServer(FDataChannel).BoundIP := TIdIOHandlerSocket(FControlChannel.IOHandler).Binding.IP;
end else begin
FDataChannel := TIdTCPClient.Create(nil);
TIdTCPClient(FDataChannel).BoundPort := ADefaultDataPort; //Default dataport
end;
end;
destructor TIdDataChannelThread.Destroy;
begin
FreeAndNil(FOKReply);
FreeAndNil(FErrorReply);
FreeAndNil(FDataChannel);
inherited Destroy;
end;
procedure TIdDataChannelThread.StartThread(AOperation: TIdFTPOperation);
begin
FFtpOperation := AOperation; try
if FDataChannel is TIdSimpleServer then begin
TIdSimpleServer(FDataChannel).Listen;
end else if FDataChannel is TIdTCPClient then begin
TIdTCPClient(FDataChannel).Connect;
end;
except
FControlChannel.WriteRFCReply(FErrorReply); //426
raise;
end;
inherited Start;
end;
procedure TIdDataChannelThread.Run;
var
LStrStream: TMemoryStream; //is faster than StringStream
begin
try
try
try
try
if Data is TStream then begin
case FFtpOperation of
ftpRetr: FDataChannel.WriteStream(TStream(Data),False);
ftpStor: FDataChannel.ReadStream(TStream(Data), -1, True);
end;
end else begin
case FFtpOperation of
ftpRetr: FDataChannel.Writestrings(Data as Tstrings);
ftpStor:
begin
LStrStream := TMemoryStream.Create;
try
FDataChannel.ReadStream(LStrStream, -1, True);
SplitLines(LStrStream.Memory, LStrStream.Size,TStrings(Data));
finally
FreeAndNil(LStrStream);
end;
end;//ftpStor
end;//case
end;
finally
FreeAndNIL(FData);
end;
finally
FDataChannel.Disconnect;
end;
FControlChannel.WriteRFCReply(FOKReply); //226
except
FControlChannel.WriteRFCReply(FErrorReply); //426
end;
finally Stop; end;
end;
procedure TIdDataChannelThread.SetupDataChannel(const AIP: string; APort: Integer);
begin
if FDataChannel is TIdSimpleServer then begin
with TIdSimpleServer(FDataChannel) do begin
BoundIP := AIP;
BoundPort := APort;
end;
end else begin
with TIdTCPClient(FDataChannel) do begin
Host := AIP;
Port := APort;
end;
end;
end;
procedure TIdDataChannelThread.SetErrorReply(const AValue: TIdRFCReply);
begin
FErrorReply.Assign(AValue);
end;
procedure TIdDataChannelThread.SetOKReply(const AValue: TIdRFCReply);
begin
FOKReply.Assign(AValue);
end;
{ TIdFTPClient }
constructor TIdFTPServerThread.Create(ACreateSuspended: Boolean = True; const ADefaultDataPort : Integer = IdPORT_FTP_DATA);
begin
inherited Create(ACreateSuspended);
FDefaultDataPort := ADefaultDataPort;
ReInitialize;
end;
procedure TIdFTPServerThread.TerminateAndFreeDataChannel;
Begin
if Assigned(FDataChannelThread) then begin
FDataChannelThread.Terminate; //set Terminated flag
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -