📄 ftpsrv.pas
字号:
var Answer : TFtpString); virtual;
procedure CommandLIST(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandNLST(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandDELE(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandSIZE(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandREST(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandRNFR(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandRNTO(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandPORT(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandSTOR(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandRETR(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandTYPE(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandCWD (Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandChangeDir(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandMKD (Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandRMD (Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandCDUP(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandXPWD(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandPWD (Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandSYST(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandABOR(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandPASV(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandAPPE(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandSTRU(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Start;
procedure Stop;
procedure DisconnectAll;
procedure WndProc(var MsgRec: TMessage);
property ServSocket : TWSocket read FServSocket;
property Handle : HWND read FWindowHandle;
property ClientCount : Integer read GetClientCount;
property Active : Boolean read GetActive
write SetActive;
property ClientClass : TFtpCtrlSocketClass
read FClientClass
write FClientClass;
published
property Addr : String read FAddr
write FAddr;
property Port : String read FPort
write FPort;
property Banner : String read FBanner
write FBanner;
property UserData : LongInt read FUserData
write FUserData;
property MaxClients : LongInt read FMaxClients
write FMaxClients;
property OnStart : TNotifyEvent
read FOnStart
write FOnStart;
property OnStop : TNotifyEvent
read FOnStop
write FOnStop;
property OnAuthenticate : TFtpSrvAuthenticateEvent
read FOnAuthenticate
write FOnAuthenticate;
property OnClientDisconnect : TFtpSrvClientConnectEvent
read FOnClientDisconnect
write FOnClientDisconnect;
property OnClientConnect : TFtpSrvClientConnectEvent
read FOnClientConnect
write FOnClientConnect;
property OnClientCommand : TFtpSrvClientCommandEvent
read FOnClientCommand
write FOnClientCommand;
property OnAnswerToClient : TFtpSrvAnswerToClientEvent
read FOnAnswerToClient
write FOnAnswerToClient;
property OnChangeDirectory : TFtpSrvChangeDirectoryEvent
read FOnChangeDirectory
write FOnChangeDirectory;
property OnMakeDirectory : TFtpSrvChangeDirectoryEvent
read FOnMakeDirectory
write FOnMakeDirectory;
property OnBuildDirectory : TFtpSrvBuildDirectoryEvent
read FOnBuildDirectory
write FOnBuildDirectory;
property OnAlterDirectory : TFtpSrvBuildDirectoryEvent
read FOnAlterDirectory
write FOnAlterDirectory;
property OnStorSessionConnected : TFtpSrvDataSessionConnectedEvent
read FOnStorSessionConnected
write FOnStorSessionConnected;
property OnRetrSessionConnected : TFtpSrvDataSessionConnectedEvent
read FOnRetrSessionConnected
write FOnRetrSessionConnected;
property OnStorSessionClosed : TFtpSrvDataSessionConnectedEvent
read FOnStorSessionClosed
write FOnStorSessionClosed;
property OnRetrSessionClosed : TFtpSrvDataSessionConnectedEvent
read FOnRetrSessionClosed
write FOnRetrSessionClosed;
property OnRetrDataSent : TFtpSrvRetrDataSentEvent
read FOnRetrDataSent
write FOnRetrDataSent;
property OnValidatePut : TFtpSrvValidateXferEvent
read FOnValidatePut
write FOnValidatePut;
property OnValidateDele : TFtpSrvValidateXferEvent
read FOnValidateDele
write FOnValidateDele;
property OnValidateRnFr : TFtpSrvValidateXferEvent
read FOnValidateRnFr
write FOnValidateRnFr;
property OnValidateRnTo : TFtpSrvValidateXferEvent
read FOnValidateRnTo
write FOnValidateRnTo;
property OnValidateGet : TFtpSrvValidateXferEvent
read FOnValidateGet
write FOnValidateGet;
property OnStorDataAvailable : TFtpSrvDataAvailableEvent
read FOnStorDataAvailable
write FOnStorDataAvailable;
end;
procedure Register;
implementation
const
msgDftBanner = '220 ICS FTP Server ready.';
msgTooMuchClients = '421 Too many users connected.';
msgCmdUnknown = '500 ''%s'': command not understood.';
msgLoginFailed = '530 Login incorrect.';
msgNotLogged = '530 Please login with USER and PASS.';
msgNoUser = '503 Login with USER first.';
msgLogged = '230 User %s logged in.';
msgPassRequired = '331 Password required for %s.';
msgCWDSuccess = '250 CWD command successful. "%s" is current directory.';
msgCWDFailed = '501 CWD failed. %s';
msgPWDSuccess = '257 "%s" is current directory.';
msgQuit = '221 Goodbye.';
msgPortSuccess = '200 Port command successful.';
msgPortFailed = '501 Invalid PORT command.';
msgStorDisabled = '501 Permission Denied'; {'500 Cannot STOR.';}
msgStorSuccess = '150 Opening data connection for %s.';
msgStorFailed = '501 Cannot STOR. %s';
msgStorAborted = '426 Connection closed; %s.';
msgStorOk = '226 File received ok';
msgStorError = '426 Connection closed; transfer aborted. Error #%d';
msgRetrDisabled = '500 Cannot RETR.';
msgRetrSuccess = '150 Opening data connection for %s.';
msgRetrFailed = '501 Cannot RETR. %s';
msgRetrAborted = '426 Connection closed; %s.';
msgRetrOk = '226 File sent ok';
msgRetrError = '426 Connection closed; transfer aborted. Error #%d';
msgSystem = '215 UNIX Type: L8 Internet Component Suite';
msgDirOpen = '150 Opening data connection for directory list.';
msgDirFailed = '451 Failed: %s.';
msgTypeOk = '200 Type set to %s.';
msgTypeFailed = '500 ''TYPE %s'': command not understood.';
msgDeleNotExists = '550 ''%s'': no such file or directory.';
msgDeleOk = '250 File ''%s'' deleted.';
msgDeleFailed = '450 File ''%s'' can''t be deleted.';
msgDeleSyntax = '501 Syntax error in parameter.';
msgDeleDisabled = '500 Cannot DELE.';
msgRnfrNotExists = '550 ''%s'': no such file or directory.';
msgRnfrSyntax = '501 Syntax error is parameter.';
msgRnfrOk = '350 File exists, ready for destination name.';
msgRnFrDisabled = '500 Cannot RNFR.';
msgRntoNotExists = '550 ''%s'': no such file or directory.';
msgRntoAlready = '553 ''%s'': file already exists.';
msgRntoOk = '250 File ''%s'' renamed to ''%s''.';
msgRntoFailed = '450 File ''%s'' can''t be renamed.';
msgRntoSyntax = '501 Syntax error in parameter.';
msgRnToDisabled = '500 Cannot RNTO.';
msgMkdOk = '257 ''%s'': directory created.';
msgMkdAlready = '550 ''%s'': file or directory already exists.';
msgMkdFailed = '550 ''%s'': can''t create directory.';
msgMkdSyntax = '501 Syntax error in parameter.';
msgRmdOk = '250 ''%s'': directory removed.';
msgRmdNotExists = '550 ''%s'': no such directory.';
msgRmdFailed = '550 ''%s'': can''t remove directory.';
msgRmdSyntax = '501 Syntax error in parameter.';
msgNoopOk = '200 Ok. Parameter was ''%s''.';
msgAborOk = '225 ABOR command successful.';
msgPasvLocal = '227 Entering Passive Mode (127,0,0,1,%d,%d).';
msgPasvRemote = '227 Entering Passive Mode (%d,%d,%d,%d,%d,%d).';
msgPasvExcept = '500 PASV exception: ''%s''.';
msgSizeOk = '213 %d';
msgSizeFailed = '550 Command failed: %s.';
msgSizeSyntax = '501 Syntax error in parameter.';
msgRestOk = '350 REST supported. Ready to resume at byte offset %d.';
msgRestZero = '501 Required byte offset parameter bad or missing.';
msgRestFailed = '501 Syntax error in parameter: %s.';
msgAppeFailed = '550 APPE failed.';
msgAppeSuccess = '150 Opening data connection for %s (append).';
msgAppeDisabled = '500 Cannot APPE.';
msgAppeAborted = '426 Connection closed; %s.';
msgAppeOk = '226 File received ok';
msgAppeError = '426 Connection closed; transfer aborted. Error #%d';
msgAppeReady = '150 APPE supported. Ready to append file "%s" at offset %d.';
msgStruOk = '200 Ok. STRU parameter ''%s'' ignored.';
function SlashesToBackSlashes(const S : String) : String; forward;
function BackSlashesToSlashes(const S : String) : String; forward;
function BuildFilePath(const Directory : String;
FileName : String) : String; forward;
var
ThisYear, ThisMonth, ThisDay : Word;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure Register;
begin
RegisterComponents('FPiette', [TFtpServer]);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
{$IFDEF VER80}
procedure SetLength(var S: string; NewLength: Integer);
begin
S[0] := chr(NewLength);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TrimRight(Str : String) : String;
var
i : Integer;
begin
i := Length(Str);
while (i > 0) and (Str[i] = ' ') do
i := i - 1;
Result := Copy(Str, 1, i);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TrimLeft(Str : String) : String;
var
i : Integer;
begin
if Str[1] <> ' ' then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -