Discussion :

[BobaL]

Salut !
Je viens chercher un coup de main...
J'ai réalisé un petit thread permettant d'utiliser la fonction CopyFileEx de façon non bloquante.
La copie se passe bien mais lorsque l'on réduit la fenêtre de l'application une exception apparaît



Peut-être que j'utilise mal la classe TThread ?
Si une âme charitable veut bien regarder mon projet de test (pièce jointe)...

Voici mon objet utilisant la class TThread

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
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
unit MyThreadCopy;
 
interface
 
uses Classes, Windows, SysUtils, ExtCtrls, SyncObjs;
 
type 
  // Evènements
  TEvtTerminated = procedure(Sender: TObject; Source, Destination: String) of object;
  TEvtExcept     = procedure(Sender: TObject; ProcedureName, Msg: String) of object;
  TEvtError      = procedure(Sender: TObject; Source, Destination, Msg: String) of object;
  TEvtProgress   = procedure(Sender: TObject; Source, Destination: String; Progress: Integer) of object;
 
  TMyThreadCopy = class(TThread)
  private
    FSource      : string;
    FDestination : string;
    FPosition    : Int64;
    FTimer       : TTimer;
    FData        : Pointer;
    FError       : TEvtError;
    FExcept      : TEvtExcept;
    FTerminated  : TEvtTerminated;
    FProgress    : TEvtProgress;
    FCriticalSection : TCriticalSection;
    procedure SendExcept(Sender: TObject; ProcedureName, Msg: string);
  protected
    procedure Execute; override;
    procedure OnTimer(Sender: TObject);
  public
    constructor Create(Source, Destination: string);
    destructor  Destroy; override;
 
    property Data         : Pointer        read FData         write FData;
 
    property OnTerminated : TEvtTerminated read FTerminated   write FTerminated;
    property OnExcept     : TEvtExcept     read FExcept       write FExcept;
    property OnError      : TEvtError      read FError        write FError;
    property OnProgress   : TEvtProgress   read FProgress     write FProgress;
  end;
 
implementation
 
 
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function CopyCallBack(TotalFileSize: LARGE_INTEGER; TotalBytesTransferred: LARGE_INTEGER; StreamSize: LARGE_INTEGER; StreamBytesTransferred: LARGE_INTEGER; dwStreamNumber: DWord; dwCallbackReason: DWord; hSourceFile: THandle; hDestinationFile: THandle; Position: PInt64): DWord; far; stdcall;
begin
  Position^ := TotalBytesTransferred.QuadPart * 100 div TotalFileSize.QuadPart;
  Result := PROGRESS_CONTINUE;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
{ TMyThreadCopy }
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
constructor TMyThreadCopy.Create(Source, Destination: string);
begin
  try
    inherited Create(True);
    FreeOnTerminate := True;
 
    FSource := Source;
    FDestination := Destination;
    FTimer := TTimer.Create(nil);
    FTimer.Interval := 500;
    FTimer.Enabled := True;
    FTimer.OnTimer := OnTimer;
    FCriticalSection := TCriticalSection.Create;
  except
    on E: Exception do SendExcept(Self, 'TMyThreadCopy.Create', E.Message);
  end;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
destructor TMyThreadCopy.Destroy;
begin
  try
    FTimer.Enabled := False;
    FreeAndNil(FTimer);
    FreeAndNil(FCriticalSection);
    inherited;
  except
    on E: Exception do SendExcept(Self, 'TMyThreadCopy.Destroy', E.Message);
  end;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TMyThreadCopy.Execute;
var
  Flag : Integer;
  Retour: LongBool;
begin
  inherited;
  try
    Flag := 0;
    Retour := False;
 
    if FileExists(FSource) then
    begin
      // Exécution de la copie
      if not CopyFileEx(PChar(FSource), PChar(FDestination), @CopyCallBack, @FPosition, @Retour, Flag) then
      begin
        if Assigned(FError) then Ferror(Self, FSource, FDestination, SysErrorMessage(GetLastError));
      end
      else
      begin
        if Assigned(FProgress) then FProgress(Self, FSource, FDestination, 100);
        if Assigned(FTerminated) then FTerminated(Self, FSource, FDestination);
      end;
    end else if Assigned(FError) then Ferror(Self, FSource, FDestination, 'The source file does not exist');
 
    FTimer.Enabled := False;
    Terminate;
  except
    on E: Exception do SendExcept(Self, 'TMyThreadCopy.Execute', E.Message);
  end;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TMyThreadCopy.OnTimer(Sender: TObject);
begin
  try
    FCriticalSection.Enter;
    try
      if Assigned(FProgress) then FProgress(Self, FSource, FDestination, FPosition);
    finally
      FCriticalSection.Leave;
    end;
  except
    on E: Exception do SendExcept(Self, 'TMyThreadCopy.OnTimer', E.Message);
  end;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TMyThreadCopy.SendExcept(Sender: TObject; ProcedureName, Msg: String);
begin
  if Assigned(FExcept) then FExcept(Self, ProcedureName, Msg);
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
end.

Merci

[Andnotor]

Tu appelles des méthodes du thread principale depuis ton thread de copie. Ce n'est pas bon du tout .

Il faut soit faire des appels synchonize ou simplement gérer OnTerminate pour récupérer le résultat de la copie.

[BobaL]

Merci pour ta réponse.
Tu fais référence au fait que j'appelle Terminate dans le Execute de mon Thread..?
Peux-tu m'en dire plus parce que je vois pas trop comment changer tout ça...

[Andnotor]

Tu fais référence au fait que j'appelle Terminate dans le Execute de mon Thread..?

Non, je parle de l'événement OnTerminate du thread (qui s'exécute dans le thread principal).
Tu mémorises simplement le résultat de CopyFileEx et le lis depuis cette procédure. Tu peux ensuite faire les branchements nécessaires.

Le Timer n'est pas bon non plus ! Envoyer un message (PostMessage) à la fiche possédant la ProgressBar serait bien mieux.

[BobaL]

J'essaie de suivre tes conseils mais ils sont un peu obscur pour moi
Voici vers quoi je m'oriente

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
unit MyThreadCopy;
 
interface
 
uses Classes, Windows, SysUtils, ExtCtrls, SyncObjs, Messages;
 
type 
  // Evènement
  TEvtExcept = procedure(Sender: TObject; ProcedureName, Msg: String) of object;
 
  TMyThreadCopy = class(TThread)
  private
    FSource      : string;
    FDestination : string;
    FData        : Pointer;
    FExcept      : TEvtExcept;
    procedure SendExcept(Sender: TObject; ProcedureName, Msg: string);
  protected
    procedure Execute; override;
  public
    constructor Create(Source, Destination: string);
    destructor  Destroy; override;
 
    property Data         : Pointer        read FData         write FData;
    property OnExcept     : TEvtExcept     read FExcept       write FExcept;
  end;
 
implementation
 
 
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
function CopyProgressRoutine(TotalFileSize: LARGE_INTEGER; TotalBytesTransferred: LARGE_INTEGER; StreamSize: LARGE_INTEGER; StreamBytesTransferred: LARGE_INTEGER; dwStreamNumber: DWord; dwCallbackReason: DWord; hSourceFile: THandle; hDestinationFile: THandle; ThreadId: PCardinal): DWord; far; stdcall;
var
  Position: Int64;
begin
  Position := TotalBytesTransferred.QuadPart * 100 div TotalFileSize.QuadPart;
  PostThreadMessage(ThreadId^, WM_USER, Integer(Position), Position);
  Result := PROGRESS_CONTINUE;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
{ TMyThreadCopy }
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
constructor TMyThreadCopy.Create(Source, Destination: string);
begin
  try
    inherited Create(True);
    FreeOnTerminate := True;
 
    FSource := Source;
    FDestination := Destination;
  except
    on E: Exception do SendExcept(Self, 'TMyThreadCopy.Create', E.Message);
  end;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
destructor TMyThreadCopy.Destroy;
begin
  try
    inherited;
  except
    on E: Exception do SendExcept(Self, 'TMyThreadCopy.Destroy', E.Message);
  end;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TMyThreadCopy.Execute;
var
  Flag : Integer;
  Retour: LongBool;
begin
  inherited;
  try
    Flag := 0;
    Retour := False;
 
    if FileExists(FSource) then
    begin
      if CopyFileEx(PChar(FSource), PChar(FDestination), @CopyProgressRoutine, @ThreadID, @Retour, Flag)
        then ExitCode := 0
        else ExitCode := 1;
    end;
  except
    on E: Exception do SendExcept(Self, 'TMyThreadCopy.Execute', E.Message);
  end;
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
procedure TMyThreadCopy.SendExcept(Sender: TObject; ProcedureName, Msg: String);
begin
  if Assigned(FExcept) then FExcept(Self, ProcedureName, Msg);
end;
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Mes problèmes sont les suivants :
- Comment récupérer les messages émis depuis le CallBack de copie (CopyProgressRoutine) ? Je voudrai récupérer toutes les progressions intermédiaires et sans Timer je vois pas comment récupérer les messages...
- Si j'arrive à récupérer les messages de progression comment vais-je les transmettre vers mon application principale (évènement ..?) ?
- J'ai supprimer les évènements pour utiliser ExitCode. Cela te semble correct dans l'utilisation du thread ?

Merci encore pour ton aide.

[Andnotor]

Le handle de la fiche est passé à CopyFileEx et CopyCallback l'utilise pour poster l'avancement à la fiche.
CopyResult est initialiser avec le résultat de la copie.

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
const
  WM_COPYPROGRESS = WM_USER;
 
type
  TMyThreadCopy = class(TThread)
  private
    Handle      :THandle;      //Fiche gérant WM_COPYPROGRESS
    Source      :TFileName;    //Source
    Dest        :TFileName;    //Destination
 
    Cancel      :boolean;      //La copie continue
    FCopyResult :integer;      //Résultat de la copie
 
  protected
    procedure Execute; override;
 
  public
    property CopyResult :integer read FCopyResult;
    constructor Create(aSource, aDest :TFileName; aHandle :THandle; aOnTerminate :TNotifyEvent);
  end;
 
implementation
 
function CopyCallback(TotalFileSize: LARGE_INTEGER; TotalBytesTransferred: LARGE_INTEGER; StreamSize: LARGE_INTEGER; StreamBytesTransferred: LARGE_INTEGER; dwStreamNumber: DWord; dwCallbackReason: DWord; hSourceFile: THandle; hDestinationFile: THandle; lpData: PCardinal): DWord; far; stdcall;
begin
  //Envoi la progression à la fiche
  PostMessage(lpData^, WM_COPYPROGRESS, TotalBytesTransferred.QuadPart, TotalFileSize.QuadPart);
  Result := PROGRESS_CONTINUE;
end;
 
{ TMyThreadCopy }
 
constructor TMyThreadCopy.Create(aSource, aDest: TFileName; aHandle: THandle; aOnTerminate: TNotifyEvent);
begin
  inherited Create(FALSE);
 
  Handle          := aHandle;
  Source          := aSource;
  Dest            := aDest;
  OnTerminate     := aOnTerminate;
  FreeOnTerminate := TRUE;
end;
 
procedure TMyThreadCopy.Execute;
begin
  Cancel := FALSE;
  CopyFileEx(PChar(Source), PChar(Dest), @CopyCallback, @Handle, @Cancel, 0);
  //Résultat de la copie
  FCopyResult := GetLastError;
end;

La fiche contient une ProgressBar et un Memo.

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
type
  TForm1 = class(TForm)
    ProgressBar1: TProgressBar;
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  protected
    procedure OnThreadTerminate(Sender :TObject);
    procedure WMCopyProgress(var Message :TMessage); message WM_COPYPROGRESS;
  end;
 
var
  Form1: TForm1;
 
 
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  TMyThreadCopy.Create('c:\temp\file1.txt', 'c:\temp\file1.bak', Handle, OnThreadTerminate);
end;
 
procedure TForm1.OnThreadTerminate(Sender: TObject);
begin
  //Résultat de la copie dans le memo
  with TMyThreadCopy(Sender) do
    Memo1.Lines.Add(Format('%d: %s', [CopyResult, SysErrorMessage(CopyResult)]));
 
  ProgressBar1.Position := 0;
end;
 
procedure TForm1.WMCopyProgress(var Message: TMessage);
begin
  //Progression de la copie
  with ProgressBar1 do
  begin
    Max      := Message.LParam;
    Position := Message.WParam;
  end;
end;