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