Solved

Indy TFtp Server

Posted on 2004-10-12
4
1,610 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

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

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…
Have you ever had your Delphi form/application just hanging while waiting for data to load? This is the article to read if you want to learn some things about adding threads for data loading in the background. First, I'll setup a general applica…
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…
Finding and deleting duplicate (picture) files can be a time consuming task. My wife and I, our three kids and their families all share one dilemma: Managing our pictures. Between desktops, laptops, phones, tablets, and cameras; over the last decade…

751 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