Question

我使用Tidtrivialftpserver和Tidtrivialftp通过LAN传输文件。我尝试了示例代码并且工作正常但是Tidtrivialftpserver只是开始编写文件，我想实现一个savedialog框，以便我可以将它保存在我想要的位置。我尝试了以下但是它将文件写入当前目录。此外，我不相信serverWriteFile中的这一行（AStream：= FS），因为当我调试此代码Astream给出nil但仍然写入文件。怎么样？

var 
  file1: string;
  FS: tfilestream;

procedure TForm2.saveClick(Sender: TObject);
begin
  if savedialog1.Execute then
  begin
   savedialog1.FileName:= file1;
    FS := TFileStream.Create(FileName,
    fmCreate or fmShareExclusive);
  end;
end;   

procedure TForm2.serverWriteFile(Sender: TObject; var FileName: string;
  const PeerInfo: TPeerInfo; var GrantAccess: Boolean; var AStream: TStream;
  var FreeStreamOnComplete: Boolean);
begin
  try
    Memo1.Lines.Add('started writing files...');
    file1 := ExtractFileName(Filename);
    { Open file in WRITE ONLY mode }
    //  FS := TFileStream.Create(FileName,
    //  fmCreate or fmShareExclusive);
    { Copy all the data }
    AStream := FS;
    { Set parameters }
    FreeStreamOnComplete := True;
    GrantAccess := True;
  except
    { On errors, deny access }
    GrantAccess := False;
    if Assigned(FS) then
    FreeAndNil(FS);
  end;
end;

Answer 1

OnWriteFile事件的目的是要求获得接收文件的权限（GrantAccess，默认为True）并获取TStream以接收文件数据（AStream，默认为零）。在事件处理程序首先退出之前，TIdTrivialFTPServer无法接收数据。如果您未提供TStream，但将GrantAccess设置为True，TIdTrivialFTPServer将使用当前TFileStream在内部创建自己的FileName。因此，如果您不想接收该文件，则必须将GrantAccess设置为False。如果要提示用户，则必须在OnWriteFile事件处理程序内执行此操作（如果TIdTrivialFTPServer.ThreadEvent属性为False，则只能直接执行此操作，否则需要与主线程同步安全地做出提示），例如：

procedure TForm2.serverWriteFile(Sender: TObject; var FileName: string;
  const PeerInfo: TPeerInfo; var GrantAccess: Boolean; var AStream: TStream;
  var FreeStreamOnComplete: Boolean);
begin
  SaveDialog1.FileName := ExtractFileName(FileName);
  if SaveDialog1.Execute then
  begin
    // let TIdTrivialFTPServer create the TFileStream internally...
    FileName := SaveDialog1.FileName;
    Memo1.Lines.Add('started writing file...');
  end else
    GrantAccess := False;
end;

TIdtrivialftp的P2P文件传输

1 个答案: