Discussion :

[BuzzLeclaire]

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 :

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

[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 ?

[Andnotor]

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

[BuzzLeclaire]

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

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

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

Non mon bloc ne change pas de taille pas besoin.

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.

[Andnotor]

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 :

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

[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

[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

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

[ShaiLeTroll]

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

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 :

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

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