Indy FTP Server尚未解决和已经解决的问题，公开源码，希望高手帮忙解决。

Question

源码：
unit ServiceMainU;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  IdBaseComponent, IdComponent, IdTCPServer, IdFTPServer, Registry, forms,
  IdUserAccounts, IdThreadMgr, IdThreadMgrPool, IdThreadMgrDefault, IdFTPList;type
  TServMain = class(TService)
    IdFTPServ: TIdFTPServer;
    IdUserMan: TIdUserManager;
    procedure ServiceAfterInstall(Sender: TService);
    procedure ServiceAfterUninstall(Sender: TService);
    procedure ServiceStart(Sender: TService; var Started: Boolean);
    procedure ServiceStop(Sender: TService; var Stopped: Boolean);
    procedure ServiceExecute(Sender: TService);
    procedure IdFTPServAfterUserLogin(ASender: TIdFTPServerThread);
    procedure IdFTPServException(AThread: TIdPeerThread;
      AException: Exception);
    procedure IdFTPServRetrieveFile(ASender: TIdFTPServerThread;
      const AFileName: String; var VStream: TStream);
    procedure IdFTPServChangeDirectory(ASender: TIdFTPServerThread;
      var VDirectory: String);
    procedure IdFTPServListDirectory(ASender: TIdFTPServerThread;
      const APath: String; ADirectoryListing: TIdFTPListItems);
    procedure IdFTPServBeforeCommandHandler(ASender: TIdTCPServer;
      const AData: String; AThread: TIdPeerThread);
    procedure IdFTPServGetCustomListFormat(ASender: TIdFTPServer;
      AItem: TIdFTPListItem; var VText: String);
    procedure IdFTPServMakeDirectory(ASender: TIdFTPServerThread;
      var VDirectory: String);
    procedure IdFTPServUserLogin(ASender: TIdFTPServerThread;
      const AUsername, APassword: String; var AAuthenticated: Boolean);
    procedure IdFTPServStoreFile(ASender: TIdFTPServerThread;
      const AFileName: String; AAppend: Boolean; var VStream: TStream);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    { Public declarations }
  end;var
  ServMain: TServMain;const
  csRegEventLog = 'SYSTEM\CurrentControlSet\Services\Eventlog\Application';
  csServiceName = 'ServMain';implementationuses MainU;{$R *.DFM}procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  ServMain.Controller(CtrlCode);
end;function TServMain.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;Procedure RegEventLog( aRegister : Boolean );
Var
  reg : TRegistry;
Begin
  reg := TRegistry.Create;
  Try
    reg.RootKey := HKEY_LOCAL_MACHINE;
    If (reg.OpenKey(csRegEventLog, false)) Then
    Begin
      If (aRegister) Then
      Begin
        If (reg.OpenKey(csServiceName, true)) Then
        Begin
          reg.WriteString('EventMessageFile', ParamStr(0));
          reg.WriteInteger('TypesSupported', EVENTLOG_ERROR_TYPE
                        OR EVENTLOG_WARNING_TYPE OR EVENTLOG_INFORMATION_TYPE);
        End;
      End
      Else
        reg.DeleteKey(csServiceName);
    End;
  Finally
    reg.Free;
  End;
End;procedure TServMain.ServiceAfterInstall(Sender: TService);
begin
  RegEventLog(true);
end;procedure TServMain.ServiceAfterUninstall(Sender: TService);
begin
  RegEventLog(false);
end;procedure TServMain.ServiceStart(Sender: TService; var Started: Boolean);
begin
  IdFTPServ.Active := true;//服务启动
  Started := true;
end;procedure TServMain.ServiceStop(Sender: TService; var Stopped: Boolean);
begin
  IdFTPServ.Active := false;//服务停止
  Stopped := true;
end;procedure TServMain.ServiceExecute(Sender: TService);
begin
  while not Terminated do//服务响应消息
    begin
      ServiceThread.ProcessRequests(False);
      sleep(100);
    end;
end;procedure TServMain.IdFTPServAfterUserLogin(ASender: TIdFTPServerThread);
begin
//登录以后的事务处理，如何设置默认路径？？？
end;procedure TServMain.IdFTPServException(AThread: TIdPeerThread;
  AException: Exception);
begin
//出错处理，以解决
end;procedure TServMain.IdFTPServRetrieveFile(ASender: TIdFTPServerThread;
  const AFileName: String; var VStream: TStream);
begin//文件下载，响应Get，以解决
  VStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
end;procedure TServMain.IdFTPServChangeDirectory(ASender: TIdFTPServerThread;
  var VDirectory: String);
begin//改变路径，以解决
  if VDirectory[1] = '\' then
    VDirectory := 'E:\ftproot' + VDirectory;
  if pos(VDirectory, 'E:\ftproot\') <> 0 then
    VDirectory := 'E:\ftproot';
end;procedure TServMain.IdFTPServListDirectory(ASender: TIdFTPServerThread;
  const APath: String; ADirectoryListing: TIdFTPListItems);
begin
end;procedure TServMain.IdFTPServBeforeCommandHandler(ASender: TIdTCPServer;
  const AData: String; AThread: TIdPeerThread);
beginend;procedure TServMain.IdFTPServGetCustomListFormat(ASender: TIdFTPServer;
  AItem: TIdFTPListItem; var VText: String);
beginend;procedure TServMain.IdFTPServMakeDirectory(ASender: TIdFTPServerThread;
  var VDirectory: String);
begin//创建新路经，以解决
  VDirectory := StringReplace(VDirectory, '/', '\', [rfReplaceAll, rfIgnoreCase]);
  ForceDirectories(VDirectory);
end;procedure TServMain.IdFTPServUserLogin(ASender: TIdFTPServerThread;
  const AUsername, APassword: String; var AAuthenticated: Boolean);
begin
  AAuthenticated := true;//用户登录验证，已实现
end;procedure TServMain.IdFTPServStoreFile(ASender: TIdFTPServerThread;
  const AFileName: String; AAppend: Boolean; var VStream: TStream);
begin
  showmessage(AFileName);
//客户端PUT可是VStream是nil，我如何接收？？
end;end.

Answer 1

一个SSL FTP Server的Demo
unit SSLFTPServer_Unit;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, CRC32Verify, IdServerIOHandler, IdSSLOpenSSL,
  IdBaseComponent, IdComponent, IdTCPServer, IdFTPServer, IdFTPList;type
  TForm1 = class(TForm)
    FTPSServer: TIdFTPServer;
    ServerIOHandlerSSL: TIdServerIOHandlerSSL;
    Label1: TLabel;
    portLabel: TLabel;
    procedure ServerIOHandlerSSLGetPassword(var Password: String);
    procedure FormCreate(Sender: TObject);
    procedure FTPSServerListDirectory(ASender: TIdFTPServerThread;
      const APath: String; ADirectoryListing: TIdFTPListItems);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.ServerIOHandlerSSLGetPassword(var Password: String);
begin
  Password:='aaaa';
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  portlabel.Caption:=InttoStr(FTPSServer.DefaultPort);
end;procedure TForm1.FTPSServerListDirectory(ASender: TIdFTPServerThread;
  const APath: String; ADirectoryListing: TIdFTPListItems);
begin
／／根据User信息，给出List的内容，这里只是Demo
  With ADirectoryListing.Add do
    begin
      FileName:='SSL FTP Test Virtual Folder';
      ItemType:=ditDirectory;／／目录
      Size:=0;
      ModifiedDate:=Now;
      GroupName:='LY';
      OwnerName:='LY';
      UserPermissions:='r--';
      GroupPermissions:='r--';
      OwnerPermissions:='r--';
    end;
  With ADirectoryListing.Add do
    begin
      FileName:='SSL FTP Test Virtual File';
      ItemType:=ditFile; ／／文件
      Size:=0;
      ModifiedDate:=Now;
      GroupName:='LY';
      OwnerName:='LY';
      UserPermissions:='r--';
      GroupPermissions:='r--';
      OwnerPermissions:='r--';
    end;
end;end.

Answer 2

Indy FTP Server的源代码片段:if Assigned(FOnStoreFile) then begin
 LStream := nil; //很明显VStream是空的Nil
 FOnStoreFile(TIdFTPServerThread(ASender.Thread), LTmp1, LAppend, LStream);
 if Assigned(LStream) then begin …
可以看出是这样接受文件的:根据AFileName给出的名字,创建文件流,复制给var VStream参数,由Indy负责写入数据.
另外: TIdFTPServerThread是有各种属性的HomeDir, CurrentDir等
procedure TForm1.FTPSServerListDirectory(ASender: TIdFTPServerThread;
  const APath: String; ADirectoryListing: TIdFTPListItems);
begin //中是有HomeDir属性的
  ASender.HomeDir