forked from alphaonex86/Supercopier
-
Notifications
You must be signed in to change notification settings - Fork 0
/
SCWorkThreadList.pas
186 lines (154 loc) · 5.87 KB
/
SCWorkThreadList.pas
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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
{
This file is part of SuperCopier.
SuperCopier is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
SuperCopier is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
}
unit SCWorkThreadList;
{$MODE Delphi}
//TODO: quand on enleve une workthread de la liste, l'enlever aussi de la liste des handles de l'API
interface
uses
Classes,SCObjectThreadList,SCBaseList,SCWorkThread,SCCommon;
type
TWorkThreadList=class(TObjectThreadList)
private
function Get(Index: Integer): TWorkThread;
procedure Put(Index: Integer; Item: TWorkThread);
public
property Items[Index: Integer]: TWorkThread read Get write Put; default;
function ProcessBaseList(BaseList:TBaseList;Operation:Cardinal;DestDir:WideString=''):TWorkThread;
procedure CreateEmptyCopyThread(IsMove:Boolean);
procedure CancelAllAndWaitTermination(Timeout:Cardinal);
constructor Create;
end;
var
WorkThreadList:TWorkThreadList;
implementation
uses ShellApi,SysUtils, Contnrs,SCCopyThread, DateUtils,Windows,Forms;
//******************************************************************************
//******************************************************************************
//******************************************************************************
// TWorkThreadList
//******************************************************************************
//******************************************************************************
//******************************************************************************
//******************************************************************************
// Create
//******************************************************************************
constructor TWorkThreadList.Create;
begin
inherited Create;
OwnsObjects:=False;
end;
//******************************************************************************
// Get
//******************************************************************************
function TWorkThreadList.Get(Index: Integer): TWorkThread;
begin
Result:=TWorkThread(inherited Get(Index));
end;
//******************************************************************************
// Put
//******************************************************************************
procedure TWorkThreadList.Put(Index: Integer; Item: TWorkThread);
begin
inherited Put(Index,Item);
end;
//******************************************************************************
// ProcessBaseList: prends en charge une opйration sur une BaseList,
// renvoie la WorkThread qui a pris en charge la BL ou nil si pas de prise en charge
//******************************************************************************
function TWorkThreadList.ProcessBaseList(BaseList:TBaseList;Operation:Cardinal;DestDir:WideString=''):TWorkThread;
var i:Integer;
GuessedSrcDir:WideString;
SameVolumeMove:Boolean;
CopyThread:TCopyThread;
begin
Result:=nil;
if BaseList.Count=0 then Exit;
dbgln('ProcessBaseList: B[0]='+BaseList[0].SrcName);
dbgln(' DD='+DestDir);
try
Lock;
case Operation of
FO_RENAME:
Result:=nil;
FO_DELETE:
Result:=nil; // non supportй pour le moment
FO_MOVE,
FO_COPY:
begin
GuessedSrcDir:=ExtractFilePath(BaseList[0].SrcName);
SameVolumeMove:=(Operation=FO_MOVE) and SameVolume(GuessedSrcDir,DestDir);
if SameVolumeMove then
begin
Result:=nil; // non supportй pour le moment
end
else
begin
Result:=nil;
CopyThread:=nil;
i:=0;
while (i<Count) and (Result=nil) do
begin
if Items[i].ThreadType=wttCopy then
begin
CopyThread:=Items[i] as TCopyThread;
if (CopyThread.IsMove=(Operation=FO_MOVE)) and CopyThread.CanHandle(GuessedSrcDir,DestDir) then
Result:=CopyThread;
end;
Inc(i);
end;
if Result=nil then // aucune CopyThread ne peut prendre en charge l'opйration -> on en crйe une nouvelle
begin
CopyThread:=TCopyThread.Create(Operation=FO_MOVE);
Add(CopyThread); // rescencer la thread
Result:=CopyThread;
end;
CopyThread.AddBaseList(BaseList,amSpecifyDest,DestDir);
end;
end;
end;
finally
Unlock;
end;
end;
//******************************************************************************
// CreateEmptyCopyThread: crйe une fenкtre de copie vide
//******************************************************************************
procedure TWorkThreadList.CreateEmptyCopyThread(IsMove:Boolean);
var CopyThread:TCopyThread;
begin
CopyThread:=TCopyThread.Create(IsMove);
Add(CopyThread);
end;
//******************************************************************************
// CancelAllAndWaitTermination: annule tout les traitements et attends la fin des threads
//******************************************************************************
procedure TWorkThreadList.CancelAllAndWaitTermination(Timeout:Cardinal);
var i:Integer;
t:Cardinal;
Ok:Boolean;
begin
// annulation
for i:=Count-1 downto 0 do Items[i].Cancel;
// attente
t:=GetTickCount;
repeat
try
Lock;
Ok:=Count=0;
finally
Unlock
end;
Sleep(DEFAULT_WAIT);
Application.ProcessMessages;
until Ok or (GetTickCount>=t+Timeout);
end;
end.