An unexpected memory leak

Version imprimable

Bonjour tout le monde,

Me voici lancé dans la copie de fichier, après avoir fait un tour de toutes les possibilité, j'ai récupéré et corrigé une procédure de copie de fichier via TFileStream permettant de gérer 2 progressebarres visuellement.

La procédure en elle même ne génèrent aucune erreur et est trés rapide.
Mais lorsque je ferme mon programme je prend ce message ( pour inf o : ReportMemoryLeaksOnShutDown := true; dans le dpr)

An Unexpected memory leak has occurred. The unepected small block leaks are :
957-1052 bytes: Unknown * 260

Code:

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
procedure TFFicheDocExterneDOC.sBtnValiderClick(Sender: TObject);
const
  TailleBloc = 1024;
var
  pBuffer: Pointer;
  TailleSource, i, j: integer;
  DossierDestination, FileDestination: String;
  Source, Destination: TFileStream;
begin
// ...
  DossierDestination := IncludeTrailingPathDelimiter(Logiciel.UNC)+
                 IncludeTrailingPathDelimiter(Logiciel.DossierDeTravail)+
                 IncludeTrailingPathDelimiter(Logiciel.DossierDOC);
  FPauseFileStream := TFPauseFileStream.Create(Self);
  Screen.Cursor := crSQLWait;
  Try
      FPauseFileStream.Caption := 'Copie de fichier(s)...';
      FPauseFileStream.sLabelDe.Caption   := '';
      FPauseFileStream.sLabelVers.Caption := DossierDestination;
 
      FPauseFileStream.sGaugeLesFichiers.Progress := 0;
      FPauseFileStream.sGaugeLesFichiers.MaxValue := sOpenDialog1.Files.Count - 1;
      FPauseFileStream.slabelLesFichiers.Caption  := 'Fichier(s) '+inttostr(FPauseFileStream.sGaugeLesFichiers.Progress)+'/'+inttostr(FPauseFileStream.sGaugeLesFichiers.MaxValue);
 
      FPauseFileStream.sGaugeLeFichier.Progress := 0;
 
      FPauseFileStream.Show;
      FPauseFileStream.Refresh;
 
      for i := 0 to sOpenDialog1.Files.Count - 1 do
      begin
        Source := TFileStream.Create(sOpenDialog1.Files[i],fmOpenRead);
        Try
          TailleSource:= Source.Size;
 
          FPauseFileStream.sLabelDe.Caption   := ExtractFilePath(sOpenDialog1.Files[i]);
          FPauseFileStream.sGaugeLeFichier.Progress  := 0;
          FPauseFileStream.sGaugeLefichier.MaxValue  := TailleSource;
          FPauseFileStream.slabelLeFichier.Caption := sOpenDialog1.Files[i];
          FPauseFileStream.Refresh;
 
 
          Source.Position := 0;
          FileDestination := DossierDestination + ExtractFileName(sOpenDialog1.Files[i]);
          Destination := TFileStream.Create(FileDestination,fmOpenWrite or fmCreate);
          Try
            GetMem(pBuffer, TailleBloc);
            j:= 1;
            while j * TailleBloc <= TailleSource do
            begin
              Source.ReadBuffer(pBuffer^, TailleBloc);
              Destination.WriteBuffer (pBuffer^, TailleBloc);
              FPauseFileStream.sGaugeLeFichier.Progress := j * TailleBloc;
              inc(j);
            end;
            Source.ReadBuffer(pBuffer^, TailleSource- (j-1)* TailleBloc);
            Destination.WriteBuffer(pBuffer^, TailleSource- (j-1)* TailleBloc);
          Finally
            Destination.Free;
          End;
        Finally
          Source.Free;
        End;
        FPauseFileStream.sGaugeLesFichiers.Progress := FPauseFileStream.sGaugeLesFichiers.Progress + 1;
        FPauseFileStream.slabelLesFichiers.Caption  := 'Fichier(s) '+inttostr(FPauseFileStream.sGaugeLesFichiers.Progress)+'/'+inttostr(FPauseFileStream.sGaugeLesFichiers.MaxValue);
      end;
  Finally
    FreeMem(pBuffer, TailleBloc);
    Screen.Cursor := crDefault;
    FPauseFileStream.Release;
  End;
 
  ModalResult := mrOk;
 
end;

09/11/2012, 17h01
ShaiLeTroll

GetMem est dans une boucle mais FreeMem est tout seul à la fin !
GetMem doit allouer un pointeur à chaque fois, tu as confondu avec ReallocMem ?
09/11/2012, 17h15
Andnotor

La méthode CopyFrom de TStream est faite pour faire des copies par bloc ;)
09/11/2012, 18h43
BuzzLeclaire

Citation:

Envoyé par ShaiLeTroll

GetMem est dans une boucle mais FreeMem est tout seul à la fin !

Grrrrrr. Bien vu, c'était juste ça, j'te jure.

Citation:

Envoyé par ShaiLeTroll

GetMem doit allouer un pointeur à chaque fois, tu as confondu avec ReallocMem ?

Non mon bloc ne change pas de taille pas besoin.

Citation:

Envoyé par Andnotor

La méthode CopyFrom de TStream est faite pour faire des copies par bloc ;)

Impossible de gérer le transfert d'un fichier avec Copyfrom, si tu veux avoir un progresse barre lié à la taille du fichier.
Copyfrom lit par bloc tous le flux et après écrit le flux.

J'ai besoin de 2 progressbarre 1 pour les fichiers à copier un pour le fichier en lui même, comme le fait Supercopier d'ailleur.

Je vous remercie tout plein, ça marche nikel

Bye.

Citation:

Envoyé par BuzzLeclaire

Impossible de gérer le transfert d'un fichier avec Copyfrom, si tu veux avoir un progresse barre lié à la taille du fichier.

Bien sûr que oui en spécifiant un nombre d'octets à copier ;)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 const CopySize = 4096; var Source :TFileStream; Dest :TFileStream; Count :integer; begin Source := TFileStream.Create('d:\Temp\Source.bmp', fmOpenRead); Dest := TFileStream.Create('d:\Temp\Dest.bmp', fmCreate); Source.Position := 0; ProgressBar1.Max := Source.Size; repeat Count := Min(CopySize, Source.Size -Source.Position); ProgressBar1.StepBy(Count); Dest.CopyFrom(Source, Count); until Source.Position = Source.Size; Source.Free; Dest.Free; end;

12/11/2012, 21h16
BuzzLeclaire

@AndNotOr

Tu as, comme d'hab, raison.

Dans l'aide c'était pas très claire, enfin pour moi, je l'ai pourtant relu juste après ton topic...

Sinon, si je copie un fichier volumineux, est-il possible d'arrêter le traitement en cours de copy ? et par quel biais je dois mis prendre ?

Merci
13/11/2012, 07h34
SergioMaster

Coucou
un Application.ProcessMessage à l'intérieur de la boucle repeat et un test sur un condition quelconque pour faire un break devraient faire l'affaire ;)
13/11/2012, 09h49
Andnotor

Je ferais déjà cette copie dans un thread avec mise à jour de la ProgressBar par PostMessage.
Si ce thread est assigné à une variable, un simple Thread.Terminate suffirait. Sinon, une variable booléenne globale pour sortir de la boucle.

Citation:

Envoyé par BuzzLeclaire

Dans l'aide c'était pas très claire, enfin pour moi, je l'ai pourtant relu juste après ton topic...

Tu n'es pas le seul à avoir ce problème, on a en discuté dans [C++Builder] TMemoryStream : incompréhension

Pour ne pas plutôt surcharger la classe TFileStream en redéfinissant le CopyFrom et en ajoutant un event OnProgress un peu comme dans ProgressBar for TResourceStream, voir plus bas le code copié depuis StackOverflow

Cela pourrait même généraliser, une classe TStreamCopier qui gère deux TStream et fourni un OnProgress

J'avais proposé un code pour utiliser IFileOperation qui justement provoque une méthode UpdateProgress via l'interface IFileOperationProgressSink, je l'ai écrit sur le forum, pas testé car pas Vista, si quelqu'un en à l'occasion :roll:

Pour la mise en thread, de l'inspiration pourra être trouvé dans Problème de synchronisation entre Thread et VCL en plus cela concerne déjà l'écriture dans un fichier !

Un code plutôt bien écrit qui sépare proprement IHM et Stream lié par un événement !
Cela utilise TResourceStream mais cela donne une idée !
Code:

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 type TForm1 = class(TForm) Button: TButton; ProgressBar: TProgressBar; procedure ButtonClick(Sender: TObject); private procedure StreamProgress(Sender: TObject; Percentage: Single); end; var Form1: TForm1; implementation {$R *.dfm} type TStreamProgressEvent = procedure(Sender: TObject; Percentage: Single) of object; TProgressResourceStream = class(TResourceStream) private FOnProgress: TStreamProgressEvent; public procedure SaveToFile(const FileName: TFileName); property OnProgress: TStreamProgressEvent read FOnProgress write FOnProgress; end; { TProgressResourceStream } procedure TProgressResourceStream.SaveToFile(const FileName: TFileName); var Count: Int64; Stream: TStream; BlockSize: Int64; P: PAnsiChar; WriteCount: Int64; begin if Assigned(FOnProgress) then begin Count := Size; if Count <> 0 then begin Stream := TFileStream.Create(FileName, fmCreate); try if Count < 500 then BlockSize := 5 else BlockSize := Count div 50; P := Memory; WriteCount := 0; while WriteCount < Count do begin if WriteCount < Count - BlockSize then Inc(WriteCount, Stream.Write(P^, BlockSize)) else Inc(WriteCount, Stream.Write(P^, Count - WriteCount)); Inc(P, BlockSize); FOnProgress(Self, WriteCount / Count); end; finally Stream.Free; end; end; end else inherited SaveToFile(FileName); end; { TForm1 } procedure TForm1.ButtonClick(Sender: TObject); var Stream: TProgressResourceStream; begin ProgressBar.Min := 0; Stream := TProgressResourceStream.Create(HInstance, 'TFORM1', RT_RCDATA); try Stream.OnProgress := StreamProgress; Stream.SaveToFile('TForm1.dat'); finally Stream.Free; end; end; procedure TForm1.StreamProgress(Sender: TObject; Percentage: Single); begin with ProgressBar do Position := Round(Percentage * Max); end;

13/11/2012, 18h04
BuzzLeclaire

Bon,

Je vais voir tout ça, le thread ça me fou le cafard... mais faut que j'essai !!

Merci Shail pour tous tes liens, je mettrais ici "quand je serais chez moi" ce que j'ai fais pour la Gauge, ça fonctionne mieux que de jouer avec un Buffer.
J'ai juste remarqué que quand je lance la copie de bcp de fichiers et que je sors du programme, mon PC est super lent et mes 6 processeurs flambes, truc de malade, même avec delphi de fermé, si je désactive mon antivirus KASPERKY 2013 tout redeviens normal, je me demande ce que fais vraiment le traitement de copie de fichier via un TFileStream !!! ce symptôme est identique que ce soit avec Copyfrom ou via Read Write et un buffer... super étrange.

Je re pour essayer le THREAD... :?