Discussion :

[xherault]

Bonjour tout le monde !

Je développe un système de traitement de fichiers texte.

Le principe est le suivant:
- J'ai 1600 fichiers dans une arborescence de répertoire
- Je souhaite ouvrir tous les fichiers, les parcourir à la recherche de balises(zones de commentaires), supprimer ces zones et enregistrer les fichiers dans un répertoire
- Je souhaite ensuite analyser le contenu épuré de ces fichiers.

Mon premier traitement (recherche et suppression des commentaires) fonctionne parfaitement sur un ensemble restreint de fichiers.

Par contre, si je le lance sur l'intégralité de mon arborescence, j'obtiens le message d'erreur suivant:

Le projet XXXX.exe a déclenché la classe d'exception EOutOfMemory avec le message 'Mémoire insuffisante'

Je suis sur un portable avec 1 Go de ram avec Delphi 2005 Edition presonnel.


Pour parcourir l'arborescence des fichiers:

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
procedure TForm1.SupprimerCommentaireFichiers(AChemin: string);
var
  Info: TSearchRec;
  FileText: TStringList;
begin
  AChemin := IncludeTrailingPathDelimiter(AChemin);
 
  FileText := TStringList.Create;
  try
    if FindFirst(AChemin+'*.*',faAnyFile,Info)=0 then begin
      repeat
       if ((Info.Attr and faDirectory)=0) then begin
          {Fichier}
          if (ExtractFileExt(info.Name) = '.P') or (ExtractFileExt(info.Name) = '.I') then begin
            FileText.Clear;
            AfficherEvolution('Chargement du fichier', AChemin + info.Name);
            FileText.LoadFromFile(AChemin + info.Name);
            FileText.Text := RetourneTexteSansCommentaires(FileText.Text);
            FileText.SaveToFile(AChemin + info.Name);
          end;
        end
        else begin
          {Répertoire}
          if (info.Name <> '.') and (info.Name <> '..') then
            SupprimerCommentaireFichiers(AChemin + info.Name);
        end;
        Application.ProcessMessages;
        Sleep(100);
      until FindNext(Info)<>0;
 
      { Libération des ressources de la recherche }
      FindClose(Info);
    end;
  finally
    FileText.free;
  end;
end;

Pour traiter un fichier:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
function TForm1.RetourneTexteSansCommentaires(ATexte: string): string;
var
  PosDebCommentaire, PosFinCommentaire: Integer;
begin
  PosDebCommentaire := Pos('/*', ATexte);
  Result := '';
  while (PosDebCommentaire <> 0) do begin
    PosFinCommentaire := Pos('*/', ATexte);
    ATexte := Copy(ATexte, 0, PosDebCommentaire - 1) + Copy(ATexte, PosFinCommentaire + 2, length(ATexte) - (PosFinCommentaire - PosDebCommentaire));
 
    PosDebCommentaire := Pos('/*', ATexte);
  end;
  Result := ATexte;
end;

Le lancement de l'application hors Delphi provoque le même problème

Avez-vous une idée ? une piste ?

[Rayek]

[edit] Apprendra a mieux lire les codes[/edit]

[ryko]

et en déclarant FileText en variable globale ?

ou en recréant/libérant FileText pour chaque fichier traité (même si ça ralenti le traitement) ?

[LadyWasky]

Code :

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

function TForm1.RetourneTexteSansCommentaires(ATexte: string): string;

Et en passant ATexte par référence ? ça évitera une duplication de la chaine en mémoire (c'est toujours ça de gagné si tes fichiers sont gros) :

Code :

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

function TForm1.RetourneTexteSansCommentaires(var ATexte: string): string;

[ryko]

J'ai raté un truc là ? Car je ne vois pas la récursion dans le code proposé

[LadyWasky]

Ha oui, ce qui pêche effectivement c'est ceci :

Code :

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

FileText := TStringList.Create;

qui est appelé de façon récursive, il faut que tu le sortes de la récursivité...

[ryko]

Ah oui. D'accord ! J'ai les yeux qui fatiguent et la cervelle qui ramolli (calor, calor)
Ben oui, faut sortir le create et le free car il n'y a pas autant de free que de create
+1 pour tous sauf pour moi

[LadyWasky]

Tu peux tester ça, ça devrait aller

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
procedure Supprime(AChemin:String;FileText:TStringList);
var
  Info: TSearchRec;  
begin
  AChemin := IncludeTrailingPathDelimiter(AChemin);  
  try
    if FindFirst(AChemin+'*.*',faAnyFile,Info)=0 then begin
      repeat
       if ((Info.Attr and faDirectory)=0) then begin
          {Fichier}
          if (ExtractFileExt(info.Name) = '.P') or (ExtractFileExt(info.Name) = '.I') then begin
            FileText.Clear;
            AfficherEvolution('Chargement du fichier', AChemin + info.Name);
            FileText.LoadFromFile(AChemin + info.Name);
            FileText.Text := RetourneTexteSansCommentaires(FileText.Text);
            FileText.SaveToFile(AChemin + info.Name);
          end;
        end
        else begin
          {Répertoire}
          if (info.Name <> '.') and (info.Name <> '..') then
            Supprime(AChemin + info.Name,FileText);
        end;
        Application.ProcessMessages;
        Sleep(100);
      until FindNext(Info)<>0;
 
      { Libération des ressources de la recherche }
      FindClose(Info);
    end;  
end;
 
procedure TForm1.SupprimerCommentaireFichiers(AChemin: string)
var  FileText: TStringList;
begin
  try
    FileText := TStringList.Create;
    Supprime(Chemin,FileText);
  finally
    FileText.free;
  end;
end;

Et encore... il faudrait aussi sortir les FindFirst/FindNext/FindClose de tout contexte récursif

[TicTacToe]

argh, j'allais proposer grosso-modo la meme chose waskol, d'encapsuler la TStringList dans la fonction supprimes

Sinon, si toujours des problemes, pour être non récursift tu fais quelque chose du style

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
var
  LDossiers: TStringList;
  IIndice: Integer;
begin
  LDossiers := TStringList.Create;
  try
  LDossiers.Add( [dossier racine] );
  IIndice := 0;
  while ( IIndice < LDossiers.Count ) do
    begin
       SDossierCourant := LDossiers[ IIndice ];
       Repeat [parcours des éléments de SDossierCourant]
         si element = fichier
           Alors traiterFichier
           Sinon Ajouter Element à LDossiers
       until plus de fichiers sur SDossierCourant
       IIndice := IIndice + 1
    end;
    finally LDossiers.Free; end;
end

enfin, c'est pas super optimisé, car on pourrait supprimer de LDossiers, les dossiers déjà ventilés, mais en général ca suffit.

bon courage!

[xherault]

Typiquement au lieu d'allouer une fois pour toutes ta TStringList, alloue la, alimente là, puis libère là dès que tu as fais ton traitement

J'ai deja essayé cette solution, mais cela ne donne rien j'ai pensé qu'une seule serait moins gourmande !

[TicTacToe]

Vive les fonctions récursives

plus sérieusement, il y a plusieurs options.

Déjà, en 1er lieu, assure toi que tu n'as aucune fuite de mémoire dans ton code, je pense que non à 1ere vue, mais j'ai pas décortiqué.

petite infos pour gérer les fuites:
http://ftp2.ie.freesbie.org/pub/sour...e/f/fa/fastmm/


sinon 2 solutions pour économiser la mémoire:

* tente dans la mesure du possible de libérer un max. de chose AVANT l'appel récursif. Typiquement au lieu d'allouer une fois pour toutes ta TStringList, alloue la, alimente là, puis libère là dès que tu as fais ton traitement. (Car elle reste pleine, lorsque tu appelles ta fonction en récursif...)

* tente un algo NON récursif , c'est faisable.