[D6][Windows 10] Recopier et afficher en ligne dans un Tedit des fichiers dans un dossier

**cincap** · 10/08/2021, 12h31

Bonjour à toutes et à tous,

Je teste pas mal des anciennes applications en cherchant d'autres méthodes.

Dans un dossier j'ai un nombre de fichiers VTS_01_*.VOB que j'aimerai afficher en ligne dans un Tedit comme ceci :

"concat:VTS_01_1.VOB|VTS_01_2.VOB|VTS_01_3.VOB"

Mais il peut y avoir plus de 3 fichiers VTS_01_*.VOB dans ce dossier.

J'utilise la 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
26
 
Function CompteFichiers(Chemin:String):Integer;
Var S:TSearchRec;
Begin
  Chemin:=IncludeTrailingPathDelimiter(Chemin);
  Result:=0;
  // Recherche de la première entrée du répertoire
  If FindFirst(Chemin+'VTS_01_*.VOB',faAnyFile,S)=0
  Then Begin
    Repeat
      // Il faut absolument dans le cas d'une procédure récursive ignorer
      // les . et .. qui sont toujours placés en début de répertoire
      // Sinon la procédure va boucler sur elle-même.
      If (S.Name<>'.')And(s.Name<>'..')
      Then Begin
        If (S.Attr And faDirectory)<>0
          // Dans le cas d'un sous-repertoire on appelle la même procédure
          Then Result:=Result+CompteFichiers(Chemin+S.FindData.cFileName)
          // Sinon on compte simplement le fichier
          Else Inc(Result);
      End;
    // Recherche du suivant
    Until FindNext(S)<>0;
    FindClose(S);
  End;
End;

Utilisation :

Code :

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

1
2
3
4
5
6
7
8
 
procedure TForm1.Button2Click(Sender: TObject);
begin
 // "concat:VTS_01_1.VOB|VTS_01_2.VOB|VTS_01_3.VOB"
 
 ShowMessage(IntToStr(CompteFichiers(chappli))+ ' Fichier(s) de type VOB');
 
end;

Le nombre de fichiers est bien détecté mais je patine pour les retranscrire comme le modèle dans le Tedit.

Merci d'avance,

@+,

cincap

**Cirec** · 10/08/2021, 13h28

Bonjour Cincap,

ça fait un moment hein

bon pour ton petit soucis
je t'avais donné une série d'unités parmi laquelle "crFilesUtils.pas" qui contient, entre autre,
la procédure FindFiles que tu utilises comme suit:

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
uses crFilesUtils;
 
procedure TForm4.Button1Click(Sender: TObject);
var
  SL: TStringList;
begin
  SL := TStringList.Create;
  try
    FindFiles('E:\Savegardes\Films\VIDEO_TS', 'VTS_02_*.VOB', SL, True, False);
    SL.Delimiter := '|';
    Edit1.Text := '"concat:' + SL.DelimitedText + '"';
  finally
    SL.Free;
  end;
end;

Le code renvoie : "concat:VTS_02_0.VOB|VTS_02_1.VOB|VTS_02_2.VOB|VTS_02_3.VOB"

pour tous les autres qui ne possèdent pas encore cette unité
voici une version de base:

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
unit crFilesUtils;
{  unit crFilesUtils
   par Cirec 
 
   Utilisation :
   Procedure FindFiles(
     Directory: String; --> In : indique le répertoire de recherche
     FilesMask: String; --> In : indique le type de fichier recherché (*?.*)
     aList: TStrings;   --> Out: TSringList contenant les noms de fichiers trouvés
     SubFolders: Boolean--> pour une recherche dans les sous répertoires à True par défaut
     FullPath: Boolean  --> renvoie le chemin + le nom  de fichier ou le nom de fichier seul
                       );
 
}
interface
uses Windows, SysUtils, Classes, Masks;
 
procedure FindFiles(Directory: string; FilesMask: string; aList: TStrings; const
  SubFolders: Boolean = True; const FullPath: Boolean = True);
 
implementation
uses Forms, Controls;
 
function MatchesMasks(const Filename, Mask: string): Boolean;
var
  CMask: TMask;
  MaskList: TStringList;
  I: Integer;
begin
  Result := False;
  MaskList := TStringList.Create;
  try
    MaskList.Delimiter := ';';
    MaskList.DelimitedText := Mask;
    for I := 0 to MaskList.Count - 1 do
    begin
      if Result then Break;
      CMask := TMask.Create(MaskList[I]);
      try
        Result := CMask.Matches(Filename);
      finally
        CMask.Free;
      end;
    end;
  finally
    MaskList.Free;
  end;
end;
 
 
 
 
procedure _FindFiles(Directory: string; FilesMask: string; aList: TStrings; const
  SubFolders: Boolean = True; const FullPath: Boolean = True);
var
  SearchRec: TSearchRec;
begin
  if not DirectoryExists(Directory) then
    Exit;
  if Directory[Length(Directory)] <> '\' then Directory := Directory + '\';
  if FindFirst(Directory + '*.*', faAnyFile, SearchRec) = 0 then
  try
    aList.BeginUpdate;
    repeat
      if (SearchRec.Attr and faDirectory = faDirectory) and (SearchRec.Name[1]
        <> '.') then
      begin
        if (SearchRec.Attr and faDirectory > 0) and SubFolders then
          _FindFiles(Directory + SearchRec.Name, FilesMask, aList, SubFolders,
            FullPath);
      end
      else
        if (SearchRec.Name[1] <> '.') and (MatchesMasks(SearchRec.Name,
          FilesMask)) then
          if FullPath then
            aList.Add(Directory + SearchRec.Name)
          else
            aList.Add(SearchRec.Name);
    until FindNext(SearchRec) <> 0;
  finally
    FindClose(SearchRec);
    aList.EndUpdate;
  end;
end;
 
procedure FindFiles(Directory: string; FilesMask: string; aList: TStrings; const
  SubFolders: Boolean = True; const FullPath: Boolean = True);
begin
  try
    SetCursor(LoadCursor(0, IDC_WAIT));
    _FindFiles(Directory, FilesMask, aList, SubFolders, FullPath);
  finally
    SetCursor(LoadCursor(0, IDC_ARROW));
  end;
end;
end.

Cordialement,

@+

**cincap** · 10/08/2021, 14h14

@ Cirec, Bonjour et merci pour ta réponse, je t'avais demandé souvent de tes nouvelles par mail mais sans réponse.

Comme je savais que tu étais très occupé, il n'y avait pas de problème.

Content que tu vas bien.

En ce qui concerne l'unité, je l'avais mais avec des liaisons avec beaucoup d'autres.

J'ai donc recréé cette unité suivant ton code et qui fait appel à l'unité "Mask" soit une seule.

Pour le code, seul "concat" s'affiche dans le Tedit, les fichiers .VOB non.

Je vais essayer de comprendre, pour ma part je pensais que ce n'était pas possible.

@+,

cincap

**Cirec** · 10/08/2021, 14h44

re,
pour les mails c'est bizarre je n'ai rien vu !!!!
je vais regarder ça de plus près ...
[EDIT]
je viens de vérifier ma boite et le dernier échange date du 13/03/2020 et depuis pas de trace !!!
envoie moi un mail pour voir ce qu'il se passe !
[/EDIT]

pour le code de mon exemple j'ai changé le type de fichier recherché:

Code :

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

FindFiles('E:\Savegardes\Films\VIDEO_TS', 'VTS_02_*.VOB', SL, True, False);

ceci explique peut être la chaine vide en retour

sinon pour info Delphi n'embarque pas de code "mort" ou "non utilisé" dans l'exe
donc même si tu as besoin de toutes les unités pour compiler le code il embarque dans l'exe que ce qui est vraiment utilisé
ce qui est représenté par les points bleus dans la marge de l'IDE après compilation

Cordialement,
@+

**cincap** · 10/08/2021, 15h22

@ Cirec, je viens de t'envoyer un mail.

J'avais remarqué le changement du fichier et avais adapté le code.

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
 
procedure TForm1.Button2Click(Sender: TObject);
 var
  SL: TStringList;
begin
// "concat:VTS_01_1.VOB|VTS_01_2.VOB|VTS_01_3.VOB"
  SL := TStringList.Create;
  try
    FindFiles('chappli','VTS_01_*.VOB', SL, True, False);
    SL.Delimiter := '|';
 
    Edit2.Text := '"concat:' + SL.DelimitedText + '"';
  finally
    SL.Free;
  end;
 
end;

La réponse dans le Tedit est "concat:"

Je ne vois pas le résultat de findfiles pour vérifier.

Maintenant j'ai recopié l'unité que tu as communiquée, je vais revoir avec l'ancien dossier.

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
 
unit crFilesUtils;
{  unit crFilesUtils
   par Cirec 
 
   Utilisation :
   Procedure FindFiles(
     Directory: String; --> In : indique le répertoire de recherche
     FilesMask: String; --> In : indique le type de fichier recherché (*?.*)
     aList: TStrings;   --> Out: TSringList contenant les noms de fichiers trouvés
     SubFolders: Boolean--> pour une recherche dans les sous répertoires à True par défaut
     FullPath: Boolean  --> renvoie le chemin + le nom  de fichier ou le nom de fichier seul
                       );
 
}
interface
uses Windows, SysUtils, Classes, Masks;
 
procedure FindFiles(Directory: string; FilesMask: string; aList: TStrings; const
  SubFolders: Boolean = True; const FullPath: Boolean = True);
 
implementation
uses Forms, Controls;
 
function MatchesMasks(const Filename, Mask: string): Boolean;
var
  CMask: TMask;
  MaskList: TStringList;
  I: Integer;
begin
  Result := False;
  MaskList := TStringList.Create;
  try
    MaskList.Delimiter := ';';
    MaskList.DelimitedText := Mask;
    for I := 0 to MaskList.Count - 1 do
    begin
      if Result then Break;
      CMask := TMask.Create(MaskList[I]);
      try
        Result := CMask.Matches(Filename);
      finally
        CMask.Free;
      end;
    end;
  finally
    MaskList.Free;
  end;
end; 
 
procedure _FindFiles(Directory: string; FilesMask: string; aList: TStrings; const
  SubFolders: Boolean = True; const FullPath: Boolean = True);
var
  SearchRec: TSearchRec;
begin
  if not DirectoryExists(Directory) then
    Exit;
  if Directory[Length(Directory)] <> '\' then Directory := Directory + '\';
  if FindFirst(Directory + '*.*', faAnyFile, SearchRec) = 0 then
  try
    aList.BeginUpdate;
    repeat
      if (SearchRec.Attr and faDirectory = faDirectory) and (SearchRec.Name[1]
        <> '.') then
      begin
        if (SearchRec.Attr and faDirectory > 0) and SubFolders then
          _FindFiles(Directory + SearchRec.Name, FilesMask, aList, SubFolders,
            FullPath);
      end
      else
        if (SearchRec.Name[1] <> '.') and (MatchesMasks(SearchRec.Name,
          FilesMask)) then
          if FullPath then
            aList.Add(Directory + SearchRec.Name)
          else
            aList.Add(SearchRec.Name);
    until FindNext(SearchRec) <> 0;
  finally
    FindClose(SearchRec);
    aList.EndUpdate;
  end;
end;
 
procedure FindFiles(Directory: string; FilesMask: string; aList: TStrings; const
  SubFolders: Boolean = True; const FullPath: Boolean = True);
begin
  try
    SetCursor(LoadCursor(0, IDC_WAIT));
    _FindFiles(Directory, FilesMask, aList, SubFolders, FullPath);
  finally
    SetCursor(LoadCursor(0, IDC_ARROW));
  end;
end;
end.

@+,

cincap

**cincap** · 10/08/2021, 15h44

@ Cirec, j'ai vu mon erreur au niveau de "chappli"

Code :

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

1
2
 
FindFiles(chappli,'VTS_01_*.VOB', SL, True, False);

Donc cela fonctionne mais dans mes tests, dans le dossier "chappli" il y a des sous dossiers avec mes essais et donc avec les mêmes fichiers .VOB.

Ce qui veut dire que dans le Tedit la recherche prends tous les fichiers.VOB.

En résumé dans le dossier ou l'extraction se fera il n'y aura que les fichiers propres au DVD.

Chapeau bas, cela fonctionne correctement.

@+,

cincap

[D6][Windows 10] Recopier et afficher en ligne dans un Tedit des fichiers dans un dossier

Delphi

Discussions similaires

Partager

Partager