Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/ThreadControl.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1.1.1 - (show annotations) (download) (as text) (vendor branch)
Sat Aug 9 13:51:12 2003 UTC (20 years, 8 months ago) by hi_
Branch: hi
CVS Tags: b33
Changes since 1.1: +0 -0 lines
File MIME type: text/x-pascal
ソキオャコ?ョ

1 unit ThreadControl;
2
3 interface
4
5 uses
6 SysUtils, Classes, Controls, Forms, IdHTTP, IdComponent,
7 HTTPApp, GikoSystem, BoardGroup, ItemDownload;
8
9 type
10 TThreadControl = class(TThread)
11 private
12 FItemList: TThreadList; // 繝?繧ヲ繝ウ繝ュ繝シ繝峨☆繧九い繧、繝?Β繧呈?シ邏阪☆繧九Μ繧ケ繝?/span>
13 FAbort: Boolean; // 荳ュ譁ュ繝輔Λ繧ー
14 FThreadList: TList; // 螳滄圀縺ォ繝?繧ヲ繝ウ繝ュ繝シ繝峨☆繧九せ繝ャ繝?ラ繧ェ繝悶ず繧ァ繧ッ繝医?繝ェ繧ケ繝?/span>
15 FMaxThreadCount: Integer; // 譛?螟ァ繧ケ繝ャ繝?ラ謨ー
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);
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);
27 protected
28 procedure Execute; override;
29 public
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;
42 end;
43
44 implementation
45
46 constructor TThreadControl.Create(CreateSuspended: Boolean);
47 begin
48 inherited Create(CreateSuspended);
49 FItemList := TThreadList.Create;
50 FThreadList := TList.Create;
51
52 FAbort := False;
53 end;
54
55 destructor TThreadControl.Destroy;
56 var
57 i: Integer;
58 begin
59 for i := 0 to FThreadList.Count - 1 do begin
60 TDownloadThread(FThreadList[i]).Free;
61 end;
62 FThreadList.Free;
63 FItemList.Free;
64 inherited;
65 end;
66
67 procedure TThreadControl.AddItem(Item: TDownloadItem);
68 begin
69 FItemList.Add(Item);
70 end;
71
72 procedure TThreadControl.Execute;
73 var
74 List: TList;
75 i: Integer;
76 FDownThread: TDownloadThread;
77 begin
78 while not Terminated do begin
79 Sleep(10);
80 List := FItemList.LockList;
81 try
82 if List.Count > 0 then begin
83 FDownThread := GetSuspendThread;
84 if FDownThread <> nil then begin
85 FDownThread.Item := TDownloadItem(List.Items[0]);
86 List.Delete(0);
87 FDownThread.Resume;
88 end;
89 end;
90 finally
91 FItemList.UnlockList;
92 end;
93 if FAbort then begin
94 for i := 0 to FThreadList.Count - 1 do begin
95 if not TDownloadThread(FThreadList[i]).Suspended then
96 TDownloadThread(FThreadList[i]).Abort;
97 end;
98 List := FItemList.LockList;
99 try
100 List.Clear;
101 finally
102 FItemList.UnlockList;
103 end;
104 FAbort := False;
105 end;
106 end;
107 for i := 0 to FThreadList.Count - 1 do begin
108 TDownloadThread(FThreadList[i]).Terminate;
109 if TDownloadThread(FThreadList[i]).Suspended then
110 TDownloadThread(FThreadList[i]).Resume;
111 end;
112
113 end;
114
115 function TThreadControl.GetSuspendThread: TDownloadThread;
116 var
117 i: Integer;
118 DownloadThread: TDownloadThread;
119 begin
120 Result := nil;
121 if GetActiveThreadCount >= FMaxThreadCount then Exit;
122 for i := 0 to FThreadList.Count - 1 do begin
123 if TDownloadThread(FThreadList[i]).Suspended then begin
124 Result := TDownloadThread(FThreadList[i]);
125 Break;
126 end;
127 end;
128 if (Result = nil) and (FMaxThreadCount > FThreadList.Count) then begin
129 DownloadThread := TDownloadThread.Create(True);
130 DownloadThread.FreeOnTerminate := False;
131 DownloadThread.Number := FThreadList.Count;
132 DownloadThread.OnWorkBegin := WorkBegin;
133 DownloadThread.OnWorkEnd := WorkEnd;
134 DownloadThread.OnWork := Work;
135 DownloadThread.OnDownloadEnd := DownloadEnd;
136 DownloadThread.OnDownloadMsg := DownloadMsg;
137 FThreadList.Add(DownloadThread);
138 Result := DownloadThread;
139 end;
140 end;
141
142 function TThreadControl.GetActiveThreadCount: Integer;
143 var
144 i: Integer;
145 begin
146 Result := 0;
147 for i := 0 to FThreadList.Count - 1 do begin
148 if not TDownloadThread(FThreadList[i]).Suspended then
149 Inc(Result);
150 end;
151 end;
152
153 procedure TThreadControl.DownloadAbort;
154 begin
155 FAbort := True;
156 end;
157
158 procedure TThreadControl.SetMaxThreadCount(Count: Integer);
159 begin
160 if FMaxThreadCount = Count then Exit;
161 if Count <= 0 then Count := 1;
162 if Count > 10 then Count := 10;
163 FMaxThreadCount := Count;
164 end;
165
166 procedure TThreadControl.WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer; Number: Integer);
167 begin
168 if Assigned(OnWorkBegin) then
169 OnWorkBegin(Sender, AWorkMode, AWorkCountMax, Number);
170 end;
171
172 procedure TThreadControl.WorkEnd(Sender: TObject; AWorkMode: TWorkMode; Number: Integer);
173 begin
174 if Assigned(OnWorkEnd) then
175 OnWorkEnd(Sender, AWorkMode, Number);
176 end;
177
178 procedure TThreadControl.Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer; Number: Integer);
179 begin
180 if Assigned(OnWork) then
181 OnWork(Sender, AWorkMode, AWorkCount, Number);
182 end;
183
184 procedure TThreadControl.DownloadEnd(Sender: TObject; Item: TDownloadItem);
185 begin
186 if Assigned(OnDownloadEnd) then
187 OnDownloadEnd(Sender, Item);
188 end;
189
190 procedure TThreadControl.DownloadMsg(Sender: TObject; Item: TDownloadItem; Msg: string; Icon: TGikoMessageIcon);
191 begin
192 if Assigned(OnDownloadMsg) then
193 OnDownloadMsg(Sender, Item, Msg, Icon);
194 end;
195
196 end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26