indy ftp server

...unit1.pas...
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,  StrUtils, IdThreadMgr, IdThreadMgrDefault, IdUserAccounts,
  IdBaseComponent, IdComponent, IdTCPServer, IdFTPServer, IdFTPList, StdCtrls,
  OleCtrls, SHDocVw, FileCtrl;

type
  TForm1 = class(TForm)
    IdFTPServer1: TIdFTPServer;
    IdUserManager1: TIdUserManager;
    FileListBox1: TFileListBox;
    IdThreadMgrDefault1: TIdThreadMgrDefault;
    WebBrowser1: TWebBrowser;
    FileListBox2: TFileListBox;
    Memo1: TMemo;
    Edit1: TEdit;
    Memo2: TMemo;
    procedure IdFTPServer1ListDirectory(ASender: TIdFTPServerThread;
      const APath: String; ADirectoryListing: TIdFTPListItems);
    procedure FormCreate(Sender: TObject);
    procedure IdFTPServer1ChangeDirectory(ASender: TIdFTPServerThread;
      var VDirectory: String);
    procedure FileListBox1Change(Sender: TObject);
    procedure IdFTPServer1GetFileSize(ASender: TIdFTPServerThread;
      const AFilename: String; var VFileSize: Int64);
    procedure IdFTPServer1RetrieveFile(ASender: TIdFTPServerThread;
      const AFileName: String; var VStream: TStream);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;
implementation

{$R *.dfm}

procedure TForm1.IdFTPServer1ListDirectory(ASender: TIdFTPServerThread;
  const APath: String; ADirectoryListing: TIdFTPListItems);
var
  buf, FSize : Integer;
  FName, FDate : String;
  F : file of byte;
begin
  Memo1.Clear;
  FileListBox1.Directory := APath;
  ASender.CurrentDir := '';
  ADirectoryListing.ListFormat := flfDos;
  for buf := 0 to FileListBox1.Items.Count -1 do
    begin
    FName := APath + FileListBox1.Items.Strings[Buf];
    AssignFile(F, FName);
    Reset(F);
    FSize := FileSize(F);
    CloseFile(F);
    FDate := FormatDateTime('mm/dd/yy hh:nn',FileDateToDateTime(FileAge(FName)));
    Memo1.Lines.Add(FDate + ' ' + IntToStr(FSize) + ' ' + FileListBox1.Items.Strings[buf]);
    end;
  Memo2.Clear;
  for buf := 0 to FileListBox2.Items.Count -1 do
    begin
      Edit1.Clear;
      Edit1.Text := FileListBox2.Items.Strings[Buf];
      Edit1.SelStart := 0;
      Edit1.SelLength := 1;
      Edit1.ClearSelection;
      Edit1.SelStart := Length(Edit1.Text) - 1;
      Edit1.SelLength := 1;
      Edit1.ClearSelection;
      if (Edit1.Text <> '.') and (Edit1.Text <> '..') then
        Memo2.Lines.Add(Edit1.Text);
    end;
    for buf := 0 to Memo2.Lines.Count - 1 do
        begin
          FDate := '01-01-01 00:00';
          Memo1.Lines.Add(FDate + ' <DIR> ' + Memo2.Lines.Strings[buf]);
        end;
  ADirectoryListing.LoadList(Memo1.Lines);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  WebBrowser1.Navigate('ftp://127.0.0.1');
end;

procedure TForm1.IdFTPServer1ChangeDirectory(ASender: TIdFTPServerThread;
  var VDirectory: String);
begin
  ASender.CurrentDir := VDirectory;
end;

procedure TForm1.FileListBox1Change(Sender: TObject);
begin
  FileListBox2.Directory := FileListBox1.Directory;
end;

procedure TForm1.IdFTPServer1GetFileSize(ASender: TIdFTPServerThread;
  const AFilename: String; var VFileSize: Int64);
var
  F : File of Byte;
begin
  AssignFile(F, AFileName);
  Reset(F);
  VFileSize := FileSize(F);
  CloseFile(F);
end;

procedure TForm1.IdFTPServer1RetrieveFile(ASender: TIdFTPServerThread;
  const AFileName: String; var VStream: TStream);
begin
  VStream := TFileStream.Create(AFileName,fmOpenRead);
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  idFTPServer1.Threads.Clear;
end;

end.

...Unit1.dfm...
object Form1: TForm1
  Left = 211
  Top = 107
  Width = 640
  Height = 433
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCloseQuery = FormCloseQuery
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object FileListBox1: TFileListBox
    Left = 0
    Top = 8
    Width = 169
    Height = 153
    ItemHeight = 13
    TabOrder = 0
    OnChange = FileListBox1Change
  end
  object WebBrowser1: TWebBrowser
    Left = 184
    Top = 8
    Width = 441
    Height = 393
    TabOrder = 1
    ControlData = {
      4C000000942D00009E2800000000000000000000000000000000000000000000
      000000004C000000000000000000000001000000E0D057007335CF11AE690800
      2B2E126208000000000000004C0000000114020000000000C000000000000046
      8000000000000000000000000000000000000000000000000000000000000000
      00000000000000000100000000000000000000000000000000000000}
  end
  object FileListBox2: TFileListBox
    Left = 0
    Top = 176
    Width = 169
    Height = 65
    FileType = [ftDirectory]
    ItemHeight = 13
    TabOrder = 2
  end
  object Memo1: TMemo
    Left = 0
    Top = 248
    Width = 169
    Height = 129
    Lines.Strings = (
      '07/02/01  10:01 <DIR> Test'
      '05/06/03  1:23 612 test.txt')
    ScrollBars = ssBoth
    TabOrder = 3
  end
  object Edit1: TEdit
    Left = 0
    Top = 384
    Width = 121
    Height = 21
    TabOrder = 4
    Text = 'Edit1'
  end
  object Memo2: TMemo
    Left = 0
    Top = 292
    Width = 185
    Height = 69
    Lines.Strings = (
      'Memo2')
    ScrollBars = ssBoth
    TabOrder = 5
  end
  object IdFTPServer1: TIdFTPServer
    Active = True
    Bindings = <>
    CommandHandlers = <>
    DefaultPort = 21
    Greeting.NumericCode = 220
    Greeting.Text.Strings = (
      'Serveur FTP Indy prêt.')
    Greeting.TextCode = '220'
    MaxConnectionReply.NumericCode = 0
    ReplyExceptionCode = 0
    ReplyTexts = <>
    ReplyUnknownCommand.NumericCode = 500
    ReplyUnknownCommand.Text.Strings = (
      'Erreur de syntaxe, commande non reconnue.')
    ReplyUnknownCommand.TextCode = '500'
    ThreadMgr = IdThreadMgrDefault1
    AnonymousAccounts.Strings = (
      'anonymous'
      'ftp'
      'guest')
    HelpReply.Strings = (
      'FTP Server by LunaticSkunk')
    UserAccounts = IdUserManager1
    SystemType = 'WIN32'
    OnChangeDirectory = IdFTPServer1ChangeDirectory
    OnGetFileSize = IdFTPServer1GetFileSize
    OnListDirectory = IdFTPServer1ListDirectory
    OnRetrieveFile = IdFTPServer1RetrieveFile
    Left = 258
    Top = 242
  end
  object IdUserManager1: TIdUserManager
    Accounts = <
      item
        UserName = 'User'
        Password = '1234'
      end>
    CaseSensitiveUsernames = False
    CaseSensitivePasswords = False
    Left = 194
    Top = 238
  end
  object IdThreadMgrDefault1: TIdThreadMgrDefault
    Left = 222
    Top = 240
  end
end