idftpserver.pas

Indy控件的使用源代码

    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, FDefaultDataPort);
  FDataChannelThread.OnException := TIdFTPServer(FConnection.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 := FDefaultDataPort;
  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);

      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;