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