Mega Code Archive
Complete TFTP Server example, using Indy components
<![CDATA[
Title: Complete TFTP Server example, using Indy components
Question: There are not many good TFTP server examples out there, so I wrote this example of a multi-thredded TFTP Server, using Indy components.
Answer:
There are few good examples of TFTP servers, so I
wrote this complete server as an example.
If works like a Secure TFTP server, since it only
allows uploads/downloads from a specific directory.
The example assumes that you open a new project with
a new form (Form1), and drop one TFTP Server and TFTP
Client on the form, and two buttons.
The source below can be copied as such. Enjoy.
-----CUT-----CUT-----CUT-----CUT-----CUT-----CUT-----CUT-----
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer,
IdTrivialFTPServer, StdCtrls, IdUDPClient, IdTrivialFTP;
type
TForm1 = class(TForm)
IdTrivialFTPServer1: TIdTrivialFTPServer;
IdTrivialFTP1: TIdTrivialFTP;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure IdTrivialFTPServer1ReadFile(Sender: TObject;
var FileName: String; const PeerInfo: TPeerInfo;
var GrantAccess: Boolean; var AStream: TStream;
var FreeStreamOnComplete: Boolean);
procedure IdTrivialFTPServer1TransferComplete(Sender: TObject;
const Success: Boolean; const PeerInfo: TPeerInfo; AStream: TStream;
const WriteOperation: Boolean);
procedure IdTrivialFTPServer1WriteFile(Sender: TObject;
var FileName: String; const PeerInfo: TPeerInfo;
var GrantAccess: Boolean; var AStream: TStream;
var FreeStreamOnComplete: Boolean);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
TFTPPath : String;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
IdTrivialFTPServer1.ThreadedEvent := True;
IdTrivialFTPServer1.Active := True;
{ Set the path to where the files will be stored/retreived }
TFTPPath := IncludeTrailingPathDelimiter('C:\Temp');
end;
procedure TForm1.IdTrivialFTPServer1ReadFile(Sender: TObject;
var FileName: String; const PeerInfo: TPeerInfo;
var GrantAccess: Boolean; var AStream: TStream;
var FreeStreamOnComplete: Boolean);
Var
FS : TFileStream;
begin
FreeStreamOnComplete := True;
Try
{ Convert UNIX style filenames to WINDOWS style }
While Pos('/',Filename)0 do Filename[Pos('/',Filename)] := '\';
{ Assure that the filename DOES NOT CONTAIN any path information }
Filename := ExtractFileName( Filename );
{ Check if file exists }
If FileExists( TFTPPath+Filename ) then
Begin
{ Open file in READ ONLY mode }
FS := TFileStream.Create( TFTPPath+Filename,
fmOpenRead OR fmShareDenyWrite );
{ Assign stream to variable }
AStream := FS;
{ Set parameters }
GrantAccess := True;
End Else
Begin
GrantAccess := False;
End;
Except
{ On errors, deny access }
GrantAccess := False;
If Assigned(FS) then FreeAndNil( FS );
End;
end;
procedure TForm1.IdTrivialFTPServer1WriteFile(Sender: TObject;
var FileName: String; const PeerInfo: TPeerInfo;
var GrantAccess: Boolean; var AStream: TStream;
var FreeStreamOnComplete: Boolean);
Var
FS : TFileStream;
begin
Try
{ Convert UNIX style filenames to WINDOWS style }
While Pos('/',Filename)0 do Filename[Pos('/',Filename)] := '\';
{ Assure that the filename DOES NOT CONTAIN any path information }
Filename := ExtractFileName( Filename );
{ Open file in WRITE ONLY mode }
FS := TFileStream.Create( TFTPPath+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;
procedure TForm1.IdTrivialFTPServer1TransferComplete(Sender: TObject;
const Success: Boolean; const PeerInfo: TPeerInfo; AStream: TStream;
const WriteOperation: Boolean);
begin
// Success = TRUE if the read/write operation was successfull
// WriteOperation = TRUE if the client SENT a file to the server
Try
{ Close the FileStream }
If Assigned(AStream) then FreeAndNil(AStream);
Except
End;
end;
// Example of how to DOWNLOAD a file from the server
procedure TForm1.Button1Click(Sender: TObject);
Var
ST : TMemoryStream;
begin
ST := TMemoryStream.Create;
IdTrivialFTP1.Get('testfile.dat',ST);
If Assigned(ST) then
begin
ShowMessage('Filesize='+IntToStr(ST.Size));
FreeAndNil(ST);
end;
end;
// Example of how to UPLOAD a file to the server
procedure TForm1.Button2Click(Sender: TObject);
Var
ST : TMemoryStream;
I : Integer;
S : String;
begin
{ Create stream }
ST := TMemoryStream.Create;
{ Initialize data }
S := 'This is a test file. It whould appear in the '+
'TFTP Server''s upload directory.'+#13#10;
{ Store in stream }
ST.Write( S[1], Length(S) );
ST.Position := 0;
{ Send Stream to TFTP Server }
IdTrivialFTP1.Put(ST,'textfile.txt');
{ Free Stream }
If Assigned(ST) then FreeAndNil(ST);
{ Show a dialog }
ShowMessage('Done!');
end;
end.
]]>