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.
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.
Now will continue with Send FIles using FTP.
After HTTP, FTP is possibly the most used protocols. It allows files to be transferred to and from FTP servers. The only disadvantage with using FTP is that the username and password are sent unencrypted in plain text. Even Internet Explorer can handle FTP.
The FTP protocol is reasonably easy to implement if you know how to use Winsock, but it has already been done by many people so this is probably one wheel you do NOT need to reinvent. The following list includes source code and they are free. ICS (Francois Piette’s superb library at (http://overbyte.delphicenter.com/frame_index.htmlhttp://overbyte.delphicenter.com/frame_index.html), Winshoes or Indy as it is now known (and soon to be included in Delphi 6 I believe) at http://www.nevrona.com/Indy/http://www.nevrona.com/Indy/ and MonsterFtp which is on www.torry.nethttp://www.torry.net on the Internet part of the VCL section under FTP.
Of these I tried Monster FTP but found a bug using it within a firewall, but Winshoes version 7 (8 is now being released as Indy) worked fine and the code shown below shows just how simple it is to upload files using the FTP. I haven’t tried ICS or any other kits so apologies if I overlooked any.
For any FTP account you need the following:
Username
Password
Server URL (ftp:// …) or IP Address
And optionally, a folder to change to, after the connection is established.
In the code below, ftpObject is a Winshoes TSimpleFTPObject.FtpUpload is a record or class containing Server (Ip Address or Name), Username, Password, Timeout (in milliseconds) and optionally Directory (to change into). The file transferred is passed in as FilenametoSend.Just add your own error Procedure to deal with errors.
Depending on the type of file transferred you may wish to transfer files as binary or as Ascii. The only difference is that Ascii transferred files have Carriage Return/Line Feeds added or stripped (according to direction of flow) if between Unix systems and Windows.
Note this needs to be slotted into a procedure or Method.
FtpObject.Hostname := FtpUpload.Server;
FtpObject.Username := FtpUpload.Username;
FtpObject.Password := FtpUpload.Password;
Ftpobject.ConnectTimeout := Ftpupload.Timeout * 1000;
if not FTPObject.Connect then
begin
Error('failed to connect to server');
exit;
end;
except
on E: Exception do
begin
Error(Format('Failed to connect to FTP server %s', [FTPUpload.Server]));
EXIT;
end;
end;
{ Change Working Directory }
try
if FtpUpload.Directory '' then
FtpObject.ChangeRemoteDir(FtpUpload.Directory);
except
on E: Exception do
begin
Error(Format('Failed to switch to FTP folder %s', [FtpUpload.Directory]));
EXIT;
end;
end;
//FTPObject.Mode(MODE_BYTE);
FTPObject.Transfertype := ttBinary;
LocalFile := CommonExportFolder + FTPUpload.FileNameToSend;
{ Includes date/time in remote file name to keep name unique on a resend }
RemoteFile := Prefix + FormatDateTime('yyyymmddhhnnss', now) + NameList[i];
try
FTpObject.PutQualifiedFile(LocalFile, RemoteFile);
except
Error('Failed Copying File ' + Localfile + ' To ' + Remotefile);
end;
Component Download: http://www.nevrona.com/Indy/http://www.nevrona.com/Indy/
