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;
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;