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

Delphi 7 est fourni avec les composants Indy. Voyons comment les utiliser pour mettre en oeuvre un client FTP. Ce document est la mise à jour du document précédent qui concernait Delphi 6, vu que les composants Indy ont évolué depuis.

Article lu   fois.

L'auteur

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

1. Connaissances préalables

Sources du projet: Indyftpsrc.zip (5.24 ko)

FTP (File Transfert Protocol) est un protocole de transfert de fichier 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 email 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

2. Mise en place des composants

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.

Image non disponible

Par défaut, le composant TIdFTP prend le contrôle de l'application entière quand il est en action, ou plutot 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 proprité OnlyWhenIdle sur "False".

Image non disponible

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

Image non disponible

Posez à présent sur votre fiche un autre TGroupBox dont le Caption sera "Gestion Fichiers", 2 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", ainsique sa propriété Visible sur true, qui servira de bouton d'annulation du téléchargement...

Image non disponible

Le FTP à la particularité de donner de nombreuses informations d'état sur les commandes que nous lui envoyons. Pour les afficher, posez un troisè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.

Image non disponible

Enfin, 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.

Image non disponible

Bien sûr, si nous executons 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:

 
Sélectionnez

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'évennement OnClick du bouton "Connecter":

 
Sélectionnez

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'évennement OnClick du bouton "Déconnecter"

 
Sélectionnez

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'évennement OnStatus:

 
Sélectionnez

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

A 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'évennement 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:

 
Sélectionnez

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

et mettez le code suivant dans l'évennement OnDisconnected du TIdFTP:

 
Sélectionnez

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

A 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

 
Sélectionnez

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

 
Sélectionnez

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.

3. Entrées ext2fs

 
Sélectionnez

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 10 caractères, qui désignent les autorisations pour les fichiers, plus les attributs:

  • le premier caractère peut être soit un tiret "-", l'entrée correspondra à un fichierun d, l'entrée correspondra à un répertoire (directory)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épértoire, 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:\netlog.txt lien\netlog.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 3 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: La lettre r désigne une autorisation de lecture (read)La lettre w désigne une autorisation d'écriture (write)La lettre x désigne une autorisation d'exécution (eXecute) du fichier maintenant, la désignation des 3 groupes: Le groupe de gauche concerne le propriétaire du fichier (user)Le groupe du milieu concerne les utilisateurs appartenant au même groupe que le propriétaire du fichier (group)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 3 champs séparés par des espaces: le mois de modificationle jour de modificationsoit 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:

 
Sélectionnez

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

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

  1. le nom du lien
  2. la chaîne "->"
  3. la cible du lien

A 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...

4. Entrées Windows

 
Sélectionnez

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 4 champs:

  1. la date de modification, au format MM:JJ:AA
  2. l'heure de modification, au format HH:MM en mode 12 heure, 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

5. Détermination du type de serveur

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:

 
Sélectionnez

type
  TFTPServerType = (ftpUnix, ftpWindows);

Définissons une variable globale de type TFTPServerType:

 
Sélectionnez

var
  FTPServerType: TFTPServerType

Le seul moyen que nous avons 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 3, alors qu'un serveur Unix en génère 8. Par conséquent, on peut dire qu'un serveur dont les entrées contiennent plus de 4 espaces est un serveur Unix. Écrivons la procédure correspondante:

 
Sélectionnez

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...

6. Gestion des répertoires

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 que 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:

 
Sélectionnez

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 3 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:

Image non disponible

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

 
Sélectionnez

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:

 
Sélectionnez

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:

 
Sélectionnez

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énnement OnClick:

 
Sélectionnez

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'évennement OnDisconnected du TIdFTP:

 
Sélectionnez

  Edit4.Text := '/';

7. Gestion des fichiers

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:

 
Sélectionnez

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:

 
Sélectionnez

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

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

 
Sélectionnez

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) :

 
Sélectionnez

...
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'évennement OnWorkBegin du TIdFTP est déclenché. Pendant le transfert, l'évennement OnWork est régulièrement déclenché. A la fin du transfert, l'évennement 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:

 
Sélectionnez

var
  TransferringData: boolean;
  AbortTransfer: boolean;

Mettez le code suivant dans l'évennement OnWorkBegin du TIdFTP:

 
Sélectionnez

procedure 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'évennement OnWorkEnd du TIdFTP:

 
Sélectionnez

procedure 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'évennement OnWork du TIdFTP:

 
Sélectionnez

procedure 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'évennement OnClick du TSpeedButton "annuler le transfert":

 
Sélectionnez

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

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

 
Sélectionnez

if TransferringData then idFTP1.Abort;

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

 
Sélectionnez

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

8. Gestion des liens symboliques

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 si il y a erreur, de télécharger le fichier. Si 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:

 
Sélectionnez

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:

 
Sélectionnez

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:

 
Sélectionnez

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'évennement OnDblClick du TListBox pour obtenir le code suivant:

 
Sélectionnez

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;

9. Autre méthode de détermination du type de serveur

Lors de la connection, le composant TIdFTP recoit des informations sur le type de serveur. Ces informations sont stockées dans la propriété TIdFTP.SystemDesc. Il s'agit d'une chaine de caractère contenant le nom du système d'exploitation :

 
Sélectionnez

UNIX Type: L8
Windows_NT version 4.0

Pour déterminer le type de serveur, il suffit donc de regarder si la chaine contient le mot "Windows" ou "Unix"...

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

 
Sélectionnez

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 connection, et juste avant l'obtention de la liste des fichiers. Modifiez l'évennement OnClick du Button1 pour obtenir le code suivant :

 
Sélectionnez

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 vu en 6 sont inutiles, nous pouvons donc supprimer le code correspondant. Modifiez le code de l'évennement OnDblClick du TListView pour obtenir le code suivant:

 
Sélectionnez

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 procedure GetServerType, devenue inutile...

10. Conclusion et améliorations possibles

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

Image non disponible

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 :

Image non disponible

Voici le résultat :

Image non disponible

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 à)edrad@wanadoo.fr, et je complèterais 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 à)edrad@wanadoo.fr, et je complèterais 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.

Liste de mes articles :
Delphi 6 : Réalisation d'un explorateur de fichiers
Delphi 6 : Création d'un menu 'à la Office 2000'
Delphi 7: Réaliser un Client FTP à l'aide des composants Indy
Delphi 7 : Donner le style Windows XP à vos applications sous Windows XP
Portage d'applications CLX entre Delphi 6 et Kylix
Tri par Sélection
Ce document est issu de http://www.developpez.com et reste la propriété exclusive de son auteur. La copie, modification et/ou distribution par quelque moyen que ce soit est soumise à l'obtention préalable de l'autorisation de l'auteur.