Search code examples
delphidelphi-xe3indy10

P2P file transfer by TIdtrivialftp


I am transferring files over LAN using Tidtrivialftpserver and Tidtrivialftp. I tried the example code and is working fine but Tidtrivialftpserver just starts writing file ,i want to implement a savedialog box so that i can save it on my desired location.i tried following but it writes file in the current directory. Also i am not convinced with this line (AStream := FS) in serverWriteFile because when i debug this code Astream gives nil but still it writes file. How?

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;

Solution

  • The purpose of the OnWriteFile event is to ask for permission to receive a file (GrantAccess, which is True by default) AND to obtain a TStream to receive the file data into (AStream, which is nil by default). TIdTrivialFTPServer cannot receive the data until the event handler exits first. If you do not provide a TStream, but do set/leave GrantAccess to True, TIdTrivialFTPServer will create its own TFileStream internally using the current FileName. So if you do not want to receive the file, you must set GrantAccess to False. If you want to prompt the user, you must do so inside of the OnWriteFile event handler (which is only safe to do directly if the TIdTrivialFTPServer.ThreadEvent property is False, otherwise you need to sync with the main thread to do the prompt safely), eg:

    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;