📄 ftpsrv.pas
字号:
unit FtpSrv;
{$B-} { Enable partial boolean evaluation }
{$T-} { Untyped pointers }
{$IFNDEF VER80}
{$J+} { Allow typed constant to be modified }
{$ENDIF}
{$IFDEF VER110} { C++ Builder V3.0 }
{$ObjExportAll On}
{$ENDIF}
interface
uses
WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Winsock, WSocket, FtpSrvC;
const
FtpServerVersion = 104;
CopyRight : String = ' TFtpServer (c) 1998 F. Piette V1.04 ';
WM_FTPSRV_CLOSE_REQUEST = WM_USER + 1;
WM_FTPSRV_CLIENT_CLOSED = WM_USER + 2;
WM_FTPSRV_ABORT_TRANSFER = WM_USER + 3;
WM_FTPSRV_CLOSE_DATA = WM_USER + 4;
type
FtpServerException = class(Exception);
{ Various Delphi and C++Builder version handle string parameter passed as var }
{ differently. To get application code compatible across all versions, we }
{ need to define our own string type. We use the larger we can with the given }
{ compiler version. btw: the 255 limit is not a problem because it applies to }
{ the command laines sent to the server and 255 should be enough except if }
{ you use incredibly long file names. }
{$IFDEF VER100} { Delphi 3 }
TFtpString = String;
{$ELSE} { All others }
TFtpString = String[255];
{$ENDIF}
TFtpCtrlSocketClass = class of TFtpCtrlSocket;
TFtpSrvAuthenticateEvent = procedure (Sender : TObject;
Client : TFtpCtrlSocket;
UserName : TFtpString;
Password : TFtpString;
var Authenticated : Boolean) of object;
TFtpSrvChangeDirectoryEvent = procedure (Sender : TObject;
Client : TFtpCtrlSocket;
Directory : TFtpString;
var Allowed : Boolean) of object;
TFtpSrvBuildDirectoryEvent = procedure (Sender : TObject;
Client : TFtpCtrlSocket;
var Directory : TFtpString;
Detailed : Boolean) of object;
TFtpSrvClientConnectEvent = procedure (Sender : TObject;
Client : TFtpCtrlSocket;
Error : Word) of object;
TFtpSrvDataSessionConnectedEvent = procedure (Sender : TObject;
Client : TFtpCtrlSocket;
Data : TWSocket;
Error : Word) of object;
TFtpSrvClientCommandEvent = procedure (Sender : TObject;
Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString) of object;
TFtpSrvAnswerToClientEvent = procedure (Sender : TObject;
Client : TFtpCtrlSocket;
var Answer : TFtpString) of object;
TFtpSrvValidateXferEvent = procedure (Sender : TObject;
Client : TFtpCtrlSocket;
var FilePath : TFtpString;
var Allowed : Boolean) of object;
TFtpSrvDataAvailableEvent = procedure (Sender : TObject;
Client : TFtpCtrlSocket;
Data : TWSocket;
Buf : PChar;
Len : LongInt;
Error : Word) of object;
TFtpSrvRetrDataSentEvent = procedure (Sender : TObject;
Client : TFtpCtrlSocket;
Data : TWSocket;
Error : Word) of object;
TFtpSrvCommandProc = procedure (Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString) of object;
TFtpSrvCommandTableItem = record
KeyWord : String;
Proc : TFtpSrvCommandProc;
end;
TFtpServer = class(TComponent)
protected
FPort : String;
FBanner : String;
FServSocket : TWSocket;
FWindowHandle : HWND;
FClientClass : TFtpCtrlSocketClass;
FClientList : TList;
FClientNum : LongInt;
FMaxClients : LongInt;
FCmdTable : array [0..31] of TFtpSrvCommandTableItem;
FLastCmd : Integer;
FUserData : LongInt; { Reserved for component user }
FOnStart : TNotifyEvent;
FOnStop : TNotifyEvent;
FOnAuthenticate : TFtpSrvAuthenticateEvent;
FOnClientConnect : TFtpSrvClientConnectEvent;
FOnClientDisconnect : TFtpSrvClientConnectEvent;
FOnClientCommand : TFtpSrvClientCommandEvent;
FOnAnswerToClient : TFtpSrvAnswerToClientEvent;
FOnChangeDirectory : TFtpSrvChangeDirectoryEvent;
FOnMakeDirectory : TFtpSrvChangeDirectoryEvent;
FOnBuildDirectory : TFtpSrvBuildDirectoryEvent;
FOnAlterDirectory : TFtpSrvBuildDirectoryEvent;
FOnValidatePut : TFtpSrvValidateXferEvent;
FOnValidateDele : TFtpSrvValidateXferEvent;
FOnStorSessionConnected : TFtpSrvDataSessionConnectedEvent;
FOnStorSessionClosed : TFtpSrvDataSessionConnectedEvent;
FOnStorDataAvailable : TFtpSrvDataAvailableEvent;
FOnValidateGet : TFtpSrvValidateXferEvent;
FOnRetrSessionConnected : TFtpSrvDataSessionConnectedEvent;
FOnRetrSessionClosed : TFtpSrvDataSessionConnectedEvent;
FOnRetrDataSent : TFtpSrvRetrDataSentEvent;
procedure Notification(AComponent: TComponent; operation: TOperation); override;
procedure ServSocketSessionAvailable(Sender : TObject; Error : Word);
procedure ServSocketStateChange(Sender : TObject; OldState, NewState : TSocketState);
procedure ClientSessionClosed(Sender : TObject; Error : Word);
procedure ClientDataSent(Sender : TObject; Error : Word);
procedure ClientCommand(Sender : TObject; CmdBuf : PChar; CmdLen : Integer);
procedure ClientPassiveSessionAvailable(Sender : TObject; Error : Word);
procedure ClientStorSessionConnected(Sender : TObject; Error : Word);
procedure ClientStorSessionClosed(Sender : TObject; Error : Word);
procedure ClientStorDataAvailable(Sender: TObject; Error : word);
procedure ClientRetrSessionConnected(Sender : TObject; Error : Word);
procedure ClientRetrSessionClosed(Sender : TObject; Error : Word);
procedure ClientRetrDataSent(Sender : TObject; Error : Word);
procedure SendAnswer(Client : TFtpCtrlSocket; Answer : TFtpString);
procedure SendNextDataChunk(Client : TFtpCtrlSocket; Data : TWSocket);
procedure StartSendData(Client : TFtpCtrlSocket);
procedure BuildDirectory(Client : TFtpCtrlSocket; var Params : TFtpString; Stream : TStream; Detailed : Boolean);
procedure TriggerServerStart; virtual;
procedure TriggerServerStop; virtual;
procedure TriggerAuthenticate(Client : TFtpCtrlSocket;
UserName : String;
PassWord : String;
var Authenticated : Boolean); virtual;
procedure TriggerChangeDirectory(Client : TFtpCtrlSocket;
Directory : String;
var Allowed : Boolean); virtual;
procedure TriggerMakeDirectory(Client : TFtpCtrlSocket;
Directory : String;
var Allowed : Boolean); virtual;
procedure TriggerBuildDirectory(Client : TFtpCtrlSocket;
var Params : TFtpString;
Detailed : Boolean);
procedure TriggerAlterDirectory(Client : TFtpCtrlSocket;
var Params : TFtpString;
Detailed : Boolean);
procedure TriggerSendAnswer(Client : TFtpCtrlSocket;
var Answer : TFtpString); virtual;
procedure TriggerClientConnect(Client : TFtpCtrlSocket; Error : Word); virtual;
procedure TriggerClientDisconnect(Client : TFtpCtrlSocket; Error : Word); virtual;
procedure TriggerClientCommand(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure TriggerStorSessionConnected(Client : TFtpCtrlSocket;
Data : TWSocket;
Error : Word); virtual;
procedure TriggerStorSessionClosed(Client : TFtpCtrlSocket;
Data : TWSocket;
Error : Word); virtual;
procedure TriggerValidatePut(Client : TFtpCtrlSocket;
var FilePath : TFtpString;
var Allowed : Boolean); virtual;
procedure TriggerValidateDele(Client : TFtpCtrlSocket;
var FilePath : TFtpString;
var Allowed : Boolean); virtual;
procedure TriggerRetrSessionConnected(Client : TFtpCtrlSocket;
Data : TWSocket;
Error : Word); virtual;
procedure TriggerRetrSessionClosed(Client : TFtpCtrlSocket;
Data : TWSocket;
Error : Word); virtual;
procedure TriggerValidateGet(Client : TFtpCtrlSocket;
var FilePath : TFtpString;
var Allowed : Boolean); virtual;
procedure TriggerStorDataAvailable(Client : TFtpCtrlSocket;
Data : TWSocket;
Buf : PChar;
Len : LongInt;
Error : Word); virtual;
procedure TriggerRetrDataSent(Client : TFtpCtrlSocket;
Data : TWSocket;
Error : Word); virtual;
function GetClientCount : Integer; virtual;
function GetActive : Boolean;
procedure SetActive(newValue : Boolean);
procedure AddCommand(const Keyword : String;
const Proc : TFtpSrvCommandProc); virtual;
procedure WMFtpSrvCloseRequest(var msg: TMessage);
message WM_FTPSRV_CLOSE_REQUEST;
procedure WMFtpSrvClientClosed(var msg: TMessage);
message WM_FTPSRV_CLIENT_CLOSED;
procedure WMFtpSrvAbortTransfer(var msg: TMessage);
message WM_FTPSRV_ABORT_TRANSFER;
procedure WMFtpSrvCloseData(var msg: TMessage);
message WM_FTPSRV_CLOSE_DATA;
procedure CommandDirectory(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString;
Detailed : Boolean);
procedure CommandUSER(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandPASS(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandQUIT(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString); virtual;
procedure CommandNOOP(Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
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;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -