急啊，IdFTPServer总是出现内存错误

Question

错误信息如下：
异常EAccessViolation发生在模块XXX.exe中的00000000位置。
存取地址004AFCAB违例发生在模块XXX.exe中，读 在地址0000000C里。这个异常在文件上传的时候会出现（不是100％出现），但文件能上传。我在调试那里选中了“停在异常处”，但出现上面那个异常的时候，并没有“停在异常处”，所以我根本不知道哪里出错。郁闷啊！代码如下：FTPSERVER端代码（那个错误框是服务器端弹出来的）：...
type
  TFtpMessage = Class(TObject)
    public
      FTPServer: String;
      Port: Integer;
      UserName: String;
      Password: String;
      MainFolder: String;
  end;var
  FtpMessage: TFtpMessage;
...procedure TfrmServer.GetFtpConfig;
var
  FileName: String;
  ini: TIniFile;
begin
  FtpMessage := TFtpMessage.Create;
  FileName := Extractfilepath(Application.ExeName) + 'Config.ini';
  if FileExists(FileName) then
  begin
    ini := TIniFile.Create(FileName);
    try
      FtpMessage.FTPServer := ini.ReadString('FTP', 'FTPServer', '');
      FtpMessage.Port := ini.ReadInteger('FTP', 'Port', 9521);
      FtpMessage.UserName := ini.ReadString('FTP', 'UserName', '');
      FtpMessage.Password := ini.ReadString('FTP', 'Password', '');
      FtpMessage.MainFolder := ini.ReadString('FTP', 'MainFolder', '');
    finally
      ini.Free;
    end;
  end;
end;procedure TfrmServer.InitFTPServer;
begin
  GetFtpConfig;
  IdFTPServer1.DefaultPort := FtpMessage.Port;
  IdFTPServer1.AllowAnonymousLogin := False;
  IdFTPServer1.EmulateSystem := IdFTPServer.ftpsUNIX;
  IdFTPServer1.HelpReply.Text := 'Help is not implemented';
  IdFTPServer1.Greeting.NumericCode := 220;
  with IdFTPServer1.CommandHandlers.add do
  begin
    Command := 'XCRC';
    OnCommand := IdFTPServer1CommandXCRC;
  end;
  IdFTPServer1.Active := True;
  Memo1.Lines.Add('['+ GetNow() + '][系统信息]文件服务启动...');
end;procedure TfrmServer.StopFtpServer;
begin
  IdFTPServer1.Active := False;
  Memo1.Lines.Add('['+ GetNow() + '][系统信息]文件服务停止...');
end;procedure TfrmServer.IdFTPServer1CommandXCRC(ASender: TIdCommand);
var
  s: string;
begin
  //Memo1.Lines.Add('['+ GetNow() + '][系统信息]-- CommandXCRC Start --');
  with TIdFTPServerThread(ASender.Thread) do
  begin
    if Authenticated then
    begin
      try
        s := ProcessPath(CurrentDir, ASender.UnparsedParams) ;
        s := TransLatePath(s, TIdFTPServerThread(ASender.Thread).HomeDir) ;
        ASender.Reply.SetReply(213, CalculateCRC(s)) ;
      except
        ASender.Reply.SetReply(500, 'file error') ;
      end;
    end;
  end;
  //Memo1.Lines.Add('['+ GetNow() + '][系统信息]-- CommandXCRC End --');
end;function TfrmServer.CalculateCRC(const path: string ) : string;
var
  f: tfilestream;
  value: dword;
  IdHashCRC32: TIdHashCRC32;
begin
  IdHashCRC32 := nil;
  f := nil;
  try
    IdHashCRC32 := TIdHashCRC32.create;
    f := TFileStream.create(path, fmOpenRead or fmShareDenyWrite) ;
    value := IdHashCRC32.HashValue( f ) ;
    result := inttohex(value, 8) ;
  finally
    f.free;
    IdHashCRC32.free;
  end;
end;procedure TfrmServer.IdFTPServer1ChangeDirectory(
  ASender: TIdFTPServerThread; var VDirectory: String);
begin
  Memo1.Lines.Add('['+ GetNow() + '][系统信息]-- ChangeDirectory Start --');
  try
    VDirectory := GetNewDirectory(ASender.CurrentDir, VDirectory);
  except
    on E:Exception do
    Memo1.Lines.Add('['+ GetNow() + '][系统信息]' + E.Message);
  end;
  Memo1.Lines.Add('['+ GetNow() + '][系统信息]-- ChangeDirectory End --');
end;function TfrmServer.GetNewDirectory( old, action: string ) : string;
var
  a: integer;
begin
  if action = '../' then
  begin
    if old = '/' then
    begin
      result := old;
      exit;
    end;
    a := length( old ) - 1;
    while ( old[a] <> '\' ) and ( old[a] <> '/' ) do
      dec( a ) ;
    result := copy( old, 1, a ) ;
    exit;
  end;
  if ( action[1] = '/' ) or ( action[1] = '\' ) then
    result := action
  else
    result := old + action;
end;procedure TfrmServer.IdFTPServer1GetFileSize(ASender: TIdFTPServerThread;
  const AFilename: String; var VFileSize: Int64);
var
  FileName: String;
begin
  //Memo1.Lines.Add('['+ GetNow() + '][系统信息]-- GetFileSize Start --');
  try
    FileName := TransLatePath(AFilename, ASender.HomeDir);
    if FileExists(FileName) then
      VFileSize := GetSizeOfFile(FileName)
    else
      VFileSize := 0;
  except
    on E:Exception do
    Memo1.Lines.Add('['+ GetNow() + '][系统信息]' + E.Message);
  end;
  //Memo1.Lines.Add('['+ GetNow() + '][系统信息]-- GetFileSize End --');
end;

Answer 1

function TfrmServer.GetSizeOfFile(const APathname: string): int64;
begin
  result := FileSizeByName(APathname) ;
end;function TfrmServer.TransLatePath(const APathname, homeDir: string) : string;
var
  tmppath: string;
begin
  result := SlashToBackSlash(homeDir) ;
  tmppath := SlashToBackSlash(APathname) ;
  if homedir = '/' then
  begin
    result := tmppath;
    exit;
  end;  if length(APathname) = 0 then
    exit;
  if result[length(result)] = '\' then
    result := Copy(result, 1, length( result ) - 1);
  if tmppath[1] <> '\' then
    result := result + '\';
  result := result + tmppath;
end;function TfrmServer.SlashToBackSlash(const str: string) : string;
var
  a: dword;
begin
  result := str;
  for a := 1 to length(result) do
    if result[a] = '/' then result[a] := '\';
end;procedure TfrmServer.IdFTPServer1ListDirectory(ASender: TIdFTPServerThread;
  const APath: String; ADirectoryListing: TIdFTPListItems);
var
  f: tSearchRec;
  a: integer;
begin
  //Memo1.Lines.Add('['+ GetNow() + '][系统信息]-- ListDirectory Start --');
  try
    ADirectoryListing.DirectoryName := apath;
    a := FindFirst(TransLatePath(apath, ASender.HomeDir) + '*.*', faAnyFile, f);
    while (a = 0) do
    begin
      if (f.Attr and faDirectory > 0) then
        AddlistItem(ADirectoryListing, f.Name, ditDirectory, f.size, FileDateToDateTime(f.Time))
      else
        AddlistItem(ADirectoryListing, f.Name, ditFile, f.size, FileDateToDateTime(f.Time));
      a := FindNext(f);
    end;
    FindClose(f);
  except
    on E:Exception do
    Memo1.Lines.Add('['+ GetNow() + '][系统信息]' + E.Message);
  end;
  //Memo1.Lines.Add('['+ GetNow() + '][系统信息]-- ListDirectory End --');
end;procedure TfrmServer.AddlistItem(aDirectoryListing: TIdFTPListItems; Filename: string; ItemType: TIdDirItemType; size: int64; date: tdatetime );
var
  listitem: TIdFTPListItem;
begin
  listitem := aDirectoryListing.Add;
  listitem.ItemType := ItemType;
  listitem.FileName := Filename;
  listitem.OwnerName := 'anonymous';
  listitem.GroupName := 'all';
  listitem.OwnerPermissions := '---';
  listitem.GroupPermissions := '---';
  listitem.UserPermissions := '---';
  listitem.Size := size;
  listitem.ModifiedDate := date;
end;procedure TfrmServer.IdFTPServer1UserLogin(ASender: TIdFTPServerThread;
  const AUsername, APassword: String; var AAuthenticated: Boolean);
begin
  //Memo1.Lines.Add('['+ GetNow() + '][系统信息]-- UserLogin Start --' + FtpMessage.UserName);
  try
    AAuthenticated := (AUsername = FtpMessage.UserName) and (APassword = FtpMessage.Password) ;
    if not AAuthenticated then exit;
    ASender.HomeDir := FtpMessage.MainFolder;
    ASender.CurrentDir := '';
  except
    on E:Exception do
    Memo1.Lines.Add('['+ GetNow() + '][系统信息]' + E.Message);
  end;
  //Memo1.Lines.Add('['+ GetNow() + '][系统信息]-- UserLogin End --' + FtpMessage.Password);
end;procedure TfrmServer.IdFTPServer1RenameFile(ASender: TIdFTPServerThread;
  const ARenameFromFile, ARenameToFile: String);
begin
  //Memo1.Lines.Add('['+ GetNow() + '][系统信息]-- RenameFile Start --');
  try
    if not MoveFile(pchar(TransLatePath(ARenameFromFile, ASender.HomeDir)) , pchar(TransLatePath(ARenameToFile, ASender.HomeDir))) then
    RaiseLastWin32Error;
  except
    on E:Exception do
    Memo1.Lines.Add('['+ GetNow() + '][系统信息]' + E.Message);
  end;
  //Memo1.Lines.Add('['+ GetNow() + '][系统信息]-- RenameFile End --');
end;procedure TfrmServer.IdFTPServer1DeleteFile(ASender: TIdFTPServerThread;
  const APathName: String);
var
  FileName: String;
begin
  FileName := TransLatePath(ASender.CurrentDir + '/' + APathname, ASender.HomeDir);
  if FileExists(FileName) then
  begin
    DeleteFile(FileName);
    Memo1.Lines.Add('['+ GetNow() + '][系统信息]删除文件' + APathname);
    Application.ProcessMessages;
  end;
end;procedure TfrmServer.IdFTPServer1RetrieveFile(ASender: TIdFTPServerThread;
  const AFileName: String; var VStream: TStream);
begin
  VStream := TFileStream.Create(TransLatePath(AFilename, ASender.HomeDir), fmopenread or fmShareDenyWrite);
  Memo1.Lines.Add('['+ GetNow() + '][系统信息]下载文件' + AFilename);
  Application.ProcessMessages;
end;procedure TfrmServer.IdFTPServer1StoreFile(ASender: TIdFTPServerThread;
  const AFileName: String; AAppend: Boolean; var VStream: TStream);
var
  FileName: String;
begin
  FileName := TransLatePath(AFilename, ASender.HomeDir);
  if FileExists(FileName) and AAppend then
  begin
    VStream := TFileStream.Create(FileName , fmOpenWrite or fmShareExclusive);
    VStream.Seek(0, soFromEnd);
  end
  else
  begin
    VStream := TFileStream.Create(FileName , fmCreate or fmShareExclusive);
    Memo1.Lines.Add('['+ GetNow() + '][系统信息]上传文件' + AFilename);
    Application.ProcessMessages;
  end;
end;procedure TfrmServer.IdFTPServer1MakeDirectory(ASender: TIdFTPServerThread;
  var VDirectory: String);
var
  Folder: String;
begin
  try
    Folder := TransLatePath(VDirectory, ASender.HomeDir);
    if not DirectoryExists(Folder) then
    begin
      MkDir(Folder);
      Memo1.Lines.Add('['+ GetNow() + '][系统信息]创建文件夹' + Folder);
      Application.ProcessMessages;
    end;
  except
    on E:Exception do
    Memo1.Lines.Add('['+ GetNow() + '][系统信息]' + E.Message);
  end;
end;procedure TfrmServer.IdFTPServer1RemoveDirectory(
  ASender: TIdFTPServerThread; var VDirectory: String);
var
  Folder: String;
begin
  try
    Folder := TransLatePath(VDirectory, ASender.HomeDir);
    if not DirectoryExists(Folder) then
    begin
      RmDir(Folder);
      Memo1.Lines.Add('['+ GetNow() + '][系统信息]删除文件夹' + Folder);
      Application.ProcessMessages;
    end;
  except
    on E:Exception do
    Memo1.Lines.Add('['+ GetNow() + '][系统信息]' + E.Message);
  end;
end;