Delphi 7 : Réaliser un Client FTP à l'aide des composants Indy

Sources du projet : Indyftpsrc.zip (5.24 ko)

FTP (File Transfert Protocol) est un protocole de transfert de fichiers utilisé sur Internet pour envoyer et recevoir des fichiers, mais aussi pour gérer des répertoires distants. Le protocole FTP est généralement utilisé pour la distribution de logiciels, pour l'envoi de fichiers sur un serveur web, ou encore pour mettre à jour votre site web personnel.

Nous allons voir dans cet article comment se connecter à un serveur FTP et manipuler les commandes de base, telles qu'afficher le contenu d'un répertoire distant et télécharger des fichiers. Mais avant de se connecter à un serveur, il faut tout d'abord savoir qu'un serveur demande toujours une authentification, constituée d'un nom d'utilisateur et d'un mot de passe.

Il existe de nombreux serveurs FTP anonymes, où il suffit de mettre « anonymous » comme nom d'utilisateur et de rentrer votre adresse e-mail comme mot de passe. Les serveurs anonymes ne vous permettent généralement pas l'envoi de fichiers, mais uniquement la réception.

Ensuite, la plupart des serveurs FTP utilisent les conventions UNIX et le système ext2fs pour la gestion des fichiers, c'est-à-dire que le séparateur de répertoires est le slash ( / ), qu'il y a une différence entre les minuscules et les majuscules, et que les fichiers ont des droits d'utilisation pour chaque type d'utilisateurs, contrairement à la gestion de fichiers sous Windows9x où tous les fichiers sont accessibles par tous les utilisateurs.

Enfin, il faut savoir que la plupart des serveurs FTP utilisent le Port 21. Un port est en fait une sorte de passerelle pour les données. Les données peuvent être reçues sous forme de texte ou sous forme binaire.

Pour avoir plus de détails sur le protocole FTP, vous trouverez la spécification complète à l'adresse suivante: http://www.eisti.fr/res/res/rfc959/959tm_inter_fr.dim?x=inter&l=fr

Créez une nouvelle application, et posez un composant « TIdFTP » (onglet « Indy Clients ») sur votre fiche. Vous voyez que par défaut le n° de port est réglé sur 21.

Par défaut, le composant TIdFTP prend le contrôle de l'application entière quand il est en action, ou plutôt quand on lui soumet une commande. Pour plus de confort, nous préfèrerons pouvoir utiliser l'application pendant les transferts. Pour cela, il nous faut placer un composant TIdAntiFreeze (onglet « Indy Divers »). Réglez sa propriété IdleTimeOut sur « 50 », et enfin sa propriété OnlyWhenIdle sur « False ».

Posez aussi sur votre fiche un TGroupBox dont le Caption sera « Connexion Serveur », trois TLabel, trois TEdit, et deux boutons. Le premier TLabel aura pour Caption « Serveur », le 2°, « Nom d'utilisateur » et le 3°, « Mot De Passe ». Les trois TEdit auront pour Text « ftp.borland.com », « anonymous », et « mail@server.com ». Le 3° TEdit aura pour PassWordChar l'étoile « * ». Enfin, les deux boutons auront pour texte « Connecter » et « Déconnecter ».

Posez à présent sur votre fiche un autre TGroupBox dont le Caption sera « Gestion Fichiers », deux TLabel (dont les Captions seront « Répertoire Distant » et « Fichier Sélectionné »), un TEdit avec la propriété Ctl3D sur « false », la propriété ReadOnly sur « true » et le Text sur « / », et un TMemo vide avec la propriété Ctl3D sur « false », la propriété ReadOnly sur « true » , et la propriété WordWrap sur « false » et videz le texte de la propriété Lines. Posez un TSpeedButton à côté du TEdit, avec la propriété Flat sur « true », et une icône de flèche vers le haut, qui servira à revenir au répertoire parent. Enfin, posez un autre TSpeedButton à côté du TMemo, avec une icône d'annulation et sa propriété Flat sur « true », ainsi que sa propriété Visible sur true, qui servira de bouton d'annulation du téléchargement…

Le FTP à la particularité de donner de nombreuses informations d'état sur les commandes que nous lui envoyons. Pour les afficher, posez un troisième TGroupBox sur votre fiche, dont le Caption sera « Etat », avec un TMemo vide à l'intérieur, dont la propriété ReadOnly sera sur « true ». Ce TMemo servira à afficher les informations de connexion, et les résultats des opérations sur les fichiers.

La finalité du protocole FTP est la gestion de fichiers. Pour afficher la liste des fichiers sur le serveur, placez un quatrième TGroupBox sur votre fiche, dont le Caption sera « Liste des Fichiers », et mettez un TListBox à l'intérieur.

Bien sûr, si nous exécutons le projet à ce stade, rien ne se passera… nous allons donc établir la connexion. Mais avant cela, rappelons-nous que nous avons posé un composant TIdAntiFreeze pour pouvoir continuer à manipuler l'application pendant les transferts. Seulement voilà, le composant FTP ne peut gérer qu'un transfert à la fois. Pour éviter de cliquer par mégarde sur un bouton de commande pendant un transfert, nous allons écrire une procédure qui désactivera tous les boutons pendant les transferts :

procedure TForm1.EnableControls(Enable: boolean);
begin
  Button1.Enabled := Enable;
  Button2.Enabled := Enable and IdFTP1.Connected;
  SpeedButton1.Enabled := Enable and IdFTP1.Connected;
  ListBox1.Enabled := Enable and IdFTP1.Connected;
end;

Maintenant, nous pouvons nous connecter en étant sûr d'éviter les problèmes. Pour se connecter, il faut choisir un serveur, et donner son nom d'utilisateur et son mot de passe. Mettez le code suivant dans l'événement OnClick du bouton « Connecter » :

procedure TForm1.Button1Click(Sender: TObject);
begin
  if IdFTP1.Connected then IdFTP1.Disconnect;
  try
    EnableControls(false);
    IdFTP1.Host := Edit1.Text;
    IdFTP1.UserName := Edit2.Text;
    IdFTP1.Password := Edit3.Text;
    IdFTP1.Connect;
  finally
    EnableControls(true);
  end;
end;

et le code suivant dans l'événement OnClick du bouton « Déconnecter »

procedure TForm1.Button2Click(Sender: TObject);
begin
  if IdFTP1.Connected then IdFTP1.Disconnect;
end;

Jusque là, rien de sorcier. Si vous exécutez le projet à ce stade, quand vous vous connecterez, vous n'aurez aucun signe pour savoir si votre connexion a réussi ou pas, et d'ailleurs vous ne saurez rien du tout. C'est pour cette raison que nous avons placé un TMemo pour afficher l'état de la connexion. Sélectionnez le composant TIdFTP, et mettez le code suivant dans l'événement OnStatus :

procédure TForm1.IdFTP1Status(axSender: TObject; const axStatus: TIdStatus;
  const asStatusText: String);
begin
  Memo2.Lines.Add(asStatusText);
end;

À présent, si vous vous connectez et que vous lancez le projet, vous aurez déjà des informations sur la connexion quand vous l'établirez. Mais bon, l'intérêt est quand même assez limité, vu que la raison d'être du protocole FTP est la gestion des fichiers. Il est donc temps de s'y attaquer.

Rajoutez la ligne suivante à la fin du code de l'événement OnClick du bouton « Connecter », juste avant le finally. Le try..except est utilisé ici pour éviter d'afficher les messages d'erreurs en cas d'interruption de transfert :

if idFTP1.Connected then
    try
      IdFTP1.List(ListBox1.Items);
    except;
    end;

et mettez le code suivant dans l'événement OnDisconnected du TidFTP :

procedure TForm1.IdFTP1Disconnected(Sender: TObject);
begin
  ListBox1.Clear;
  EnableControls(true);
end;

À présent, si vous lancez le projet, lors de votre connexion, vous obtiendrez la liste des fichiers et dossiers situés à la racine du serveur distant. Malheureusement, pour l'instant, il est impossible de changer de répertoire, on est cantonné à cette liste, assez complexe par ailleurs, qui peut se présenter sous les formes suivantes :

exemple de résultat sur un serveur UNIX/ext2fs

drwx------  2   ftpuser  ftpusers  512   Nov 23 1998    lost+found
drwxr-xr-x  19  ftpuser  ftpusers  1024  Jun 5 14:17    pub
lrwxrwxrwx  1   root     root      14    Jun 25 07:54   DIRS.byname -> ../DIRS.byname

exemple de résultat sur un serveur Windows

05-30-01  10:01AM   <DIR>     demos
04-04-00  02:15PM   2733901   force_commander.mov

Ce sont des entrées dont les champs sont séparés par des espaces. Il est important de bien comprendre la signification de chaque champ, pour pouvoir continuer notre programme. Voici donc leur description.

drwx------  2   ftpuser  ftpusers  512   Nov 23 1998    lost+found
drwxr-xr-x  19  ftpuser  ftpusers  1024  Jun 5 14:17    pub
lrwxrwxrwx  1   root     root      14    Jun 25 07:54   DIRS.byname -> ../DIRS.byname

Le premier champ d'une entrée ext2fs est constitué de dix caractères, qui désignent les autorisations pour les fichiers, plus les attributs :

• le premier caractère peut être soit

  1. un tiret « - », l'entrée correspondra à un fichier,
  2. un d, l'entrée correspondra à un répertoire (directory),
  3. un l, l'entrée correspondra à un lien symbolique (link).

En effet, sous Unix, on peut établir des liens symboliques pour n'importe quel fichier ou répertoire, c'est-à-dire qu'on peut créer un fichier virtuel (le lien), qui, lorsqu'on l'ouvrira, pointera vers le fichier réel (la cible), au contraire de Windows, où on ne peut établir des liens aussi poussés. Par exemple, si sous Windows vous créez un raccourci dans le répertoire C:\ vers le répertoire C:\windows\system, et que vous nommez ce raccourci « lien », vous ne pourrez pas utiliser la commande
« copy c:

etlog.txt lien

etlog.txt »
et vous obtiendrez une erreur, car "lien" n'est pas un vrai lien symbolique, alors que sous Linux les liens symboliques permettent ce genre de manipulation ;

• ensuite, nous avons une chaîne de type rwxrwxrwx, en fait constituée de trois groupes rwx, qui correspondent à des autorisations d'accès aux fichiers. Si une lettre est remplacée par un tiret "-", c'est que l'autorisation n'a pas été donnée.
  Voici la désignation des trois lettres rwx de chaque groupe :

  1. la lettre r désigne une autorisation de lecture (read),
  2. la lettre w désigne une autorisation d'écriture (write),
  3. la lettre x désigne une autorisation d'exécution (eXecute) du fichier.

  Maintenant, la désignation des trois groupes :

  1. le groupe de gauche concerne le propriétaire du fichier (user),
  2. le groupe du milieu concerne les utilisateurs appartenant au même groupe que le propriétaire du fichier (group),
  3. le groupe de droite concerne tous les autres utilisateurs (other).

Ainsi, sur l'exemple donné ci-dessus, le répertoire lost+found n'est accessible que par son créateur, il nous est même impossible de regarde le contenu, tandis que le répertoire pub est accessible par tout le monde en lecture ;

• le 2° champ désigne le nombre de liens à ce fichier ;
• le 3° champ désigne le propriétaire (user) du fichier ;
• le 4° champ désigne le groupe (group) du fichier ;
• le 5° champ désigne la taille en octets du fichier ;

• le 6° champ désigne la date de dernière modification, constituée de trois champs séparés par des espaces :

  1. le mois de modification,
  2. le jour de modification,
  3. soit l'heure au format HH:MM, soit l'année au format AAAA ;
• le 7° et dernier champ désigne le nom du fichier.

Les entrées correspondant à un lien sont légèrement différentes :

lrwxrwxrwx  1   root     root      14    Jun 25 07:54   DIRS.byname -> ../DIRS.byname

Les six premières entrées sont identiques aux entrées standard ext2fs, mais la dernière entrée est constituée de trois champs, séparés par des espaces :

1. le nom du lien ;
2. la chaîne "→" ;
3. la cible du lien.

À noter: la cible du lien n'existe pas forcément, tout comme les liens sur les pages HTML, on peut mettre n'importe quel texte ne comportant pas d'espace dans la cible…

05-30-01  10:01AM   <DIR>     demos
 
04-04-00  02:15PM   2733901   force_commander.mov

Les entrées Windows, qui utilisent la FAT, sont constituées de quatre champs :

1. la date de modification, au format MM:JJ:AA ;
2. l'heure de modification, au format HH:MM en mode 12 heures, suivi de AM ou PM selon ;
3. la chaîne <DIR> s'il s'agit d'un répertoire ;
4. la taille en octets s'il s'agit d'un fichier ;
5. le nom de répertoire ou de fichier, qui peut contenir des espaces…

Il n'existe pas de liens symboliques ni de droits d'accès sur les serveurs Windows.

Maintenant que nous connaissons la signification complète des résultats renvoyés par la commande List, nous pouvons analyser les entrées pour naviguer parmi les répertoires. Comme les entrées d'un serveur Windows sont très différentes des entrées d'un serveur UNIX, il serait judicieux de déterminer à quel type de serveur on se connecte.

Définissons tout d'abord un type qui servira à choisir le serveur :

type
  TFTPServerType = (ftpUnix, ftpWindows);

Définissons une variable globale de type TFTPServerType :

var
  FTPServerType: TFTPServerType

Le seul moyen que nous ayons pour l'instant de déterminer le type de serveur est de regarder le nombre d'espaces dans les entrées : un serveur Windows en génère trois, alors qu'un serveur Unix en génère huit. Par conséquent, on peut dire qu'un serveur dont les entrées contiennent plus de quatre espaces est un serveur Unix. Écrivons la procédure correspondante :

procedure TForm1.GetServerType(const ServerEntry: string);
var
  s: string;
begin
  s := Trim(ServerEntry);
  s := Trim(Copy(s, Pos(' ', s) + 1, Length(s)));
  s := Trim(Copy(s, Pos(' ', s) + 1, Length(s)));
  s := Trim(Copy(s, Pos(' ', s) + 1, Length(s)));
  FTPServerType := TFTPServerType(Pos(' ', s) = 0);
end;

Enfin, pour déterminer le type de serveur, nous ne pouvons malheureusement pas choisir la première ou la dernière entrée, car certains serveurs ajoutent des commentaires en début et/ou en fin de liste, ce qui empêche d'analyser ces commentaires comme des entrées. Nous analyserons donc les entrées à chaque clic…

Il nous faut d'abord écrire une fonction qui détermine si une entrée est un répertoire, une 2° fonction qui détermine si on a accès à ce répertoire ou pas, et enfin une 3° fonction qui détermine le nom du fichier/répertoire correspondant à l'entrée. Comme les entrées d'un serveur Unix sont différentes de celles d'un serveur Windows, il faut écrire, pour chaque fonction, une version Unix et une version Windows, et enfin une fonction qui utilise la bonne selon le type de serveur :

function IsFatDir(const FatEntry: string): boolean;
var
  s: string;
begin
  s := Trim(FatEntry);
  s := Trim(Copy(s, Pos(' ', s) + 1, Length(s)));
  s := Trim(Copy(s, Pos(' ', s) + 1, Length(s)));
  s := Trim(Copy(s, 1, Pos(' ', s) - 1));
  Result := UpperCase(s) = '<DIR>';
end;
 
function IsDir(const Entry: string): boolean;
begin
  if FTPServerType = ftpWindows then Result := IsFatDir(Entry)
  else Result := (Length(Trim(Entry)) > 0) and (LowerCase(Trim(Entry))[1] = 'd');
end;
 
function AccessAllowed(const Entry: string): boolean;
begin
  if FTPServerType = ftpWindows then Result := true
  else Result := (Length(Trim(Entry)) > 7) and (LowerCase(Trim(Entry))[8] = 'r');
end;
 
function GetFatEntryName(const FatEntry: string): string;
begin
  Result := Trim(FatEntry);
  Result := Trim(Copy(Result, Pos(' ', Result) + 1, Length(Result)));
  Result := Trim(Copy(Result, Pos(' ', Result) + 1, Length(Result)));
  Result := Trim(Copy(Result, Pos(' ', Result) + 1, Length(Result)));
end;
 
function GetExt2EntryName(const Ext2Entry: string): string;
begin
  Result := Trim(Ext2Entry);
  Result := Trim(Copy(Result, Pos(' ', Result) + 1, Length(Result)));
  Result := Trim(Copy(Result, Pos(' ', Result) + 1, Length(Result)));
  Result := Trim(Copy(Result, Pos(' ', Result) + 1, Length(Result)));
  Result := Trim(Copy(Result, Pos(' ', Result) + 1, Length(Result)));
  Result := Trim(Copy(Result, Pos(' ', Result) + 1, Length(Result)));
  Result := Trim(Copy(Result, Pos(' ', Result) + 1, Length(Result)));
  Result := Trim(Copy(Result, Pos(' ', Result) + 1, Length(Result)));
  Result := Trim(Copy(Result, Pos(' ', Result) + 1, Length(Result)));
end;
 
function GetEntryName(const Entry: string): string;
begin
  if FTPServerType = ftpWindows then Result := GetFatEntryName(Entry)
  else Result := GetExt2EntryName(Entry);
end;

Avec ces trois fonctions, nous allons pouvoir déterminer si une entrée est un répertoire, si on y a accès, et le cas échéant, nous pourrons entrer dans le répertoire. Si nous ne vérifions pas les droits d'accès sur un serveur Unix avant d'accéder à un répertoire, nous aurons droit à un joli message d'erreur :

Sélectionnez la ListBox, et entrez le code suivant dans l'événement OnDblClick. Remarquez qu'on analyse le type de serveur au double clic sur une entrée :

procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  Entry: string;
begin
  if Listbox1.Count > 0 then
    begin
      Entry := ListBox1.Items[ListBox1.ItemIndex];
      GetServerType(Entry);
      ChangeDir(Entry);
    end;
end;

et définissez la procédure suivante :

procedure TForm1.ChangeDir(const Entry: string);
var
  Name: string;
begin
  if IsDir(Entry) then
    begin
      if AccessAllowed(Entry) then
        begin
          try
            EnableControls(false);
            Name := GetEntryName(Entry);
            Edit4.Text := Edit4.Text + Name + '/';
            IdFTP1.ChangeDir(Edit4.Text);
            try IdFTP1.List(ListBox1.Items); except; end;
          finally
            EnableControls(true);
          end;
        end
      else
        begin
          Memo2.Lines.Add('Accès non autorisé au répertoire ' + Name)
        end;
    end
end;

pour revenir à un répertoire parent, il nous faut une fonction qui analyse la chaîne et qui renvoie le répertoire précédent :

function GetPrevLevel(const FolderName: string): string;
var
  a: integer;
  s, t: string;
begin
  a := Pos('/', FolderName);
  if a = 0 then Result := FolderName
  else
    begin
      if FolderName[Length(FolderName)] = '/' then
        begin
          t := Copy(FolderName, 1, Length(FolderName) - 1);
          a := Pos('/', t);
        end
      else t := FolderName;
      s := '';
      while a > 0 do
        begin
          s := s + Copy(t, 1, a - 1) + '/';
          t := Copy(t, a + 1, Length(t));
          a := Pos('/', t);
        end;
      Result := Copy(s, 1, Length(S) - 1) + '/';
    end;
end;

Sélectionnez le TSpeedButton, et mettez le code suivant dans l'événement OnClick :

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  if not IdFTP1.Connected then Exit;
  if Length(Edit4.Text) = 1 then Memo2.Lines.Add('Vous êtes déjà au répertoire racine')
  else
    begin
      try
        EnableControls(false);
        Edit4.Text := GetPrevLevel(Edit4.Text);
        IdFTP1.ChangeDir(Edit4.Text);
        try IdFTP1.List(ListBox1.Items); except; end;
      finally
        EnableControls(true);
      end;
    end;
end;

Ajoutez la ligne suivante à l'événement OnDisconnected du TidFTP :

  Edit4.Text := '/';

Bon, la gestion des répertoires standard est complète, mais il reste encore à gérer les liens, qui peuvent désigner soit un fichier, soit un répertoire. Avant ça, occupons-nous de la gestion des fichiers standard…

Tout d'abord, écrivons une fonction qui nous permettra de déterminer si une entrée correspond à un fichier :

function  IsFile(const Entry: string): boolean;
begin
  if FTPServerType = ftpWindows then Result := not isFatDir(Entry)
  else Result := (Length(Trim(Entry)) > 0) and (Trim(Entry)[1] = '-');
end;

Maintenant, nous sommes prêts à récupérer des fichiers depuis un serveur distant. Placez simplement sur votre fiche un composant TSaveDialog. Nous voulons également afficher la progression et la vitesse de téléchargement pendant le téléchargement, nous aurons donc besoin d'une variable globale FileSize, de type integer, d'une variable FileName, de type string, et enfin d'une variable STime de type TdateTime :

var
  FileSize: integer;
  FileName: string;
  STime: TDateTime;

Sélectionnez maintenant le composant TListBox et modifiez le code de l'événement OnDblClick pour obtenir le code suivant :

procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  Entry: string;
begin
  if Listbox1.Count > 0 then
    begin
      Entry := ListBox1.Items[ListBox1.ItemIndex];
      GetServerType(Entry);
      ChangeDir(Entry);
      DownLoad(Entry);
    end;
end;

et définissez la procédure suivante (vous aurez besoin d'utiliser l'unité IdFTPCommon) :

...
uses
  Windows, ..., IdFtpCommon;
 
...
 
procedure TForm1.Download(const Entry: string);
var
  Name: string;
begin
  if IsFile(Entry) then
    begin
      if AccessAllowed(Entry) then
        begin
          Name := GetEntryName(Entry);
          FileName := Name;
          SaveDialog1.FileName := Name;
          try
            if SaveDialog1.Execute then
              begin
                EnableControls(false);
                IdFTP1.TransferType := ftBinary;
                FileSize := IdFTP1.Size(Name);
                try
                  IdFTP1.Get(Name, ExpandFileName(SaveDialog1.FileName), true);
                except
                  Memo2.Lines.Add('Echec lors du transfert');
                end;
              end;
          finally
            EnableControls(true);
          end;
        end
        else
          begin
            Memo2.Lines.Add('Accès non autorisé au fichier ' +  Name)
          end;
    end;
end;

Bon, maintenant, on peut télécharger un fichier sans problème, mais il reste encore un problème : si on télécharge un gros fichier, on risque de s'ennuyer ferme devant l'application, sans savoir si elle a planté ou pas… Pour ça, nous allons afficher la vitesse de réception ainsi que la quantité téléchargée du fichier en cours.

Lors du début du transfert, l'événement OnWorkBegin du TIdFTP est déclenché. Pendant le transfert, l'événement OnWork est régulièrement déclenché. À la fin du transfert, l'événement OnWorkEnd est déclenché. Pour savoir si nous sommes en cours de transfert ou pas, nous allons définir une variable globale TransferingData de type booléen. Pour voir si on veut annuler le transfert, nous allons déclarer une variable globale AbortTransfer de type booléen :

var
  TransferringData: boolean;
  AbortTransfer: boolean;

Mettez le code suivant dans l'événement OnWorkBegin du TidFTP :

procédure TForm1.IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  TransFerringData := true;
  SpeedButton2.Visible := true;
  AbortTransfer := false;
  STime := Now;
  Memo1.Lines.Add(FileName);
  Memo1.Lines.Add('0.00 Kb/s');
  if FileSize < AWorkCountMax then FileSize := AWorkCountMax;
  Memo1.lines.Add('0 / ' + IntToStr(FileSize) + ' octets');
end;

Mettez le code suivant dans l'événement OnWorkEnd du TidFTP :

procédure TForm1.IdFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
  SpeedButton2.Visible := false;
  Memo1.Lines.Clear;
  if AbortTransfer then Memo2.Lines.Add('Transfert Annulé : ' + FileName)
  else
  if (FileName <> '') then Memo2.Lines.Add('Transfert Complet : ' + FileName);
  FileSize := 0;
  TransferringData := false;
  FileName := '';
end;

Mettez le code suivant dans l'événement OnWork du TidFTP :

procédure TForm1.IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
var
  S: string;
  TotalTime: TDateTime;
  H, M, Sec, MS: Word;
  DLTime: Double;
  AverageSpeed: extended;
begin
  TotalTime :=  Now - STime;
  DecodeTime(TotalTime, H, M, Sec, MS);
  Sec := Sec + M * 60 + H * 3600;
  DLTime := Sec + MS / 1000;
  if DLTime > 0 then
    begin
      AverageSpeed := (AWorkCount / 1024) / DLTime;
      S := FormatFloat('0.00 Kb/s', AverageSpeed);
      Memo1.Lines[1] := S;
    end;
  if AbortTransfer then IdFTP1.Abort;
  Memo1.Lines[2] := IntToStr(AWorkCount) + '/' + IntToStr(FileSize) + ' octets';
end;

Pour pouvoir annuler le transfert, mettez le code suivant dans l'événement OnClick du TSpeedButton "annuler le transfert" :

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  AbortTransfer := true;
end;

Rajoutez la ligne suivante en première ligne de l'éventement OnClick du bouton "Connecter" :

if TransferringData then idFTP1.Abort;

Enfin, mettez le code suivant dans l'événement OnDestroy de la fiche :

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if TransferringData then idFTP1.Abort;
  if IdFTP1.Connected then IdFTP1.Disconnect;
end;

Sur les serveurs UNIX, il n'est pas rare de rencontrer des liens symboliques. Il est malheureusement impossible de différencier les liens symboliques vers des fichiers des liens symboliques vers des répertoires. Il est même impossible de déterminer si la cible d'un lien existe vraiment. Nous essaierons donc, pour les liens, en premier lieu de changer de répertoire, et s'il y a erreur, de télécharger le fichier. S’il y a encore une erreur, ça veut dire que la cible du lien n'existe pas.

Tout d'abord, écrivons une fonction qui identifie un lien :

function IsLink(const Entry: string): boolean;
begin
  if FTPServerType = ftpWindows then Result := false
  else Result := (Length(Trim(Entry)) > 0) and (LowerCase(Trim(Entry))[1] = 'l');
end;

puis, écrivons une fonction qui obtient le nom du lien :

function GetLinkName(const Name: string): string;
begin
  Result := Copy(Name, 1, Pos(' ', Name) - 1);
end;

Maintenant, écrivons une procédure pour gérer les liens :

procedure TForm1.ResolveLink(const Entry: string);
var
  Name: string;
begin
  if IsLink(Entry) then
    begin
      if AccessAllowed(Entry) then
        begin
          Name := GetLinkName(GetEntryName(Entry));
          FileName := Name;
          SaveDialog1.FileName := Name;
          try
            EnableControls(false);
            try
              IdFTP1.ChangeDir(Edit4.Text + Name + '/');
              Edit4.Text := Edit4.Text + Name + '/';
              try IdFTP1.List(ListBox1.Items); except; end;
            except
              if SaveDialog1.Execute then
                begin
                  IdFTP1.TransferType := ftBinary;
                  FileSize := IdFTP1.Size(Name);
                  try IdFTP1.Get(Name, ExpandFileName(SaveDialog1.FileName), true); except; end;
                end;
            end;
          finally
            EnableControls(true);
          end;
        end
        else
          begin
            Memo2.Lines.Add('Accès non autorisé au fichier ' +  Name)
          end;
    end;
end;

et modifiez l'événement OnDblClick du TListBox pour obtenir le code suivant :

procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  Entry: string;
begin
  if Listbox1.Count > 0 then
    begin
      Entry := ListBox1.Items[ListBox1.ItemIndex];
      GetServerType(Entry);
      ChangeDir(Entry);
      DownLoad(Entry);
      ResolveLink(Entry);
    end;
end;

Lors de la connexion, le composant TIdFTP reçoit des informations sur le type de serveur. Ces informations sont stockées dans la propriété TIdFTP.SystemDesc. Il s'agit d'une chaîne de caractères contenant le nom du système d'exploitation :

UNIX Type: L8
Windows_NT version 4.0

Pour déterminer le type de serveur, il suffit donc de regarder si la chaîne contient le mot "Windows" ou "Unix"…

À présent, écrivons une fonction qui détermine le type de serveur en fonction du texte du Tmemo :

procedure GetServerTypeFromSyst(ftp: TIdFTP);
var
  s: string;
begin
  s := Form1.IdFTP1.SystemDesc;
  if Pos('windows', LowerCase(s)) > 0 then FTPServerType := ftpWindows
  else FTPServerType := ftpUnix;
end;

Maintenant, déclenchons l'analyse du type de serveur. Il suffit d'effectuer le test juste après la connexion, et juste avant l'obtention de la liste des fichiers. Modifiez l'événement OnClick du Button1 pour obtenir le code suivant :

procedure TForm1.Button1Click(Sender: TObject);
begin
  if TransferringData then idFTP1.Abort;
  if IdFTP1.Connected then IdFTP1.Disconnect;
  try
    EnableControls(false);
    IdFTP1.Host := Edit1.Text;
    IdFTP1.UserName := Edit2.Text;
    IdFTP1.Password := Edit3.Text;
    IdFTP1.Connect;
    if idFTP1.Connected then
      try
        GetServerTypeFromSyst(idFTP1);
        IdFTP1.List(ListBox1.Items);
      except;
      end;
  finally
    EnableControls(true);
  end;
end;

Maintenant, les méthodes que nous avons vues en 6 sont inutiles, nous pouvons donc supprimer le code correspondant. Modifiez le code de l'événement OnDblClick du TListView pour obtenir le code suivant :

procedure TForm1.ListBox1DblClick(Sender: TObject);
var
  Entry: string;
begin
  if Listbox1.Count > 0 then
    begin
      Entry := ListBox1.Items[ListBox1.ItemIndex];
      ChangeDir(Entry);
      DownLoad(Entry);
      ResolveLink(Entry);
   end;
end;

Enfin, supprimez la procédure GetServerType, devenue inutile…

Voilà, vous avez maintenant un client FTP prêt à naviguer sur les serveurs UNIX et Windows…

Cependant, de nombreuses améliorations sont possibles. La première, et la plus simple consiste à activer le style XP sous Windows XP. Pour cela, il suffit d'ajouter un composant TXPManifest (onglet Win32) à la fiche :

Voici le résultat :

Il existe cependant d'autres systèmes de fichiers. Si vous rencontrez un serveur FTP qui n'est ni sous Windows, ni sous UNIX, donnez-moi l'adresse (envoyer à), et je complèterai l'article….

Il existe également des serveurs Windows avec des fichiers dont le nom contient des espaces. Si vous rencontrez un tel serveur, envoyez-moi l'adresse (envoyer à), et je complèterai l'article…


Maintenant que toute la technique pour réaliser un client FTP a été étudiée, on pourrait également utiliser un TListView pour bien visualiser les entrées des fichiers. On pourrait aussi utiliser de la couleur dans un TRichEdit pour afficher l'état des transferts.