?? idftpserver.pas
字號:
begin
FOKReply.Assign(AValue);
end;
{ TIdFTPClient }
constructor TIdFTPServerThread.Create(ACreateSuspended: Boolean = True);
begin
inherited Create(ACreateSuspended);
ReInitialize;
end;
procedure TIdFTPServerThread.TerminateAndFreeDataChannel;
Begin
if Assigned(FDataChannelThread) then begin
FDataChannelThread.Terminate; //set Terminated flag
FDataChannelThread.Start; //can be stopped
FreeAndNIL(FDataChannelThread);
end;
End;//
destructor TIdFTPServerThread.Destroy;
begin
TerminateAndFreeDataChannel;
inherited Destroy;
end;
procedure TIdFTPServerThread.CreateDataChannel(APASV: Boolean = False);
begin
{APR 020423. We must cache it, but in future:
if assigned(FDataChannelThread) and not APASV then begin
exit; // we already have one.
end;}
TerminateAndFreeDataChannel; //let the old one terminate
FDataChannelThread := TIdDataChannelThread.Create(APASV, Connection);
FDataChannelThread.OnException := TIdFTPServer(Connection.Server).ThreadException;
//APR 020423 FDataChannelThread.FreeOnTerminate := True;
end;
procedure TIdFTPServerThread.KillDataChannel;
begin
with FDataChannelThread do try
if not Stopped then begin
FDataChannel.DisconnectSocket;
StopMode:=smTerminate; // otherwise the waitfor on the next line waits forever.
WaitFor;
end;
except
{ absorb }
end;
end;
procedure TIdFTPServerThread.ReInitialize;
begin
UserType := utNone;
FAuthenticated := False;
FALLOSize := 0;
FCurrentDir := '/'; {Do not Localize}
FDataType := ftASCII;
FDataMode := dmStream;
FDataPort := 0;
FDataStruct := dsFile;
FHomeDir := ''; {Do not Localize}
FUsername := ''; {Do not Localize}
FPassword := ''; {Do not Localize}
FPASV := False;
FRESTPos := 0;
FRNFR := ''; {Do not Localize}
end;
function TIdFTPServerThread.IsAuthenticated(ASender: TIdCommand): Boolean;
begin
if not FAuthenticated then begin
ASender.Reply.SetReply(530, RSFTPUserNotLoggedIn);
end
else begin
if Assigned(FDataChannelThread) then begin
if not FDataChannelThread.Stopped and
not AnsiSameText(ASender.CommandHandler.Command, 'ABOR') and {Do not Localize}
not AnsiSameText(ASender.CommandHandler.Command, #$FF#$F4#$FF#$FF'ABOR') // ABOR with telnet escape {Do not Localize}
then begin
Result := False;
Exit;
end;
end;
end;
Result := FAuthenticated;
end;
{ TIdFTPServer }
constructor TIdFTPServer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAnonymousAccounts := TstringList.Create;
// By default these user names will be treated as anonymous.
with FAnonymousAccounts do begin
Add('anonymous'); { do not localize }
Add('ftp'); { do not localize }
Add('guest'); { do not localize }
end;
FAllowAnonymousLogin := Id_DEF_AllowAnon;
FAnonymousPassStrictCheck := Id_DEF_PassStrictCheck;
DefaultPort := IDPORT_FTP;
DefaultDataPort := IdPORT_FTP_DATA;
FEmulateSystem := Id_DEF_SystemType;
Greeting.NumericCode := 220;
Greeting.Text.Text := RSFTPDefaultGreeting;
FHelpReply := TstringList.Create;
ThreadClass := TIdFTPServerThread;
ReplyUnknownCommand.NumericCode := 500;
ReplyUnknownCommand.Text.Text := RSFTPCmdSyntaxError;
FUserAccounts := nil;
FSystemType := Id_OS_Win32; {Do not Localize}
end;
procedure TIdFTPServer.InitializeCommandHandlers;
begin
inherited;
//ACCESS CONTROL COMMANDS
//USER <SP> <username> <CRLF>
with CommandHandlers.Add do begin
Command := 'USER'; {Do not Localize}
OnCommand := CommandUSER;
end;
//PASS <SP> <password> <CRLF>
with CommandHandlers.Add do begin
Command := 'PASS'; {Do not Localize}
OnCommand := CommandPASS;
end;
//ACCT <SP> <account-information> <CRLF>
with CommandHandlers.Add do begin
Command := 'ACCT'; {Do not Localize}
ReplyNormal.NumericCode := 202;
ReplyNormal.Text.Text := Format(RSFTPCmdNotImplemented, ['ACCT']); {Do not Localize}
end;
//CWD <SP> <pathname> <CRLF>
with CommandHandlers.Add do begin
Command := 'CWD'; {Do not Localize}
OnCommand := CommandCWD;
ReplyExceptionCode := 550;
end;
//CDUP <CRLF>
with CommandHandlers.Add do begin
Command := 'CDUP'; {Do not Localize}
OnCommand := CommandCDUP;
ReplyExceptionCode := 550;
end;
//SMNT <SP> <pathname> <CRLF>
with CommandHandlers.Add do begin
Command := 'SMNT'; {Do not Localize}
ReplyNormal.NumericCode := 250;
ReplyNormal.Text.Text := RSFTPFileActionCompleted;
end;
//QUIT <CRLF>
with CommandHandlers.Add do begin
Command := 'QUIT'; {Do not Localize}
Disconnect := True;
ReplyNormal.NumericCode := 221;
ReplyNormal.Text.Text := 'Goodbye.'; {Do not Localize}
end;
//REIN <CRLF>
with CommandHandlers.Add do begin
Command := 'REIN'; {Do not Localize}
OnCommand := CommandREIN;
end;
//PORT <SP> <host-port> <CRLF>
with CommandHandlers.Add do begin
Command := 'PORT'; {Do not Localize}
OnCommand := CommandPORT;
end;
//PASV <CRLF>
with CommandHandlers.Add do begin
Command := 'PASV'; {Do not Localize}
OnCommand := CommandPASV;
end;
//TYPE <SP> <type-code> <CRLF>
with CommandHandlers.Add do begin
Command := 'TYPE'; {Do not Localize}
OnCommand := CommandTYPE;
end;
//STRU <SP> <structure-code> <CRLF>
with CommandHandlers.Add do begin
Command := 'STRU'; {Do not Localize}
OnCommand := CommandSTRU;
end;
//MODE <SP> <mode-code> <CRLF>
with CommandHandlers.Add do begin
Command := 'MODE'; {Do not Localize}
OnCommand := CommandMODE;
end;
//FTP SERVICE COMMANDS
//RETR <SP> <pathname> <CRLF>
with CommandHandlers.Add do begin
Command := 'RETR'; {Do not Localize}
OnCommand := CommandRETR;
ReplyExceptionCode := 550;
end;
//STOR <SP> <pathname> <CRLF>
with CommandHandlers.Add do begin
Command := 'STOR'; {Do not Localize}
OnCommand := CommandSSAP;
ReplyExceptionCode := 550;
end;
//STOU <CRLF>
with CommandHandlers.Add do begin
Command := 'STOU'; {Do not Localize}
OnCommand := CommandSSAP;
ReplyExceptionCode := 550;
end;
//APPE <SP> <pathname> <CRLF>
with CommandHandlers.Add do begin
Command := 'APPE'; {Do not Localize}
OnCommand := CommandSSAP;
ReplyExceptionCode := 550;
end;
//ALLO <SP> <decimal-integer>
// [<SP> R <SP> <decimal-integer>] <CRLF>
with CommandHandlers.Add do begin
Command := 'ALLO'; {Do not Localize}
OnCommand := CommandALLO;
end;
//REST <SP> <marker> <CRLF>
with CommandHandlers.Add do begin
Command := 'REST'; {Do not Localize}
OnCommand := CommandREST;
end;
//RNFR <SP> <pathname> <CRLF>
with CommandHandlers.Add do begin
Command := 'RNFR'; {Do not Localize}
OnCommand := CommandRNFR;
end;
//RNTO <SP> <pathname> <CRLF>
with CommandHandlers.Add do begin
Command := 'RNTO'; {Do not Localize}
OnCommand := CommandRNTO;
end;
//ABOR <CRLF>
with CommandHandlers.Add do begin
Command := 'ABOR'; {Do not Localize}
OnCommand := CommandABOR;
end;
//ABOR <CRLF>
with CommandHandlers.Add do begin // ABOR with telnet escape
Command := #$FF#$F4#$FF#$FF'ABOR'; {Do not Localize}
OnCommand := CommandABOR;
end;
//DELE <SP> <pathname> <CRLF>
with CommandHandlers.Add do begin
Command := 'DELE'; {Do not Localize}
OnCommand := CommandDELE;
end;
//RMD <SP> <pathname> <CRLF>
with CommandHandlers.Add do begin
Command := 'RMD'; {Do not Localize}
OnCommand := CommandRMD;
end;
//MKD <SP> <pathname> <CRLF>
with CommandHandlers.Add do begin
Command := 'MKD'; {Do not Localize}
OnCommand := CommandMKD;
end;
//PWD <CRLF>
with CommandHandlers.Add do begin
Command := 'PWD'; {Do not Localize}
OnCommand := CommandPWD;
end;
//LIST [<SP> <pathname>] <CRLF>
FCmdHandlerList := CommandHandlers.Add;
with FCmdHandlerList do begin
Command := 'LIST'; {Do not Localize}
OnCommand := CommandLIST;
end;
//NLST [<SP> <pathname>] <CRLF>
FCmdHandlerNlst := CommandHandlers.Add;
with FCmdHandlerNlst do begin
Command := 'NLST'; {Do not Localize}
OnCommand := CommandLIST;
end;
//SITE <SP> <string> <CRLF>
with CommandHandlers.Add do begin
Command := 'SITE'; {Do not Localize}
OnCommand := CommandSITE;
end;
//SYST <CRLF>
with CommandHandlers.Add do begin
Command := 'SYST'; {Do not Localize}
OnCommand := CommandSYST;
end;
//STAT [<SP> <pathname>] <CRLF>
with CommandHandlers.Add do begin
Command := 'STAT'; {Do not Localize}
OnCommand := CommandSTAT;
end;
//HELP [<SP> <string>] <CRLF>
with CommandHandlers.Add do begin
Command := 'HELP'; {Do not Localize}
ReplyNormal.NumericCode := 214;
//
if Length(FHelpReply.Text) <> 0 then
ReplyNormal.Text := FHelpReply
else
ReplyNormal.Text.Text := 'HELP Command'; {Do not Localize}
end;
//NOOP <CRLF>
with CommandHandlers.Add do begin
Command := 'NOOP'; {Do not Localize}
ReplyNormal.NumericCode := 200;
ReplyNormal.Text.Text := Format(RSFTPCmdSuccessful, ['NOOP']); {Do not Localize}
end;
with CommandHandlers.Add do begin
Command := 'XMKD'; {Do not Localize}
OnCommand := CommandMKD;
end;
with CommandHandlers.Add do begin
Command := 'XRMD'; {Do not Localize}
OnCommand := CommandRMD;
end;
with CommandHandlers.Add do begin
Command := 'XPWD'; {Do not Localize}
OnCommand := CommandPWD;
end;
with CommandHandlers.Add do begin
Command := 'XCUP'; {Do not Localize}
OnCommand := CommandCDUP;
end;
with CommandHandlers.Add do begin
Command := 'FEAT'; {Do not Localize}
OnCommand := CommandFEAT;
end;
//TODO: OPTS - what is this for? Cannot find in RFC 959
with CommandHandlers.Add do begin
Command := 'OPTS'; {Do not Localize}
OnCommand := CommandOPTS;
end;
//SIZE [<FILE>] CRLF
with CommandHandlers.Add do begin
Command := 'SIZE'; {Do not Localize}
OnCommand := CommandSIZE;
end;
end;
destructor TIdFTPServer.Destroy;
begin
FreeAndNil(FAnonymousAccounts);
FreeAndNil(FHelpReply);
inherited Destroy;
end;
procedure TIdFTPServer.ListDirectory(ASender: TIdFTPServerThread; ADirectory: string;
var ADirContents: TstringList; ADetails: Boolean);
var
i: Integer;
LDirectoryList: TIdFTPListItems;
LPathSep: string;
begin
if Assigned(FOnListDirectory) then begin
LDirectoryList := TIdFTPListItems.Create; try
LPathSep := '/'; {Do not Localize}
// Emulated System
case FEmulateSystem of
ftpsOther: begin
if Assigned(OnGetCustomListFormat) then begin
LDirectoryList.ListFormat := flfCustom;
LDirectoryList.OnGetCustomListFormat := DoGetCustomListFormat;
end else begin
LDirectoryList.ListFormat := flfNone;
end;
end;
ftpsDOS: begin
LDirectoryList.ListFormat := flfDos;
LPathSep := '\'; {Do not Localize}
end;
ftpsUNIX: begin
LDirectoryList.ListFormat := flfUnix;
end;
ftpsVAX: begin
LDirectoryList.ListFormat := flfVax;
end;
end;
if Copy(ADirectory, Length(LPathSep), 1) <> LPathSep then begin
ADirectory := ADirectory + LPathSep;
end;
// Event
FOnListDirectory(ASender, ADirectory, LDirectoryList);
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -