Solved

Indy TFtp Server

Posted on 2004-10-12
4
1,588 Views
Last Modified: 2008-01-09
I am trying to get an answer to the same issue for the last 3 weeks,  I am looking for sample code (that can be
compiled) to setup a simple TFTP or FTP server
0
Comment
Question by:amielDorel
  • 2
4 Comments
 
LVL 6

Expert Comment

by:vadim_ti
ID: 12293667
why Indy
there is really nice free component ICS with a lot of examples

http://www.overbyte.be/frame_index.html
0
 
LVL 17

Accepted Solution

by:
TheRealLoki earned 500 total points
ID: 12294181
here's something that i wrote (added from original demo) to do windows dir listings and file send/receive

unit Unit1;

interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  IdBaseComponent, IdComponent, IdTCPServer, IdFTPList, IdFTPServer,
  StdCtrls, scktcomp;

type
  TfFTPServerMain = class(TForm)
    IdFTPServer1: TIdFTPServer;
    bStartStopServer: TButton;
    mLog: TMemo;
    procedure IdFTPServer1ListDirectory(ASender: TIdFTPServerThread;
      const APath: String; ADirectoryListing: TIdFTPListItems);
    procedure bStartStopServerClick(Sender: TObject);
    procedure IdFTPServer1UserLogin(ASender: TIdFTPServerThread;
      const AUsername, APassword: String; var AAuthenticated: Boolean);
    procedure IdFTPServer1ChangeDirectory(ASender: TIdFTPServerThread;
      var VDirectory: String);
    procedure IdFTPServer1StoreFile(ASender: TIdFTPServerThread;
      const AFileName: String; AAppend: Boolean; var VStream: TStream);
    procedure IdFTPServer1RetrieveFile(ASender: TIdFTPServerThread;
      const AFileName: String; var VStream: TStream);
    procedure IdFTPServer1Connect(AThread: TIdPeerThread);
    procedure IdFTPServer1Disconnect(AThread: TIdPeerThread);
  private
    procedure AddToLog(s: string);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fFTPServerMain: TfFTPServerMain;
function CorrectFTPPath(s: string): string;

IMPLEMENTATION
(* }-=Loki=-{  lokiwashere@yahoo.co.nz   *)
{$R *.DFM}


function CorrectFTPPath(s: string): string;
    begin
        S := StringReplace(S, '//', '\', [rfReplaceAll]);
        S := StringReplace(S, '/', '\', [rfReplaceAll]);
        if ( (S <> '') and (S[1] <> '\') ) then
          S := '\' + S;
        result := s;
    end;

procedure TfFTPServerMain.IdFTPServer1ListDirectory(ASender: TIdFTPServerThread;
    const APath: String; ADirectoryListing: TIdFTPListItems);
    var
        newitem: TIdFTPListItem;
        SearchRec: TSearchRec;
        SearchResult: integer;
        SearchPath: string;
    begin
        AddToLog(ASender.Connection.Socket.Binding.PeerIP + ' - LIST ' + APath);
        SearchPath := CorrectFTPPath(APath);
       
        ADirectoryListing.ListFormat := flfDos;
        SearchResult := FindFirst(SearchPath + '*.*', faAnyFile, SearchRec);
        while SearchResult = 0 do
        begin
            if (SearchRec.Attr and faDirectory) = faDirectory  then
            begin
                newitem := ADirectoryListing.Add;
                newitem.FileName := SearchRec.Name;
                newitem.ItemType := ditDirectory;
                newitem.Size := SearchRec.Size;
                newitem.ModifiedDate := SearchRec.Time;
            end
            else
            begin
                newitem := ADirectoryListing.Add;
                newitem.FileName := SearchRec.Name;
                newitem.ItemType := ditFile;
                newitem.Size := SearchRec.Size;
                newitem.ModifiedDate := SearchRec.Time;
            end;
            SearchResult := FindNext(SearchRec);
        end;
        FindClose(SearchRec);
       
    end;

procedure TfFTPServerMain.bStartStopServerClick(Sender: TObject);
    begin
        IdFTPServer1.Active := (not IdFTPServer1.Active);
        if IdFTPServer1.Active then
        begin
            bStartStopServer.caption := 'Stop Server';
            AddToLog('Started FTP Server');
        end
        else
        begin
            bStartStopServer.caption := 'Start Server';
            AddToLog('Stopped FTP Server');
        end;
    end;

procedure TfFTPServerMain.IdFTPServer1UserLogin(ASender: TIdFTPServerThread;
    const AUsername, APassword: String; var AAuthenticated: Boolean);
    begin
// # Note - do any user authentication here (read user from ini file etc)
        if ( (AUserName = 'ftp') and (APassword = 'ftp') ) then
          AAuthenticated := true;

        if AAuthenticated then
          AddToLog(ASender.Connection.Socket.Binding.PeerIP + ' - LOGIN ' + AUsername)
        else
          AddToLog(ASender.Connection.Socket.Binding.PeerIP + ' - FAILED LOGIN ' + AUsername);
    end;

procedure TfFTPServerMain.IdFTPServer1ChangeDirectory(ASender: TIdFTPServerThread;
    var VDirectory: String);
    begin
        AddToLog(ASender.Connection.Socket.Binding.PeerIP + ' - CD ' + VDirectory);
        VDirectory := StringReplace(VDirectory, '/', '\', [rfReplaceAll]);
    end;

procedure TfFTPServerMain.IdFTPServer1StoreFile(ASender: TIdFTPServerThread;
    const AFileName: String; AAppend: Boolean; var VStream: TStream);
    var
        ActualFilename: string;
    begin
        AddToLog(ASender.Connection.Socket.Binding.PeerIP + ' - PUT ' + AFilename);
        ActualFilename := CorrectFTPPath(AFilename);
        VStream := TFileStream.Create(ActualFilename, fmCreate);
    end;

procedure TfFTPServerMain.IdFTPServer1RetrieveFile(ASender: TIdFTPServerThread;
    const AFileName: String; var VStream: TStream);
    var
        ActualFilename: string;
    begin
        AddToLog(ASender.Connection.Socket.Binding.PeerIP + ' - GET ' + AFilename);
        ActualFilename := CorrectFTPPath(AFilename);
        if FileExists(ActualFilename) then
          VStream := TFileStream.Create(ActualFilename, fmOpenRead+fmShareDenyNone);
    end;

procedure TfFTPServerMain.IdFTPServer1Connect(AThread: TIdPeerThread);
begin
    AddToLog(AThread.Connection.Socket.Binding.PeerIP + ' - Connected');
end;

procedure TfFTPServerMain.IdFTPServer1Disconnect(AThread: TIdPeerThread);
begin
    if assigned(AThread.Connection.Socket.Binding) then
      AddToLog(AThread.Connection.Socket.Binding.PeerIP + ' - Disconnected')
    else
      AddToLog('Remote client disconnected')
end;

procedure TfFTPServerMain.AddToLog(s: string);
    begin
        mLog.Lines.Add(FormatDateTime('dd"-"mmm"-"yyyy" "hh":"nn":"ss" "', Now) + S);
        mLog.Perform(EM_SCROLL,SB_LINEDOWN,0);
        while mLog.Lines.Count > 500 do mLog.Lines.Delete(0);
    end;

end.


// FORM FOLLOWS

object fFTPServerMain: TfFTPServerMain
  Left = 247
  Top = 230
  Width = 575
  Height = 391
  Caption = '}=-Loki=-{ FTP Server example (lokiwashere@yahoo.co.nz)'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object bStartStopServer: TButton
    Left = 8
    Top = 8
    Width = 75
    Height = 25
    Caption = 'Start Server'
    TabOrder = 0
    OnClick = bStartStopServerClick
  end
  object mLog: TMemo
    Left = 8
    Top = 48
    Width = 537
    Height = 297
    ScrollBars = ssBoth
    TabOrder = 1
  end
  object IdFTPServer1: TIdFTPServer
    Bindings = <>
    CommandHandlers = <>
    DefaultPort = 21
    Greeting.NumericCode = 220
    Greeting.Text.Strings = (
      'Indy FTP Server ready.')
    Greeting.TextCode = '220'
    MaxConnectionReply.NumericCode = 0
    OnConnect = IdFTPServer1Connect
    OnDisconnect = IdFTPServer1Disconnect
    ReplyExceptionCode = 0
    ReplyTexts = <>
    ReplyUnknownCommand.NumericCode = 500
    ReplyUnknownCommand.Text.Strings = (
      'Syntax error, command unrecognized.')
    ReplyUnknownCommand.TextCode = '500'
    AnonymousAccounts.Strings = (
      'anonymous'
      'ftp'
      'guest')
    EmulateSystem = ftpsOther
    SystemType = 'WIN32'
    OnChangeDirectory = IdFTPServer1ChangeDirectory
    OnUserLogin = IdFTPServer1UserLogin
    OnListDirectory = IdFTPServer1ListDirectory
    OnRetrieveFile = IdFTPServer1RetrieveFile
    OnStoreFile = IdFTPServer1StoreFile
    Left = 384
    Top = 24
  end
end
0
 

Author Comment

by:amielDorel
ID: 12300831
I have tried using the ICS ftpserver smaple however, when I bring the sample up, the first thing I get is TftpServer calss can't be found.   how do I continue ?

Thanks
0
 
LVL 6

Expert Comment

by:vadim_ti
ID: 12302414
i think you do not install components.
do you have "fpiette" tab on components palette?
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Mydac connection data base issue 3 166
When I am typing into a TEdit last word repeats 7 145
Press three keys together and trigger a function 3 60
creating threads in delphi 1 132
A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
In an interesting question (https://www.experts-exchange.com/questions/29008360/) here at Experts Exchange, a member asked how to split a single image into multiple images. The primary usage for this is to place many photographs on a flatbed scanner…
I've attached the XLSM Excel spreadsheet I used in the video and also text files containing the macros used below. https://filedb.experts-exchange.com/incoming/2017/03_w12/1151775/Permutations.txt https://filedb.experts-exchange.com/incoming/201…

860 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question