6 SysUtils, Classes, Controls, Forms, IdHTTP, IdComponent,
7 {HTTPApp,} YofUtils, GikoSystem, BoardGroup, ItemDownload;
10 TThreadControl = class(TThread)
12 FItemList: TThreadList; //
\83_
\83E
\83\93\83\8d\81[
\83h
\82·
\82é
\83A
\83C
\83e
\83\80\82ð
\8ai
\94[
\82·
\82é
\83\8a\83X
\83g
13 FAbort: Boolean; //
\92\86\92f
\83t
\83\89\83O
14 FThreadList: TList; //
\8eÀ
\8dÛ
\82É
\83_
\83E
\83\93\83\8d\81[
\83h
\82·
\82é
\83X
\83\8c\83b
\83h
\83I
\83u
\83W
\83F
\83N
\83g
\82Ì
\83\8a\83X
\83g
15 FMaxThreadCount: Integer; //
\8dÅ
\91å
\83X
\83\8c\83b
\83h
\90\94
16 FOnWork: TGikoWorkEvent;
17 FOnWorkBegin: TGikoWorkBeginEvent;
18 FOnWorkEnd: TGikoWorkEndEvent;
19 FOnDownloadEnd: TDownloadEndEvent;
20 FOnDownloadMsg: TDownloadMsgEvent;
21 procedure WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer; Number: Integer; const AWorkTitle: string);
22 procedure WorkEnd(Sender: TObject; AWorkMode: TWorkMode; Number: Integer);
23 procedure Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer; Number: Integer);
24 procedure DownloadEnd(Sender: TObject; Item: TDownloadItem);
25 procedure DownloadMsg(Sender: TObject; Item: TDownloadItem; Msg: string; Icon: TGikoMessageIcon);
26 procedure SetMaxThreadCount(Count: Integer);
28 procedure Execute; override;
30 constructor Create(CreateSuspended: Boolean);
31 destructor Destroy; override;
32 procedure AddItem(Item: TDownloadItem);
33 function GetSuspendThread: TDownloadThread;
34 function GetActiveThreadCount: Integer;
35 procedure DownloadAbort;
36 property MaxThreadCount: Integer read FMaxThreadCount write SetMaxThreadCount;
37 property OnWork: TGikoWorkEvent read FOnWork write FOnWork;
38 property OnWorkBegin: TGikoWorkBeginEvent read FOnWorkBegin write FOnWorkBegin;
39 property OnWorkEnd: TGikoWorkEndEvent read FOnWorkEnd write FOnWorkEnd;
40 property OnDownloadEnd: TDownloadEndEvent read FOnDownloadEnd write FOnDownloadEnd;
41 property OnDownloadMsg: TDownloadMsgEvent read FOnDownloadMsg write FOnDownloadMsg;
46 constructor TThreadControl.Create(CreateSuspended: Boolean);
48 inherited Create(CreateSuspended);
49 FItemList := TThreadList.Create;
50 FThreadList := TList.Create;
55 destructor TThreadControl.Destroy;
60 for i := FThreadList.Count - 1 downto 0 do begin
61 TDownloadThread(FThreadList[i]).Free;
63 FThreadList.Capacity := FThreadList.Count;
70 procedure TThreadControl.AddItem(Item: TDownloadItem);
75 procedure TThreadControl.Execute;
79 FDownThread: TDownloadThread;
81 while not Terminated do begin
83 List := FItemList.LockList;
85 if List.Count > 0 then begin
86 FDownThread := GetSuspendThread;
87 if FDownThread <> nil then begin
88 FDownThread.Item := TDownloadItem(List.Items[0]);
97 for i := 0 to FThreadList.Count - 1 do begin
98 if not TDownloadThread(FThreadList[i]).Suspended then
99 TDownloadThread(FThreadList[i]).Abort;
101 List := FItemList.LockList;
105 FItemList.UnlockList;
109 Application.ProcessMessages;
111 //
\8ec
\82Á
\82Ä
\82¢
\82é
\83X
\83\8c\83b
\83h
\82ð
\91S
\82Ä
\8fI
\97¹
\82³
\82¹
\82é
\81B
112 for i := 0 to FThreadList.Count - 1 do begin
113 TDownloadThread(FThreadList[i]).Abort;
114 TDownloadThread(FThreadList[i]).Terminate;
115 if TDownloadThread(FThreadList[i]).Suspended then begin
116 TDownloadThread(FThreadList[i]).Resume;
117 TDownloadThread(FThreadList[i]).WaitFor;
123 function TThreadControl.GetSuspendThread: TDownloadThread;
126 DownloadThread: TDownloadThread;
129 if GetActiveThreadCount >= FMaxThreadCount then Exit;
130 for i := 0 to FThreadList.Count - 1 do begin
131 if TDownloadThread(FThreadList[i]).Suspended then begin
132 Result := TDownloadThread(FThreadList[i]);
136 if (Result = nil) and (FMaxThreadCount > FThreadList.Count) then begin
137 DownloadThread := TDownloadThread.Create(True);
138 DownloadThread.FreeOnTerminate := False;
139 DownloadThread.Number := FThreadList.Count;
140 DownloadThread.OnWorkBegin := WorkBegin;
141 DownloadThread.OnWorkEnd := WorkEnd;
142 DownloadThread.OnWork := Work;
143 DownloadThread.OnDownloadEnd := DownloadEnd;
144 DownloadThread.OnDownloadMsg := DownloadMsg;
145 FThreadList.Add(DownloadThread);
146 Result := DownloadThread;
150 function TThreadControl.GetActiveThreadCount: Integer;
155 for i := 0 to FThreadList.Count - 1 do begin
156 if not TDownloadThread(FThreadList[i]).Suspended then
161 procedure TThreadControl.DownloadAbort;
166 procedure TThreadControl.SetMaxThreadCount(Count: Integer);
168 if FMaxThreadCount = Count then Exit;
169 if Count <= 0 then Count := 1;
170 if Count > 10 then Count := 10;
171 FMaxThreadCount := Count;
174 procedure TThreadControl.WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer; Number: Integer; const AWorkTitle: string);
176 if Assigned(OnWorkBegin) then
177 OnWorkBegin(Sender, AWorkMode, AWorkCountMax, Number, AWorkTitle);
180 procedure TThreadControl.WorkEnd(Sender: TObject; AWorkMode: TWorkMode; Number: Integer);
182 if Assigned(OnWorkEnd) then
183 OnWorkEnd(Sender, AWorkMode, Number);
186 procedure TThreadControl.Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer; Number: Integer);
188 if Assigned(OnWork) then
189 OnWork(Sender, AWorkMode, AWorkCount, Number);
192 procedure TThreadControl.DownloadEnd(Sender: TObject; Item: TDownloadItem);
194 if Assigned(OnDownloadEnd) then
195 OnDownloadEnd(Sender, Item);
198 procedure TThreadControl.DownloadMsg(Sender: TObject; Item: TDownloadItem; Msg: string; Icon: TGikoMessageIcon);
200 if Assigned(OnDownloadMsg) then
201 OnDownloadMsg(Sender, Item, Msg, Icon);