Copie une arborescence de fichiers avec vérification des fichiers copiés

Télécharger le projet
Commenter

Description

Un programme qui copie les fichiers d'un répertoire à un autre en traitant les sous dossiers (fonction récursive) et qui gère si les fichiers on bien été copié.
supprime aussi certains espaces en fin de noms pour la compatibilité entre Mac et PC.
J'ai fait ce programme pour vérifier la bonne sauvegarde des fichiers d'un mac pour les transférer vers un PC
Permet d'obtenir une liste des fichiers qui n'ont pas été copiés.

Source / Exemple : 


procedure ChercherFichier(Repertoire,Repcourt: string);
var
  R: Integer;
  SearchRec: TSearchRec;
  nomdest,nomcourt,nomtemp: String;
begin
  begin
    R := FindFirst(Repertoire + '\*', faAnyFile, SearchRec);
    try
      while R = 0 do
        begin
      form1.LblNbListe.Caption:=   inttostr(Form1.RichEditListeFichieraCopier.Lines.Count);
      application.ProcessMessages;
          nomdest:=copy(Repertoire + '\' + SearchRec.Name, 3, StrLen(Pchar(Repertoire + '\' + SearchRec.Name)) - 2) ;
          nomcourt:=ExtractShortPathName(Repcourt + '\' +SearchRec.Name);
          if nomcourt='' then
            begin
              nomtemp:='"' + Repcourt + '\' +SearchRec.Name+' "';
              nomcourt:=nomtemp;
              nomcourt:=ExtractShortPathName('"' + Repcourt + '\' +SearchRec.Name+' "');
              nomcourt:=Repcourt;
            end;
          if (SearchRec.Attr <> 16) and (SearchRec.Attr <> 17) then
            begin
              Form1.RichEditListeFichieraCopier.Lines.Add(Repertoire + '\' + SearchRec.Name);
//              Form1.RichEdit4.Lines.Add(nomdest);
              form1.RichEditNomCourtdesFichiers.Lines.Add(nomcourt);

            end

          else if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then
          try
            //remplace les '**** \*****' par '****\****'
            nomdest:=ReplaceRegExpr(' \\',nomdest,'\');
            CreateDir(Form1.EditDest.Text + nomdest);
            if not DirectoryExists(Form1.EditDest.Text + nomdest) then
              Form1.RichEditErreurRepertoire.Lines.add('"' + Repertoire + '\' + SearchRec.Name + '"');
            ChercherFichier(Repertoire + '\' + SearchRec.Name, ExtractShortPathName(Repcourt + '\' + SearchRec.Name));
          except
            Form1.RichEditErreurRepertoire.Lines.add('"' + Repertoire + '\' + SearchRec.Name + '"');
          end;
          R := FindNext(SearchRec);
        end;
    finally
      FindClose(SearchRec);
    end;
  end;

end;

procedure TForm1.BtnListerClick(Sender: TObject);
begin
  if not DirectoryExists(EditDest.Text + copy(pchar(EditSource.Text), 3, strlen(pchar(EditSource.Text) - 2))) then
    CreateDir(EditDest.Text + copy(pchar(EditSource.Text), 3, strlen(pchar(EditSource.Text) - 2)));
  ChercherFichier(EditSource.Text,EditSource.Text);
end;

procedure TForm1.BtnCopierClick(Sender: TObject);
var
  i: integer;
  filename: string;
begin
  for i := 0 to RichEditListeFichieraCopier.Lines.Count do
    begin
      if BtnLister.Tag<>0 then
        begin
          BtnLister.Tag:=0;
          exit;
        end;
        try
        form1.LblNBCopies.Caption:=   inttostr(i);
        filename := EditDest.Text + copy(RichEditListeFichieraCopier.Lines[i], 3, StrLen(Pchar(RichEditListeFichieraCopier.Lines[i])) - 2);
        filename:=ReplaceRegExpr(' \\',filename,'\');
        CopyFile(Pchar(RichEditListeFichieraCopier.Lines[i]), Pchar(filename), false);
        if not FileExists(filename) then
          begin
            RichEditFichiersMalCopies.Lines.Add(RichEditListeFichieraCopier.Lines[i]);
            //pour connaitre le nomcourt des fichiers mal copiés
            //RichEdit6.Lines.Add(RichEditListeFichiersaCopier.Lines[i]);
          end;
        LblNbMalCopies.Caption:=inttostr(RichEditFichiersMalCopies.Lines.count);
      except
        RichEditFichiersMalCopies.Lines.Add(RichEditListeFichieraCopier.Lines[i]);
      end;
      application.ProcessMessages;
    end;
end;
procedure TForm1.BtnArretCopieClick(Sender: TObject);
begin
  BtnLister.tag:=1;
end;

Conclusion :


je ne modifierai plus ce code puisque la migration est finie.
Tout ce que je peux vous en dire c'est que les Mac c'est vraiment pas à mon gout...
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_Brain)