idftpserver.pas

Indy控件的使用源代码

    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;
begin
  with TIdFTPServerThread(ASender.Thread) do begin
    if IsAuthenticated(ASender) then begin
      CreateDataChannel(True);
      FDataChannelThread.SetupDataChannel(TIdIOHandlerSocket(Connection.IOHandler).Binding.IP
       , FDataPort);
      with TIdSimpleServer(FDataChannelThread.FDataChannel) do begin
        BeginListen;
        LBPort := Binding.Port;
        LParam := stringReplace(BoundIP, '.', ',', [rfReplaceAll]);    {Do not Localize}
        LParam := LParam + ',' + IntToStr(LBPort div 256) + ',' + IntToStr(LBPort mod 256);    {Do not Localize}

        ASender.Reply.SetReply(227, Format(RSFTPPassiveMode, [LParam]));
        FPASV := True;
      end;
    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}
      //
      if Assigned(FOnStoreFile) then begin
        LStream := nil;
        FOnStoreFile(TIdFTPServerThread(ASender.Thread), LTmp1, LAppend, LStream);