Discussion :

[cincap]

Bonjour à toutes et à tous,

Avec une fonction pour copier un dossier vers un autre dossier, j'aimerai pouvoir copier que les fichiers du 1er dossier qui ont un poids de plus >250K et leur ajouter une extension soit .jpg.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
function CopyFolder(FromFld, ToFld: string): boolean; 
var fos: TSHFileopStruct;
begin 
// il faut supprimer les antislashs de fin sinon vous aurez droit à un message d'erreur 
  FromFld := ExcludeTrailingPathDelimiter(Trim(FromFld)); 
  ToFld := ExcludeTrailingPathDelimiter(Trim(ToFld)); 
 
  FillChar(fos, SizeOf(fos),0); 
  with fos do 
  begin 
    wFunc := FO_COPY; 
    pFrom := PChar(FromFld+#0); 
    pTo   := PChar(ToFld+#0); 
    fFlags := FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR; 
  end; 
  Result := ShFileOperation(fos)=0; 
end;

J'utilise Windows 10 64bits et D6.

Si quelqu'un avait une idée merci d'avance.

@+,

cincap

[tourlourou]

La solution passe peut-être par une boucle FindFirst/FindNext avec exploitation du TSearchRec et copie fichier par fichier.

[Charly910]

Bonjour,

if faut créer le répertoire de destination s'il n'existe pas (ForceDirectories ) puis utiliser FindFirst et FindNext :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
var
  sr       : TSearchRec ;
  FileAttrs: Integer ;
  Chemin   : String ;
begin
  FileAttrs := faAnyFile ;
  if FindFirst(Chemin, FileAttrs, sr) = 0 then
    begin
      repeat
        if (sr.Attr and FileAttrs) = sr.Attr then
        begin
//         Copy du fichier et modification de l'extension
        end;
      until FindNext(sr) <> 0 ;
      FindClose(sr) ;
    end;
  end;

(code non testé)

Si tu as des sous-répertoires, regarde ici

A+
Charly

[cincap]

@ tourlourou et @ Charly910, merci pour vos suggestions que je vais tester.

@ Charly910, avec la fonction décrite à mon topic, comme le DossierOriginal existe, elle crée le DossierFinal si il n'existe pas !

Pour son utilisation :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
procedure TForm1.Button1Click(Sender: TObject);
begin
if copyfolder('C:\DossierOriginal','C:\DossierFinal')
then 
     ShowMessage('Copie effectuée avec succès') else 
     ShowMessage('Copie non effectuée');
end;

Je vais tester et pour vous rassurer c'est en fait que je suis en train de reprendre des anciennes applications et de chercher d'autres solutions.

@+,

cincap

[Charly910]

Bonsoir,

il y a surement mieux et plus simple, mais essaye comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
function CopyFolder(FromFld, ToFld: string): boolean;
Var
  sr       : TSearchRec ;
  FileAttrs: Integer ;
  Chemin   : String ;
  FicRes   : String ;
 
Begin
  FromFld := IncludeTrailingPathDelimiter(Trim(FromFld)) ;
  ToFld := IncludeTrailingPathDelimiter(Trim(ToFld)) ;
 
  // Contrôle des entrées
  If not DirectoryExists(FromFld) Then
    Begin
      Result := False ;
      Exit ;
    End ;
  If (ToFld = '') Then    // Sinon ForceDirectories échoue
    Begin
      Result := False ;
      Exit ;
    End ;
 
  // Création éventuelle du répertoire cible
  SysUtils.ForceDirectories(ToFld) ;
  If not DirectoryExists(ToFld) Then
    Begin
      Result := False ;
      Exit ;
    End ;
 
  //  Exploration du répertoire source
  Chemin:=FromFld+'*.*' ;
  Result:=True;
  FileAttrs := faAnyFile ;
  if FindFirst(Chemin, FileAttrs, sr) = 0 then
    begin
      repeat
        If ((Sr.Name<>'.')And(sr.Name<>'..') And ((Sr.Attr And faDirectory)=0)) Then
        begin
//         Copy du fichier et modification de l'extension
          FicRes := ToFld+sr.Name ;
          FicRes := ChangeFileExt(FicRes, '.jpg') ;
          If not Windows.CopyFile(PChar(FromFld+sr.Name), PChar(FicRes), False) Then
            Begin
              Result := False ;
              FindClose(sr) ;
              Exit ;
            End
        end;
      until FindNext(sr) <> 0 ;
      FindClose(sr) ;
    end;
  Result := True ;
End;

A+
Charly

[pprem]

Modernisez-vous et oubliez les FindFirst / FindNext et TSearchrec : passez à http://docwiki.embarcadero.com/Libra...ctory.GetFiles avec un filtre géré sous forme de predicate. (si votre version de Delphi est assez récente, bien entendu).

[cincap]

Bonjour à toutes et à tous,

@ pprem, merci de ton intervention mais à mon âge, je suis toujours sous Delphi 6 comme précisé dans mon topic.

J'utilise Windows 10 64bits et D6.

@ Charly910, excellent travail, cela fonctionne correctement pour les 3/4 de ce que j'aimerai, reste à ne sauver que les fichiers qui ont un poids supérieur à 250 Kb.

En effet dans le dossier original, les fichiers n'ont pas d'extensions et avec la nouvelle mouture de la fonction, tous les fichiers sont bien copié avec l'extension dans ce cas .jpg.

J'ai testé mais sans bon résultat, je vous tiens au courant.

@+,

cincap

[SergioMaster]

Bonjour,

reste à ne sauver que les fichiers qui ont un poids supérieur à 250 Kb.

à ma souvenance, que j'ai été rafraîchir, la structure de SearchRec contient l'information de taille (Size) en octets.
Donc, en ajoutant dans le test (ligne 39) une nouvelle condition AND (sr.size>=250*1024) il n'y a pas à soulever ce point

[Charly910]

Oui, j'avais zappé le coup des 250 kb !! il suffit en effet de le rajouter dans le test.

je ne sais pas si le test sur . et .. est strictement indispensable dans ce cas ou on a filtré les directory ?

A+
Charly

[Charly910]

Effectivement je pense que l'on peut enlever : (Sr.Name<>'.') And (sr.Name<>'..')

A+
Charly

[cincap]

@ SergioMaster et @ Charly910 c'est exactement cela, j'avais testé sur une ligne ceci qui ne fonctionnait pas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
FloatToStrF(Sr.Size/250000, ffFixed, 7, 2)

Sans avoir pensé directement dans le processus de recherche.

A ce stade, je pourrai aussi tester une autre condition suivant la largeur de l'image .jpg (width) qui est de 1920 x 1080 car dans ce dossier il existe aussi un fichier convertit en image de 1080 x 1920 qui ne m'intéresse pas et qui est aussi copié (demi mal).

Je ferme le topic puisque l'excellente solution correspond à mon topic.

Grand merci à @ SergioMaster et @ Charly910 et les autres.

@+,

cincap

[SergioMaster]

A ce stade, je pourrai aussi tester une autre condition suivant la largeur de l'image .jpg (width) qui est de 1920 x 1080 car dans ce dossier il existe aussi un fichier convertit en image de 1080 x 1920 qui ne m'intéresse pas et qui est aussi copié (demi mal).

Ah, non, pour cela il faudrait charger le fichier dans un Tbitmap (ou plutôt un TJpeg) pour pouvoir tester ces caractéristiques

[Charly910]

Bonsoir,

pour faire plaisir à Patrick, voici la version "moderne" en D10.3 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
function CopyFolder(FromFld, ToFld: string): boolean ;
var
  LList: TStringDynArray;
  i    : Integer;
  LSearchOption: TSearchOption;
  Chemin   : String ;
  f: file of Byte;
  size: Longint;
Begin
  FromFld := IncludeTrailingPathDelimiter(Trim(FromFld)) ;
  ToFld := IncludeTrailingPathDelimiter(Trim(ToFld)) ;
 
  // Contrôle des entrées
  If not DirectoryExists(FromFld) Then
    Begin
      Result := False ;
      Exit ;
    End ;
  If (ToFld = '') Then    // Sinon ForceDirectories échoue
    Begin
      Result := False ;
      Exit ;
    End ;
 
  // Création éventuelle du répertoire cible
  ForceDirectories(ToFld) ;
  If not DirectoryExists(ToFld) Then
    Begin
      Result := False ;
      Exit ;
    End ;
 
  //  Exploration du répertoire source
  Chemin:=FromFld+'*.*' ;
  Result:=True;
 
  { Recherche non récursive }
  LSearchOption := TSearchOption.soTopDirectoryOnly;
 
  try
    { Recherche des fichiers }
    LList := TDirectory.GetFiles(FromFld, '*.*', LSearchOption);
 
  except
    { En cas d'erreur }
    Result := False ;
    MessageDlg('Chemin incorrect ou filtre de fichier incorrect', mtError, [mbOK], 0);
    Exit;
  end;
 
  { Copie des fichiers }
  for i := 0 to Length(LList) - 1 do
    Begin
       AssignFile(f, LList[i]);
      Reset(f);
      try
        size := FileSize(f);
        // à voir s'il faut modifier le test sur la taille ??
        If Size > 250 * 1024 Then TFile.Copy(LList[i], ToFld+TPath.GetFileNameWithoutExtension(LList[i])+'.jpg', True);
       finally
        CloseFile(f);
      end;
    End;
  Result := True ; 
end;

A+
Charly

[cincap]

Bonjour à toutes et à tous,

@ SergioMaster, merci de ta réponse, je vais à l'occasion tester la fonction concernant la largeur de l'image .jpg.

@ Charly910, je suppose que ta modification servira aux versions supérieures à D6 ?

Car sinon après test j'obtiens deux erreurs à la compilation :

LList: TStringDynArray;

LSearchOption: TSearchOption;

Ce qui me parait normal vu le contexte.

Encore merci d'avoir trouvé une excellente solution à mon topic.

@+,

cincap

[Charly910]

Bonjour,

le type TStringDynArray n'existe que dans les versions plus récentes de Delphi (par exemple la 10.3 dont tu peux télécharger gratuitement la version Community)

Sinon pour connaitre et tester les dimensions de tes Jpeg, tu peux utiliser cette fonction :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
function TailleImgJpg(Image : String) : TPoint ;
// Dimensions en pixels du fichier Image
//     Uses Jpeg ...
Var
  Jpeg1 : TJpegImage ;
  Ext : String ;
  IsJpg : Boolean ;
Begin
  Result.X := 0 ;
  Result.Y := 0 ;
  // Test du fichier
  If not FileExists(Image) Then Exit ;
  Ext := UpperCase(ExtractFileExt(Image)) ;
  IsJpg := (Ext = '.JPG') or (Ext = '.JPEG') ;
  If not IsJpg Then Exit ;
  // Chargement et calcul de la Taille
  Jpeg1 := TJpegImage.Create;
  try
    Jpeg1.LoadFromFile(Image);
    Result.X := Jpeg1.Width ;
    Result.Y := Jpeg1.Height ;
  finally
    Jpeg1.Free;
  end;
End ;

Largeur : TailleImgJpg(Image).X
Hauteur : TailleImgJpg(Image).Y

A+
Charly

[Andnotor]

pour faire plaisir à Patrick, voici la version "moderne" en D10.3 :

Je pense que pprem pensait plus à quelque chose comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
function CopyFolder(const aSource, aDest :string): boolean;
begin
  if not DirectoryExists(aSource) or
     aDest.IsEmpty                or
     not ForceDirectories(aDest)  then Exit(FALSE);
 
  var Files := TDirectory.GetFiles(aSource, '*.*', TSearchOption.soTopDirectoryOnly, function(const Path: string; const SearchRec: TSearchRec): Boolean
                                                                                     begin
                                                                                       Result := SearchRec.Size >= 250 *1024;
                                                                                     end);
  for var F in Files do
    TFile.Copy(F, TPath.Combine(aDest, TPath.GetFileName(F) +'.jpg'));
 
  Result := TRUE;
end;

[Charly910]

J'avais quand même TDirectory.GetFiles(FromFld, '*.*', LSearchOption) de bon !

Merci pour cette fonction qui pourra me resservir

A+
Charly

[tourlourou]

Très belle version du code ! Chapeau... C'est comme en littérature : plus beau quand il n'y a rien de trop. Et que ce soit efficace, plus qu'un exercice de style à la Queneau.

[Andnotor]

Merci pour les

[pprem]

Je pense que pprem pensait plus à quelque chose comme ceci

En effet, mais j'avais pas vu qu'il était en Delphi 6 et par conséquent cette solution hyper pratique ne passe pas puisque System.IOUtils n'est apparu que bien plus tard.