?? ftpsrv.pas
字號:
if Answer <> '' then begin
{ Event handler has processed the client command, send the answer }
SendAnswer(Client, Answer);
Exit;
end;
{ The command has not been processed, we'll process it }
if Keyword = '' then begin
{ Empty keyword (should never occurs) }
SendAnswer(Client, Format(msgCmdUnknown, [Params]));
Exit;
end;
{ We need to process the client command, search our command table }
I := 0;
while I <= High(FCmdTable) do begin
if FCmdTable[I].KeyWord = KeyWord then begin
FCmdTable[I].Proc(Client, KeyWord, Params, Answer);
SendAnswer(Client, Answer);
Exit;
end;
Inc(I);
end;
SendAnswer(Client, Format(msgCmdUnknown, [KeyWord]));
except
on E:Exception do begin
SendAnswer(Client, '501 ' + E.Message);
end;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.ClientDataSent(Sender : TObject; Error : Word);
var
Client : TFtpCtrlSocket;
begin
Client := Sender as TFtpCtrlSocket;
if Client.CloseRequest then begin
Client.CloseRequest := FALSE;
PostMessage(FWindowHandle, WM_FTPSRV_CLOSE_REQUEST, 0, LongInt(Client));
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.ClientSessionClosed(Sender : TObject; Error : Word);
begin
PostMessage(FWindowHandle, WM_FTPSRV_CLIENT_CLOSED, 0, LongInt(Sender));
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.WMFtpSrvClientClosed(var msg: TMessage);
var
Client : TFtpCtrlSocket;
begin
Client := TFtpCtrlSocket(Msg.LParam);
try
FClientList.Remove(Client);
TriggerClientDisconnect(Client, Error);
finally
Client.Destroy;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.WMFtpSrvAbortTransfer(var msg: TMessage);
var
Data : TWSocket;
begin
Data := TWSocket(Msg.LParam);
Data.ShutDown(2);
Data.Close;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.WMFtpSrvCloseData(var msg: TMessage);
var
Data : TWSocket;
begin
if msg.WParam > 0 then begin
{$IFNDEF VER80}
Sleep(0); { Release time slice }
{$ENDIF}
PostMessage(FWindowHandle, Msg.Msg, msg.WParam - 1, msg.LParam);
end
else begin
Data := TWSocket(Msg.LParam);
Data.Close;
end;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TFtpServer.GetClientCount : Integer;
begin
if Assigned(FClientList) then
Result := FClientList.Count
else
Result := 0;
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerServerStart;
begin
if Assigned(FOnStart) then
FOnStart(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerServerStop;
begin
if Assigned(FOnStop) then
FOnStop(Self);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerAuthenticate(
Client : TFtpCtrlSocket;
UserName : String;
PassWord : String;
var Authenticated : Boolean);
begin
if Assigned(FOnAuthenticate) then
FOnAuthenticate(Self, Client, UserName, Password, Authenticated);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerChangeDirectory(
Client : TFtpCtrlSocket;
Directory : String;
var Allowed : Boolean);
begin
if Assigned(FOnChangeDirectory) then
FOnChangeDirectory(Self, Client, Directory, Allowed);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerMakeDirectory(
Client : TFtpCtrlSocket;
Directory : String;
var Allowed : Boolean);
begin
if Assigned(FOnMakeDirectory) then
FOnMakeDirectory(Self, Client, Directory, Allowed);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerBuildDirectory(
Client : TFtpCtrlSocket;
var Params : TFtpString;
Detailed : Boolean);
begin
if Assigned(FOnBuildDirectory) then
FOnBuildDirectory(Self, Client, Params, Detailed);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerAlterDirectory(
Client : TFtpCtrlSocket;
var Params : TFtpString;
Detailed : Boolean);
begin
if Assigned(FOnAlterDirectory) then
FOnAlterDirectory(Self, Client, Params, Detailed);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerSendAnswer(
Client : TFtpCtrlSocket;
var Answer : TFtpString);
begin
if Assigned(FOnAnswerToClient) then
FOnAnswerToClient(Self, Client, Answer);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerClientDisconnect(Client : TFtpCtrlSocket; Error : Word);
begin
if Assigned(FOnClientDisconnect) then
FOnClientDisconnect(Self, Client, Error);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerClientConnect(Client : TFtpCtrlSocket; Error : Word);
begin
if Assigned(FOnClientConnect) then
FOnClientConnect(Self, Client, Error);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerStorSessionConnected(
Client : TFtpCtrlSocket; Data : TWSocket; Error : Word);
begin
if Assigned(FOnStorSessionConnected) then
FOnStorSessionConnected(Self, Client, Data, Error);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerRetrSessionConnected(
Client : TFtpCtrlSocket; Data : TWSocket; Error : Word);
begin
if Assigned(FOnRetrSessionConnected) then
FOnRetrSessionConnected(Self, Client, Data, Error);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerStorSessionClosed(
Client : TFtpCtrlSocket; Data : TWSocket; Error : Word);
begin
if Assigned(FOnStorSessionClosed) then
FOnStorSessionClosed(Self, Client, Data, Error);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerRetrSessionClosed(
Client : TFtpCtrlSocket; Data : TWSocket; Error : Word);
begin
if Assigned(FOnRetrSessionClosed) then
FOnRetrSessionClosed(Self, Client, Data, Error);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerClientCommand(
Client : TFtpCtrlSocket;
var Keyword : TFtpString;
var Params : TFtpString;
var Answer : TFtpString);
begin
if Assigned(FOnClientCommand) then
FOnClientCommand(Self, Client, KeyWord, Params, Answer);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerValidatePut(
Client : TFtpCtrlSocket;
var FilePath : TFtpString;
var Allowed : Boolean);
begin
if Assigned(FOnValidatePut) then
FOnValidatePut(Self, Client, FilePath, Allowed);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerValidateDele(
Client : TFtpCtrlSocket;
var FilePath : TFtpString;
var Allowed : Boolean);
begin
if Assigned(FOnValidateDele) then
FOnValidateDele(Self, Client, FilePath, Allowed);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerValidateRnFr(
Client : TFtpCtrlSocket;
var FilePath : TFtpString;
var Allowed : Boolean);
begin
if Assigned(FOnValidateRnFr) then
FOnValidateRnFr(Self, Client, FilePath, Allowed);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerValidateRnTo(
Client : TFtpCtrlSocket;
var FilePath : TFtpString;
var Allowed : Boolean);
begin
if Assigned(FOnValidateRnTo) then
FOnValidateRnTo(Self, Client, FilePath, Allowed);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TFtpServer.TriggerValidateGet(
Client : TFtpCtrlSocket;
var FilePath : TFtpString;
var Allowed : Boolean);
begin
if Assigned(FOnValidateGet) then
FOnValidateGet(Self, Client, FilePath, Allowed);
end;
{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -