?? idftpserver.pas
字號:
for i := 0 to LDirectoryList.Count - 1 do begin
if ADetails then begin
ADirContents.Add(LDirectoryList.Items[i].Text);
end else begin
ADirContents.Add(LDirectoryList.Items[i].Filename);
end;
end;
finally FreeAndNil(LDirectoryList); end;
end else begin
raise EIdFTPServerNoOnListDirectory.Create(RSFTPNoOnDirEvent); {Do not Localize}
end;
end;
procedure TIdFTPServer.SetHelpReply(const AValue: Tstrings);
begin
FHelpReply.Assign(AValue);
end;
procedure TIdFTPServer.SetUserAccounts(const AValue: TIdUserManager);
begin
FUserAccounts := AValue;
if Assigned(FUserAccounts) then
begin
FUserAccounts.FreeNotification(Self);
end;
end;
procedure TIdFTPServer.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FUserAccounts) then
FUserAccounts := nil;
end;
procedure TIdFTPServer.SetAnonymousAccounts(const AValue: TstringList);
begin
if Assigned(AValue) then
begin
FAnonymousAccounts.Assign(AValue);
end;
end;
procedure TIdFTPServer.SetEmulateSystem(const AValue: TIdFTPSystems);
begin
if AnsiSameText(FSystemType, 'Windows 9x/NT.') or AnsiSameText(FSystemType, 'UNIX type: L8.') then {Do not Localize}
begin
case AValue of
ftpsDOS: FSystemType := 'Windows 9x/NT.'; {Do not Localize}
ftpsUNIX,
ftpsVAX: FSystemType := 'UNIX type: L8.'; {Do not Localize}
end;
end;
FEmulateSystem := AValue;
end;
procedure TIdFTPServer.ThreadException(AThread: TIdThread;
AException: Exception);
begin
ShowException(AException, nil);
end;
//Command Replies/Handling
procedure TIdFTPServer.CommandUSER(ASender: TIdCommand);
begin
with TIdFTPServerThread(ASender.Thread) do begin
if (FAnonymousAccounts.IndexOf(Lowercase(ASender.UnparsedParams)) >= 0)
and (AllowAnonymousLogin) then begin
UserType := utAnonymousUser;
FUsername := ASender.UnparsedParams;
ASender.Reply.SetReply(331, RSFTPAnonymousUserOkay);
end else begin
UserType := utNormalUser;
if Length(ASender.UnparsedParams) > 0 then begin
FUsername := ASender.UnparsedParams;
ASender.Reply.SetReply(331, RSFTPUserOkay);
end else begin
ASender.Reply.SetReply(332, RSFTPNeedAccountForLogin);
end;
end;
end;
end;
procedure TIdFTPServer.CommandPASS(ASender: TIdCommand);
var
LValidated: Boolean;
begin
with TIdFTPServerThread(ASender.Thread) do begin
case FUserType of
utAnonymousUser:
begin
LValidated := Length(ASender.UnparsedParams) > 0;
if FAnonymousPassStrictCheck and LValidated then begin
LValidated := False;
if FindFirstOf('@.', ASender.UnparsedParams) > 0 then begin {Do not Localize}
LValidated := True;
end;
end;
if LValidated then begin
FAuthenticated := True;
FPassword := ASender.UnparsedParams;
ASender.Reply.SetReply(230, RSFTPAnonymousUserLogged);
end else begin
FUserType := utNone;
FAuthenticated := False;
FPassword := ''; {Do not Localize}
ASender.Reply.SetReply(530, RSFTPUserNotLoggedIn);
end;
end;//utAnonymousUser
utNormalUser:
begin
if Assigned(FUserAccounts) then begin
FAuthenticated := FUserAccounts.AuthenticateUser(FUsername, ASender.UnparsedParams);
if FAuthenticated then begin
FPassword := ASender.UnparsedParams;
ASender.Reply.SetReply(230, RSFTPUserLogged);
end else begin
FPassword := ''; {Do not Localize}
ASender.Reply.SetReply(530, RSFTPUserNotLoggedIn);
end;
end
else if Assigned(FOnUserLogin) then begin
LValidated := False;
FOnUserLogin(TIdFTPServerThread(ASender.Thread), FUsername, ASender.UnparsedParams, LValidated);
FAuthenticated := LValidated;
if LValidated then begin
FPassword := ASender.UnparsedParams;
ASender.Reply.SetReply(230, RSFTPUserLogged);
end else begin
FPassword := ''; {Do not Localize}
ASender.Reply.SetReply(530, RSFTPUserNotLoggedIn);
end;
end
//APR 020423
else begin
ASender.Reply.SetReply(530, RSFTPUserNotLoggedIn); // user manager not found
end;
end;//utNormalUser
else
ASender.Reply.SetReply(503, RSFTPNeedLoginWithUser);
end;//case
end;//with
//After login
if TIdFTPServerThread(ASender.Thread).FAuthenticated and Assigned(FOnAfterUserLogin) then begin
FOnAfterUserLogin(TIdFTPServerThread(ASender.Thread));
end;
end;
procedure TIdFTPServer.CommandCWD(ASender: TIdCommand);
var
s: string;
begin
with TIdFTPServerThread(ASender.Thread) do begin
if IsAuthenticated(ASender) then begin
if Assigned(OnChangeDirectory) then begin
case FEmulateSystem of
ftpsDOS: s := ProcessPath(FCurrentDir, ASender.UnparsedParams, '\'); {Do not Localize}
ftpsOther, ftpsUNIX, ftpsVAX: s := ProcessPath(FCurrentDir, ASender.UnparsedParams);
end;
DoChangeDirectory(TIdFTPServerThread(ASender.Thread), s);
ASender.Reply.SetReply(250, Format(RSFTPCmdSuccessful, ['CWD'])); {Do not Localize}
FCurrentDir := s;
end else begin
ASender.Reply.SetReply(550, Format(RSFTPCmdNotImplemented, ['CWD'])); {Do not Localize}
end;
end;
end;
end;
procedure TIdFTPServer.CommandCDUP(ASender: TIdCommand);
var
s: string;
begin
with TIdFTPServerThread(ASender.Thread) do begin
if IsAuthenticated(ASender) then begin
case FEmulateSystem of
ftpsDOS: s := '..\'; {Do not Localize}
ftpsOther, ftpsUNIX, ftpsVAX: s := '../'; {Do not Localize}
end;
if Assigned(FOnChangeDirectory) then begin
DoChangeDirectory(TIdFTPServerThread(ASender.Thread), s);
FCurrentDir := s;
ASender.Reply.SetReply(212, Format(RSFTPCurrentDirectoryIs, [FCurrentDir]));
end else begin
ASender.Reply.SetReply(550, Format(RSFTPCmdNotImplemented, ['CWD'])); {Do not Localize}
end;
end;
end;
end;
procedure TIdFTPServer.CommandREIN(ASender: TIdCommand);
begin
with TIdFTPServerThread(ASender.Thread) do
begin
if IsAuthenticated(ASender) then
begin
ReInitialize;
ASender.Reply.SetReply(220, RSFTPServiceOpen);
end;
end;
end;
procedure TIdFTPServer.CommandPORT(ASender: TIdCommand);
var
LLo, LHi: Integer;
LParm, IP: string;
begin
with TIdFTPServerThread(ASender.Thread) do begin
if IsAuthenticated(ASender) then begin
FPASV := False;
LParm := ASender.UnparsedParams;
IP := ''; {Do not Localize}
{ h1 }
IP := IP + Fetch(LParm, ',') + '.'; {Do not Localize}
{ h2 }
IP := IP + Fetch(LParm, ',') + '.'; {Do not Localize}
{ h3 }
IP := IP + Fetch(LParm, ',') + '.'; {Do not Localize}
{ h4 }
IP := IP + Fetch(LParm, ','); {Do not Localize}
{ p1 }
LLo := StrToInt(Fetch(LParm, ',')); {Do not Localize}
{ p2 }
LHi := StrToInt(LParm);
FDataPort := (LLo * 256) + LHi;
CreateDataChannel(False);
FDataChannelThread.SetupDataChannel(IP, FDataPort);
ASender.Reply.SetReply(200, Format(RSFTPCmdSuccessful, ['PORT'])); {Do not Localize}
end;
end;
end;
procedure TIdFTPServer.CommandPASV(ASender: TIdCommand);
var
LParam: string;
LBPort: Word;
LThread: TIdFTPServerThread;
begin
LThread := TIdFTPServerThread(ASender.Thread);
with LThread do begin
if IsAuthenticated(ASender) then begin
LParam := TIdIOHandlerSocket(Connection.IOHandler).Binding.IP;
LBPort := FDefaultDataPort;
DoOnPASV(LThread, LParam, LBPort);
CreateDataChannel(True);
FDataChannelThread.SetupDataChannel(LParam, LBPort);
with TIdSimpleServer(FDataChannelThread.FDataChannel) do begin
BeginListen;
LParam := BoundIP;
LBPort := Binding.Port;
end;
FDataPort := LBPort;
FPASV := True;
LParam := StringReplace(LParam, '.', ',', [rfReplaceAll]) + {Do not Localize}
',' + IntToStr(LBPort div 256) + ',' + IntToStr(LBPort mod 256); {Do not Localize}
ASender.Reply.SetReply(227, Format(RSFTPPassiveMode, [LParam]));
end;
end;
end;
procedure TIdFTPServer.CommandTYPE(ASender: TIdCommand);
var
LType: Char;
begin
with TIdFTPServerThread(ASender.Thread) do
begin
if IsAuthenticated(ASender) then
begin
if Length(ASender.UnparsedParams) = 1 then
begin
//Default data type is ASCII
LType := Uppercase(ASender.UnparsedParams)[1];
case LType of
'A': FDataType := ftASCII; {Do not Localize}
'I': FDataType := ftBinary; {Do not Localize}
end;
if FDataType in [ftASCII, ftBinary] then
begin
ASender.Reply.SetReply(200, Format(RSFTPTYPEChanged, [LType]));
end;
end;
end;
end;
end;
procedure TIdFTPServer.CommandSTRU(ASender: TIdCommand);
var
LDataStruct: Char;
begin
with TIdFTPServerThread(ASender.Thread) do
begin
if IsAuthenticated(ASender) then
begin
if Length(ASender.UnparsedParams) = 1 then
begin
//Default structure is file
LDataStruct := Uppercase(ASender.UnparsedParams)[1];
case LDataStruct of
'F': FDataStruct := dsFile; {Do not Localize}
'R': FDataStruct := dsRecord; {Do not Localize}
'P': FDataStruct := dsPage; {Do not Localize}
end;
if FDataStruct in [dsFile, dsRecord, dsPage] then
begin
ASender.Reply.SetReply(200, Format(RSFTPSTRUChanged, [LDataStruct]));
end;
end;
end;
end;
end;
procedure TIdFTPServer.CommandMODE(ASender: TIdCommand);
var
LMode: Char;
begin
with TIdFTPServerThread(ASender.Thread) do
begin
if IsAuthenticated(ASender) then
begin
if Length(ASender.UnparsedParams) = 1 then
begin
//Default data mode is stream
LMode := Uppercase(ASender.UnparsedParams)[1];
case LMode of
'B': FDataMode := dmBlock; {Do not Localize}
'C': FDataMode := dmCompressed; {Do not Localize}
'S': FDataMode := dmStream; {Do not Localize}
end;
if FDataMode in [dmBlock, dmCompressed, dmStream] then
begin
ASender.Reply.SetReply(200, Format(RSFTPMODEChanged, [LMode]));
end;
end;
end;
end;
end;
procedure TIdFTPServer.CommandRETR(ASender: TIdCommand);
var
s: string;
LStream: TStream;
begin
with TIdFTPServerThread(ASender.Thread) do begin
if IsAuthenticated(ASender) then begin
//TODO: Fix reference to /
s := ProcessPath(CurrentDir, ASender.UnparsedParams, '/'); {Do not Localize}
if Assigned(FOnRetrieveFile) then begin
LStream := nil;
FOnRetrieveFile(TIdFTPServerThread(ASender.Thread), s, LStream);
if Assigned(LStream) then begin
LStream.Position := FRESTPos;
FRESTPos := 0;
FDataChannelThread.Data := LStream;
FDataChannelThread.OKReply.SetReply(226, RSFTPDataConnClosed);
FDataChannelThread.ErrorReply.SetReply(426, RSFTPDataConnClosedAbnormally);
ASender.Reply.SetReply(150, RSFTPDataConnToOpen);
ASender.SendReply;
FDataChannelThread.StartThread(ftpRetr);
end else begin
ASender.Reply.SetReply(550, RSFTPFileActionAborted);
end;
end else begin
ASender.Reply.SetReply(550, Format(RSFTPCmdNotImplemented, ['RETR'])); {Do not Localize}
end;
end;
end;
end;
procedure TIdFTPServer.CommandSSAP(ASender: TIdCommand);
var
LStream: TStream;
LTmp1: string;
LAppend: Boolean;
Reply: TIdRFCReply;
begin
with TIdFTPServerThread(ASender.Thread) do begin
if IsAuthenticated(ASender) then begin
if AnsiSameText(ASender.CommandHandler.Command, 'STOU') then begin {Do not Localize}
//TODO: Find a better method of finding unique names
RandSeed := 9944;
Randomize;
LTmp1 := 'Tmp' + IntToStr(Random(192)); {Do not Localize}
end else begin
LTmp1 := ASender.UnparsedParams;
end;
//
LTmp1 := ProcessPath(FCurrentDir, LTmp1);
LAppend := AnsiSameText(ASender.CommandHandler.Command, 'APPE'); {Do not Localize}
//
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -