idftpserver.pas

Indy控件的使用源代码

        if Assigned(LStream) then begin
          //Issued previously by ALLO cmd
          if FALLOSize > 0 then begin
            LStream.Size := FALLOSize;
          end;
          if LAppend then begin
            LStream.Position := LStream.Size;
          end else begin
            LStream.Position := FRESTPos;
            FRESTPos:=0;
//was:            LStream.Position := 0;
          end;
          { Data transfer }
          try
            Reply := TIdRFCReply.Create(nil);
            {
            FDataChannelThread.Data := LStream;
            Reply.SetReply(226, RSFTPDataConnClosed);
            FDataChannelThread.OKReply := Reply;
            Reply.SetReply(426, RSFTPDataConnClosedAbnormally);
            FDataChannelThread.ErrorReply := Reply;
            ASender.Reply.SetReply(150, RSFTPDataConnToOpen);
            ASender.SendReply;   }
            FDataChannelThread.Data := LStream;
            FDataChannelThread.OKReply.SetReply(226, RSFTPDataConnClosed);
            FDataChannelThread.ErrorReply.SetReply(426, RSFTPDataConnClosedAbnormally);
            ASender.Reply.SetReply(150, RSFTPDataConnToOpen);
            ASender.SendReply;

            FDataChannelThread.StartThread(ftpStor);
          finally FreeAndNil(Reply); end;
        end else begin
          ASender.Reply.SetReply(550, RSFTPFileActionAborted);
        end;
      end else begin
        ASender.Reply.SetReply(550, Format(RSFTPCmdNotImplemented, [ASender.CommandHandler.Command]));
      end;
    end;
  end;
end;

procedure TIdFTPServer.CommandALLO(ASender: TIdCommand);
var
  s: string;
begin
  with TIdFTPServerThread(ASender.Thread) do
  begin
    if IsAuthenticated(ASender) then
    begin
      s := Uppercase(ASender.UnparsedParams);
      case s[1] of
        'R':    {Do not Localize}
           begin
             if s[2] = #32 then begin
               FALLOSize := StrToIntDef(Copy(s, 2, Length(s) - 2), 0);
             end;
           end;
      else
        FALLOSize := StrToIntDef(ASender.UnparsedParams, 0);
      end;
      ASender.Reply.SetReply(200, Format(RSFTPCmdSuccessful, ['ALLO']));    {Do not Localize}
    end;
  end;
end;

procedure TIdFTPServer.CommandREST(ASender: TIdCommand);
begin
  with TIdFTPServerThread(ASender.Thread) do
  begin
    if IsAuthenticated(ASender) then
    begin
      FRESTPos := StrToIntDef(ASender.UnparsedParams, 0);
      ASender.Reply.SetReply(350, RSFTPFileActionPending);
    end;
  end;
end;

procedure TIdFTPServer.CommandRNFR(ASender: TIdCommand);
var
  s: string;
begin
  with TIdFTPServerThread(ASender.Thread) do
  begin
    if IsAuthenticated(ASender) then
    begin
      s := ASender.UnparsedParams;
      if Assigned(FOnRenameFile) then
      begin
        ASender.Reply.SetReply(350, RSFTPFileActionPending);
        FRNFR := s;
      end
      else
      begin
        ASender.Reply.SetReply(350, RSFTPFileActionPending);
      end;
    end;
  end;
end;

procedure TIdFTPServer.CommandRNTO(ASender: TIdCommand);
var
  s: string;
begin
  with TIdFTPServerThread(ASender.Thread) do
  begin
    if IsAuthenticated(ASender) then
    begin
      s := ASender.UnparsedParams;
      if Assigned(FOnRenameFile) then
      begin
        try
          FOnRenameFile(TIdFTPServerThread(ASender.Thread), FRNFR, s);
          ASender.Reply.NumericCode := 250;
        except
          ASender.Reply.NumericCode := 550;
          raise;
        end;
      end
      else
      begin
        ASender.Reply.SetReply(550, RSFTPFileActionNotTaken);
      end;
    end;
  end;
end;

procedure TIdFTPServer.CommandABOR(ASender: TIdCommand);
begin
  with TIdFTPServerThread(ASender.Thread) do begin
    if IsAuthenticated(ASender) then begin
      if not FDataChannelThread.Stopped then begin
        FDataChannelThread.OkReply.SetReply(426, RSFTPDataConnClosedAbnormally);
        FDataChannelThread.ErrorReply.SetReply(426, RSFTPDataConnClosedAbnormally);
        KillDataChannel;
        ASender.Reply.SetReply(226, RSFTPDataConnClosed);
      end else begin
        ASender.Reply.SetReply(226, Format(RSFTPCmdSuccessful, ['ABOR']));    {Do not Localize}
      end;
    end;
  end;
end;

procedure TIdFTPServer.CommandDELE(ASender: TIdCommand);
(*
DELE <SP> <pathname> <CRLF>
  250 Requested file action okay, completed.
  450 Requested file action not taken. - File is busy
  550 Requested action not taken. - File unavailable, no access permitted, etc
  500 Syntax error, command unrecognized.
  501 Syntax error in parameters or arguments.
  502 Command not implemented.
  421 Service not available, closing control connection. - During server shutdown, etc
  530 Not logged in.
*)
//TODO: Need to set replies when not authenticated and set replynormal to 250
// do for all procs, list valid replies in comments. Or maybe default is 550
begin
  with TIdFTPServerThread(ASender.Thread) do begin
    if IsAuthenticated(ASender) then begin
      if Assigned(FOnDeleteFile) then begin
        FOnDeleteFile(TIdFTPServerThread(ASender.Thread), ASender.UnparsedParams);
        ASender.Reply.SetReply(250, RSFTPFileActionCompleted);
      end else begin
        ASender.Reply.SetReply(550, RSFTPFileActionNotTaken);
      end;
    end;
  end;
end;

procedure TIdFTPServer.CommandRMD(ASender: TIdCommand);
var
  s: string;
begin
  with TIdFTPServerThread(ASender.Thread) do begin
    if IsAuthenticated(ASender) then begin
      s := ProcessPath(FCurrentDir, ASender.UnparsedParams);
      if Assigned(FOnRemoveDirectory) then begin
        DoRemoveDirectory(TIdFTPServerThread(ASender.Thread), s);
        ASender.Reply.SetReply(250, RSFTPFileActionCompleted);
      end else begin
        ASender.Reply.SetReply(550, Format(RSFTPCmdNotImplemented, ['RMD']));    {Do not Localize}
      end;
    end;
  end;
end;

procedure TIdFTPServer.CommandMKD(ASender: TIdCommand);
var
  S: string;
begin
  with TIdFTPServerThread(ASender.Thread) do begin
    if IsAuthenticated(ASender) then begin
      S := ProcessPath(FCurrentDir, ASender.UnparsedParams);
      if Assigned(FOnMakeDirectory) then begin
        FOnMakeDirectory(TIdFTPServerThread(ASender.Thread), s);
        ASender.Reply.SetReply(257, RSFTPFileActionCompleted);
      end
      else begin
        ASender.Reply.SetReply(550, Format(RSFTPCmdNotImplemented, ['MKD']));    {Do not Localize}
      end;
    end;
  end;
end;

procedure TIdFTPServer.CommandPWD(ASender: TIdCommand);
begin
  with TIdFTPServerThread(ASender.Thread) do
  begin
    if IsAuthenticated(ASender) then
    begin
      ASender.Reply.SetReply(257, Format(RSFTPCurrentDirectoryIs, [FCurrentDir]));
    end;
  end;
end;

procedure TIdFTPServer.CommandLIST(ASender: TIdCommand);
var
  LStream: TstringList;
begin
  with TIdFTPServerThread(ASender.Thread) do begin
    if IsAuthenticated(ASender) then begin
      LStream := TstringList.Create;
      try
        ListDirectory(TIdFTPServerThread(ASender.Thread), ProcessPath(FCurrentDir
         , ASender.UnparsedParams), LStream, ASender.CommandHandler = FCmdHandlerList);
      finally
        FDataChannelThread.Data := LStream;
        FDataChannelThread.OKReply.SetReply(226, RSFTPDataConnClosed);
        FDataChannelThread.ErrorReply.SetReply(426, RSFTPDataConnClosedAbnormally);
        ASender.Reply.SetReply(125, RSFTPDataConnToOpen);
        ASender.SendReply;
        FDataChannelThread.StartThread(ftpRetr);
      end;
    end;
  end;
end;

procedure TIdFTPServer.CommandSITE(ASender: TIdCommand);
var
  s: string;
begin
  with TIdFTPServerThread(ASender.Thread) do
  begin
    if IsAuthenticated(ASender) then
    begin
      s := Uppercase(ASender.UnparsedParams);
      if AnsiSameText(s, 'HELP') then    {Do not Localize}
      begin
        ASender.Reply.SetReply(214, RSFTPSITECmdsSupported);
      end
      else
      begin
        case FEmulateSystem of
          ftpsDOS: ASender.Reply.SetReply(214, Format(RSFTPDirectorySTRU, ['MS-DOS']));    {Do not Localize}
          ftpsUNIX: ASender.Reply.SetReply(214, Format(RSFTPDirectorySTRU, ['UNIX']));    {Do not Localize}
          ftpsVAX: ASender.Reply.SetReply(214, Format(RSFTPDirectorySTRU, ['VAX/VMS']));    {Do not Localize}
        end;
      end;
    end;
  end;
end;

procedure TIdFTPServer.CommandSYST(ASender: TIdCommand);
begin
  with TIdFTPServerThread(ASender.Thread) do begin
    if IsAuthenticated(ASender) then begin
      ASender.Reply.SetReply(215, FSystemType);
    end;
  end;
end;

procedure TIdFTPServer.CommandSTAT(ASender: TIdCommand);
var
  LStream: TstringList;
begin
  with TIdFTPServerThread(ASender.Thread) do begin
    if IsAuthenticated(ASender) then begin
      if NOT FDataChannelThread.Stopped then begin //was .Suspended
        ASender.Reply.SetReply(211, RSFTPOpenDataConn);
      end;
      //else act as LIST command without a data channel
      ASender.Reply.SetReply(211, RSFTPDataConnToOpen);
      ASender.SendReply;
      LStream := TStringList.Create;
      try
        ListDirectory(TIdFTPServerThread(ASender.Thread), ProcessPath(FCurrentDir,
          ASender.UnparsedParams), LStream, True);
      finally
        Connection.Writestrings(LStream);
        FreeAndNil(LStream);
      end;
      ASender.Reply.SetReply(211, RSFTPCmdEndOfStat);
    end;
  end;
end;

procedure TIdFTPServer.CommandFEAT(ASender: TIdCommand);
begin
  with TIdFTPServerThread(ASender.Thread) do begin
    begin
      ASender.Reply.SetReply(502,RSFTPCmdSyntaxError);
    end;
  end;
end;

procedure TIdFTPServer.CommandOPTS(ASender: TIdCommand);
var
  s: string;
begin
  with TIdFTPServerThread(ASender.Thread) do begin
    if IsAuthenticated(ASender) then begin
      //TODO: Actually call event
      s := ASender.UnparsedParams;
      ASender.Reply.SetReply(202, Format(RSFTPCmdNotImplemented, ['OPTS']));    {Do not Localize}
    end;
  end;
end;

procedure TIdFTPServer.CommandSIZE(ASender: TIdCommand);
var
  s: string;
  LSize: Int64;
begin
  with TIdFTPServerThread(ASender.Thread) do begin
    if IsAuthenticated(ASender) then
    begin
      s := ProcessPath(FCurrentDir, ASender.UnparsedParams);
      if Assigned(FOnGetFileSize) then
      begin
        try
          LSize := -1;
          FOnGetFileSize(TIdFTPServerThread(ASender.Thread), s, LSize);
          if LSize > -1 then begin
            ASender.Reply.SetReply(213, IntToStr(LSize));
          end else begin
            ASender.Reply.SetReply(550, RSFTPFileActionAborted);
          end;
        except
          ASender.Reply.NumericCode := 550;
          raise;
        end;
      end else begin
        ASender.Reply.SetReply(550, Format(RSFTPCmdNotImplemented, ['SIZE']));    {Do not Localize}
      end;
    end;
  end;
end;

procedure TIdFTPServer.DoGetCustomListFormat(AItem: TIdFTPListItem; var VText: string);
begin
  if Assigned(OnGetCustomListFormat) then begin
    OnGetCustomListFormat(Self, AItem, VText);
  end;
end;

procedure TIdFTPServer.DoChangeDirectory(AThread: TIdFTPServerThread; var VDirectory: string);
begin
  if Assigned(FOnChangeDirectory) then begin
    FOnChangeDirectory(AThread, VDirectory);
  end;
end;

procedure TIdFTPServer.DoRemoveDirectory(AThread: TIdFTPServerThread; var VDirectory: string);
begin
  if Assigned(FOnRemoveDirectory) then begin
    FOnRemoveDirectory(AThread, VDirectory);
  end;
end;

procedure TIdFTPServer.DoMakeDirectory(AThread: TIdFTPServerThread; var VDirectory: string);
begin
  if Assigned(FOnMakeDirectory) then begin
    FOnMakeDirectory(AThread, VDirectory);
  end;
end;

end.