1 | //****************************************************
|
---|
2 | // IEMultiDownload *
|
---|
3 | // For Delphi 5 - 2009 *
|
---|
4 | // Freeware Component *
|
---|
5 | // by *
|
---|
6 | // *
|
---|
7 | // Eran Bodankin (bsalsa) *
|
---|
8 | // bsalsa@gmail.com *
|
---|
9 | // *
|
---|
10 | // Documentation and updated versions: *
|
---|
11 | // http://www.bsalsa.com *
|
---|
12 | //****************************************************
|
---|
13 |
|
---|
14 | {*******************************************************************************}
|
---|
15 | {LICENSE:
|
---|
16 | THIS SOFTWARE IS PROVIDED TO YOU "AS IS" WITHOUT WARRANTY OF ANY KIND,
|
---|
17 | EITHER EXPRESSED OR IMPLIED INCLUDING BUT NOT LIMITED TO THE APPLIED
|
---|
18 | WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
|
---|
19 | YOU ASSUME THE ENTIRE RISK AS TO THE ACCURACY AND THE USE OF THE SOFTWARE
|
---|
20 | AND ALL OTHER RISK ARISING OUT OF THE USE OR PERFORMANCE OF THIS SOFTWARE
|
---|
21 | AND DOCUMENTATION. BSALSA PRODUCTIONS DOES NOT WARRANT THAT THE SOFTWARE IS ERROR-FREE
|
---|
22 | OR WILL OPERATE WITHOUT INTERRUPTION. THE SOFTWARE IS NOT DESIGNED, INTENDED
|
---|
23 | OR LICENSED FOR USE IN HAZARDOUS ENVIRONMENTS REQUIRING FAIL-SAFE CONTROLS,
|
---|
24 | INCLUDING WITHOUT LIMITATION, THE DESIGN, CONSTRUCTION, MAINTENANCE OR
|
---|
25 | OPERATION OF NUCLEAR FACILITIES, AIRCRAFT NAVIGATION OR COMMUNICATION SystemS,
|
---|
26 | AIR TRAFFIC CONTROL, AND LIFE SUPPORT OR WEAPONS SystemS. VSOFT SPECIFICALLY
|
---|
27 | DISCLAIMS ANY EXPRES OR IMPLIED WARRANTY OF FITNESS FOR SUCH PURPOSE.
|
---|
28 |
|
---|
29 | You may use, change or modify the component under 4 conditions:
|
---|
30 | 1. In your website, add a Link to "http://www.bsalsa.com"
|
---|
31 | 2. In your application, add credits to "Embedded Web Browser"
|
---|
32 | 3. Mail me (bsalsa@gmail.com) any code change in the unit
|
---|
33 | for the benefit of the other users.
|
---|
34 | 4. Please consider donation in our web site!
|
---|
35 | {*******************************************************************************}
|
---|
36 |
|
---|
37 | unit IEMultiDownload;
|
---|
38 |
|
---|
39 | {$I EWB.inc}
|
---|
40 |
|
---|
41 | interface
|
---|
42 |
|
---|
43 | uses
|
---|
44 | WinInet, MSHTML_EWB, Windows, SysUtils, Classes, Forms, ExtCtrls,
|
---|
45 | IEDownload, IEParser, EwbUrl;
|
---|
46 |
|
---|
47 | type
|
---|
48 | TIEMultiDownload = class;
|
---|
49 |
|
---|
50 | TMultiState = (msBusy, msReady, msStopped);
|
---|
51 | TMultiDownloadOptions = (doAll, doImages, doPages, doVideo, doMusic);
|
---|
52 |
|
---|
53 | TDownloadItem = class(TCollectionItem)
|
---|
54 | private
|
---|
55 | FFileName: WideString;
|
---|
56 | FPassword: WideString;
|
---|
57 | FPath: WideString;
|
---|
58 | FPort: integer;
|
---|
59 | FProtocol: WideString;
|
---|
60 | FRef: WideString;
|
---|
61 | FRoot: WideString;
|
---|
62 | FUser: WideString;
|
---|
63 | procedure Set_Ref(const Value: WideString);
|
---|
64 | procedure SetFileName(const Value: WideString);
|
---|
65 | procedure SetPassword(const Value: WideString);
|
---|
66 | procedure SetPath(const Value: WideString);
|
---|
67 | procedure SetPort(const Value: integer);
|
---|
68 | procedure SetProtocol(const Value: WideString);
|
---|
69 | procedure SetRoot(const Value: WideString);
|
---|
70 | procedure SetUser(const Value: WideString);
|
---|
71 | public
|
---|
72 | procedure Assign(Source: TPersistent); override;
|
---|
73 | published
|
---|
74 | property FileName: WideString read FFileName write SetFileName;
|
---|
75 | property Ref: WideString read FRef write Set_Ref;
|
---|
76 | property Password: WideString read FPassword write SetPassword;
|
---|
77 | property Path: WideString read FPath write SetPath;
|
---|
78 | property Port: integer read FPort write SetPort;
|
---|
79 | property Protocol: WideString read FProtocol write SetProtocol;
|
---|
80 | property Root: WideString read FRoot write SetRoot;
|
---|
81 | property User: WideString read FUser write SetUser;
|
---|
82 | end;
|
---|
83 |
|
---|
84 | TDownloadList = class(TCollection)
|
---|
85 | private
|
---|
86 | FIEMD: TIEMultiDownload;
|
---|
87 | function GetItem(Index: Integer): TDownloadItem;
|
---|
88 | procedure SetItem(Index: Integer; Value: TDownloadItem);
|
---|
89 | protected
|
---|
90 | function GetOwner: TPersistent; override;
|
---|
91 | public
|
---|
92 | constructor Create(IEMD: TIEMultiDownload);
|
---|
93 | function Add: TDownloadItem;
|
---|
94 | function Insert(Index: Integer): TDownloadItem;
|
---|
95 | function IsListed(const aRef: WideString): Boolean;
|
---|
96 | procedure DeleteItem(Index: Integer);
|
---|
97 | procedure ClearItems;
|
---|
98 | public
|
---|
99 | property Items[index: Integer]: TDownloadItem read GetItem write SetItem; default;
|
---|
100 | end;
|
---|
101 |
|
---|
102 | TOnMultiBeforeDownloadEvent = procedure(Sender: TObject; const hRef: WideString; const Item: TDownloadItem; var Cancel: boolean) of object;
|
---|
103 | TOnMultiCompleteEvent = procedure(Sender: TObject; const DownloadedList: TStrings) of object;
|
---|
104 | TOnMultiGetDocInfoEvent = procedure(Sender: TObject; const Text: string) of object;
|
---|
105 | TOnMultiGetImageEvent = procedure(Sender: TObject; const ImgName: string; var Cancel: Boolean) of object;
|
---|
106 | TOnMultiGetLinkEvent = procedure(Sender: TObject; const hRef, Host, HostName, PathName, Port, Protocol, MimeType, NameProp: string; var Cancel: Boolean) of object;
|
---|
107 | TOnMultiGetQueryInfoEvent = procedure(const MimeType, Encoding, Disposition: string) of object;
|
---|
108 | TOnMultiItemAddedEvent = procedure(Sender: TObject; const hRef, hProtocol, hRoot, hPath, hFileName, hUser, hPassword: WideString; const hPort: integer) of object;
|
---|
109 | TOnMultiParseCompleteEvent = procedure(Sender: TObject; Doc: IhtmlDocument2; All: IHtmlElementCollection) of object;
|
---|
110 | TOnMultiParseDocumentEvent = procedure(Sender: TObject; const Res: HRESULT; stMessage: string) of object;
|
---|
111 | TOnMultiParseErrorEvent = procedure(Sender: TObject; const ErrorCode: integer; const Url, stError: string) of object;
|
---|
112 | TOnMultiParseProgressEvent = procedure(Sender: TObject; const ulProgress, ulProgressMax: integer) of object;
|
---|
113 | TOnMultiStateChangeEvent = procedure(Sender: TObject; const State: TMultiState) of object;
|
---|
114 | TOnMultiStartParsingEvent = procedure(Sender: TObject; const aUrl: WideString) of object;
|
---|
115 |
|
---|
116 | TIEMultiDownload = class(TCustomIEDownload)
|
---|
117 | private
|
---|
118 | FAbout: string;
|
---|
119 | FBaseFolder: WideString;
|
---|
120 | FBaseUrl: WideString;
|
---|
121 | FAbort: Boolean;
|
---|
122 | FDownloadLevel: integer;
|
---|
123 | FFromBaseSiteOnly: Boolean;
|
---|
124 | FGetCompleteBaseSite: Boolean;
|
---|
125 | FItems: TDownloadList;
|
---|
126 | FMultiDownloadOptions: TMultiDownloadOptions;
|
---|
127 | FMultiState: TMultiState;
|
---|
128 | FMaxItems: integer;
|
---|
129 | FOnMultiBeforeDownload: TOnMultiBeforeDownloadEvent;
|
---|
130 | FOnMultiComplete: TOnMultiCompleteEvent;
|
---|
131 | FOnMultiGetDocInfo: TOnMultiGetDocInfoEvent;
|
---|
132 | FOnMultiGetImage: TOnMultiGetImageEvent;
|
---|
133 | FOnMultiGetLink: TOnMultiGetLinkEvent;
|
---|
134 | FOnMultiGetQueryInfo: TOnMultiGetQueryInfoEvent;
|
---|
135 | FOnMultiItemAdded: TOnMultiItemAddedEvent;
|
---|
136 | FOnMultiParseComplete: TOnMultiParseCompleteEvent;
|
---|
137 | FOnMultiParseDocument: TOnMultiParseDocumentEvent;
|
---|
138 | FOnMultiParseError: TOnMultiParseErrorEvent;
|
---|
139 | FOnMultiParseProgress: TOnMultiParseProgressEvent;
|
---|
140 | FOnMultiStateChange: TOnMultiStateChangeEvent;
|
---|
141 | FOnMultiStartParsing: TOnMultiStartParsingEvent;
|
---|
142 | FOpenFolder: boolean;
|
---|
143 | FProgress, FProgressMax: integer;
|
---|
144 | FTimer: TTimer;
|
---|
145 | FRoorUrl: string;
|
---|
146 | HtmlParser: TIEParser;
|
---|
147 | slDownloadedList: TStringList;
|
---|
148 | UrlParser: TUrl;
|
---|
149 | procedure DoOnExit;
|
---|
150 | procedure DownloadList(const aItems: TDownloadList);
|
---|
151 | procedure MultiAnchor(Sender: TObject; hRef, Target, Rel, Rev, Urn, Methods, Name, Host, HostName, PathName, Port, Protocol, Search, Hash, AccessKey, ProtocolLong, MimeType, NameProp: string; Element: TElementInfo);
|
---|
152 | procedure MultiGetDocInfo(Sender: TObject; const Text: string);
|
---|
153 | procedure MultiGetQueryInfo(const MimeType, Encoding, Disposition: string);
|
---|
154 | procedure MultiImage(Sender: TObject; Source: string; ImgElement: IHTMLImgElement; Element: TElementInfo);
|
---|
155 | procedure MultiParseComplete(Sender: TObject; Doc: IhtmlDocument2; All: IHtmlElementCollection);
|
---|
156 | procedure MultiParseDocument(Sender: TObject; const Res: HRESULT; stMessage: string);
|
---|
157 | procedure MultiParseError(Sender: TObject; const ErrorCode: integer; const Url, stError: string);
|
---|
158 | procedure MultiStartParsing(Sender: TObject; const aUrl: WideString);
|
---|
159 | procedure SetAbout(Value: string);
|
---|
160 | procedure SetItems(Value: TDownloadList);
|
---|
161 | procedure SetMaxItems(Value: Integer);
|
---|
162 | procedure MultiTimer(Sender: TObject);
|
---|
163 | protected
|
---|
164 | public
|
---|
165 | constructor Create(AOwner: TComponent); override;
|
---|
166 | destructor Destroy; override;
|
---|
167 | function AddItem(const aRef: string): TDownloadItem;
|
---|
168 | procedure GoMulti(BaseUrl: WideString);
|
---|
169 | procedure SetDownloadOptions(const Value: TMultiDownloadOptions);
|
---|
170 | procedure Stop;
|
---|
171 |
|
---|
172 | public
|
---|
173 | property DownloadedList: TStringList read slDownloadedList;
|
---|
174 | property MultiState: TMultiState read FMultiState;
|
---|
175 | published
|
---|
176 | property About: string read FAbout write SetAbout;
|
---|
177 | property BaseUrl: WideString read FBaseUrl write FBaseUrl;
|
---|
178 | property DownloadLevel: integer read FDownloadLevel write FDownloadLevel default 1;
|
---|
179 | property DownloadOptions: TMultiDownloadOptions read FMultiDownloadOptions write SetDownloadOptions default doAll;
|
---|
180 | property FromBaseSiteOnly: boolean read FFromBaseSiteOnly write FFromBaseSiteOnly default True;
|
---|
181 | property GetCompleteBaseSite: boolean read FGetCompleteBaseSite write FGetCompleteBaseSite default False;
|
---|
182 | property Items: TDownloadList read FItems write SetItems;
|
---|
183 | property MaxItems: integer read FMaxItems write SetMaxItems default 100;
|
---|
184 | property OnMultiBeforeDownload: TOnMultiBeforeDownloadEvent read FOnMultiBeforeDownload write FOnMultiBeforeDownload;
|
---|
185 | property OnMultiComplete: TOnMultiCompleteEvent read FOnMultiComplete write FOnMultiComplete;
|
---|
186 | property OnMultiGetDocInfo: TOnMultiGetDocInfoEvent read FOnMultiGetDocInfo write FOnMultiGetDocInfo;
|
---|
187 | property OnMultiGetImage: TOnMultiGetImageEvent read FOnMultiGetImage write FOnMultiGetImage;
|
---|
188 | property OnMultiGetLink: TOnMultiGetLinkEvent read FOnMultiGetLink write FOnMultiGetLink;
|
---|
189 | property OnMultiGetQueryInfo: TOnMultiGetQueryInfoEvent read FOnMultiGetQueryInfo write FOnMultiGetQueryInfo;
|
---|
190 | property OnMultiItemAdded: TOnMultiItemAddedEvent read FOnMultiItemAdded write FOnMultiItemAdded;
|
---|
191 | property OnMultiParseComplete: TOnMultiParseCompleteEvent read FOnMultiParseComplete write FOnMultiParseComplete;
|
---|
192 | property OnMultiParseDocument: TOnMultiParseDocumentEvent read FOnMultiParseDocument write FOnMultiParseDocument;
|
---|
193 | property OnMultiParseError: TOnMultiParseErrorEvent read FOnMultiParseError write FOnMultiParseError;
|
---|
194 | property OnMultiParseProgress: TOnMultiParseProgressEvent read FOnMultiParseProgress write FOnMultiParseProgress;
|
---|
195 | property OnMultiStateChange: TOnMultiStateChangeEvent read FOnMultiStateChange write FOnMultiStateChange;
|
---|
196 | property OnMultiStartParsing: TOnMultiStartParsingEvent read FOnMultiStartParsing write FOnMultiStartParsing;
|
---|
197 | end;
|
---|
198 |
|
---|
199 | implementation
|
---|
200 |
|
---|
201 | uses
|
---|
202 | IEDownloadTools;
|
---|
203 |
|
---|
204 | procedure TDownloadItem.Assign(Source: TPersistent);
|
---|
205 | var
|
---|
206 | Item: TDownloadItem;
|
---|
207 | begin
|
---|
208 | if (Source is TDownloadItem) then
|
---|
209 | begin
|
---|
210 | Item := (Source as TDownloadItem);
|
---|
211 | FRef := Item.Ref;
|
---|
212 | FProtocol := Item.Protocol;
|
---|
213 | FRoot := Item.Root;
|
---|
214 | FPort := Item.Port;
|
---|
215 | FFileName := Item.FileName;
|
---|
216 | FUser := Item.User;
|
---|
217 | FPassword := Item.Password;
|
---|
218 | FPath := Item.Path;
|
---|
219 | end
|
---|
220 | else
|
---|
221 | begin
|
---|
222 | inherited Assign(Source);
|
---|
223 | end;
|
---|
224 | end;
|
---|
225 |
|
---|
226 | procedure TDownloadItem.SetFileName(const Value: WideString);
|
---|
227 | begin
|
---|
228 | if FFileName <> Value then
|
---|
229 | FFileName := Value;
|
---|
230 | end;
|
---|
231 |
|
---|
232 | procedure TDownloadItem.SetPath(const Value: WideString);
|
---|
233 | begin
|
---|
234 | if FPath <> Value then
|
---|
235 | FPath := Value;
|
---|
236 | end;
|
---|
237 |
|
---|
238 | procedure TDownloadItem.SetRoot(const Value: WideString);
|
---|
239 | begin
|
---|
240 | if FRoot <> Value then
|
---|
241 | FRoot := Value;
|
---|
242 | end;
|
---|
243 |
|
---|
244 | procedure TDownloadItem.SetPort(const Value: integer);
|
---|
245 | begin
|
---|
246 | if FPort <> Value then
|
---|
247 | FPort := Value;
|
---|
248 | end;
|
---|
249 |
|
---|
250 | procedure TDownloadItem.SetUser(const Value: WideString);
|
---|
251 | begin
|
---|
252 | if FUser <> Value then
|
---|
253 | FUser := Value;
|
---|
254 | end;
|
---|
255 |
|
---|
256 | procedure TDownloadItem.SetPassword(const Value: WideString);
|
---|
257 | begin
|
---|
258 | if FPassword <> Value then
|
---|
259 | FPassword := Value;
|
---|
260 | end;
|
---|
261 |
|
---|
262 | procedure TDownloadItem.Set_Ref(const Value: WideString);
|
---|
263 | begin
|
---|
264 | if FRef <> Value then
|
---|
265 | FRef := Value;
|
---|
266 | end;
|
---|
267 |
|
---|
268 | procedure TDownloadItem.SetProtocol(const Value: WideString);
|
---|
269 | begin
|
---|
270 | if FProtocol <> Value then
|
---|
271 | FProtocol := Value;
|
---|
272 | end;
|
---|
273 |
|
---|
274 | //-------------------------------------------------------------------------------
|
---|
275 |
|
---|
276 | procedure TDownloadList.DeleteItem(Index: Integer);
|
---|
277 | begin
|
---|
278 | Delete(Index);
|
---|
279 | end;
|
---|
280 |
|
---|
281 | procedure TDownloadList.ClearItems;
|
---|
282 | begin
|
---|
283 | Clear;
|
---|
284 | end;
|
---|
285 |
|
---|
286 | function TDownloadList.GetItem(Index: Integer): TDownloadItem;
|
---|
287 | begin
|
---|
288 | Result := TDownloadItem(inherited GetItem(Index));
|
---|
289 | end;
|
---|
290 |
|
---|
291 | procedure TDownloadList.SetItem(Index: Integer; Value: TDownloadItem);
|
---|
292 | begin
|
---|
293 | inherited SetItem(Index, Value);
|
---|
294 | end;
|
---|
295 |
|
---|
296 | function TDownloadList.Add: TDownloadItem;
|
---|
297 | begin
|
---|
298 | Result := TDownloadItem(inherited Add);
|
---|
299 | end;
|
---|
300 |
|
---|
301 | function TDownloadList.Insert(Index: Integer): TDownloadItem;
|
---|
302 | begin
|
---|
303 | Result := Add;
|
---|
304 | Result.Index := Index;
|
---|
305 | end;
|
---|
306 |
|
---|
307 | function TDownloadList.IsListed(const aRef: WideString): Boolean;
|
---|
308 | var
|
---|
309 | I: Integer;
|
---|
310 | begin
|
---|
311 | Result := True;
|
---|
312 | for I := 0 to Count - 1 do
|
---|
313 | if CompareText(LowerCase(Items[I].FRef), LowerCase(aRef)) = 0 then
|
---|
314 | Exit;
|
---|
315 | Result := False;
|
---|
316 | end;
|
---|
317 |
|
---|
318 | constructor TDownloadList.Create(IEMD: TIEMultiDownload);
|
---|
319 | begin
|
---|
320 | inherited Create(TDownloadItem);
|
---|
321 | FIEMD := IEMD;
|
---|
322 | end;
|
---|
323 |
|
---|
324 | function TDownloadList.GetOwner: TPersistent;
|
---|
325 | begin
|
---|
326 | Result := FIEMD;
|
---|
327 | end;
|
---|
328 |
|
---|
329 | //-------------------------------------------------------------------------------
|
---|
330 |
|
---|
331 | function TIEMultiDownload.AddItem(const aRef: string): TDownloadItem;
|
---|
332 | var
|
---|
333 | UP: TUrl;
|
---|
334 | begin
|
---|
335 | Result := nil;
|
---|
336 | if (not FItems.isListed(aRef)) and (FItems.Count <> FMaxItems) and
|
---|
337 | (IEDownloadTools.IsValidURL(aRef)) then
|
---|
338 | begin
|
---|
339 | slDownloadedList.Add(aRef);
|
---|
340 | UP := TUrl.Create(aRef);
|
---|
341 | UP.Clear;
|
---|
342 | UP.QueryUrl(aRef);
|
---|
343 | with FItems.Add do
|
---|
344 | begin
|
---|
345 | FRef := aRef;
|
---|
346 | FProtocol := UP.Protocol;
|
---|
347 | FRoot := UP.HostName;
|
---|
348 | FPort := UP.Port;
|
---|
349 | FFileName := UP.Document;
|
---|
350 | FUser := UP.UserName;
|
---|
351 | FPassword := UP.Password;
|
---|
352 | FPath := CharReplace(UP.UrlPath, '/', '\');
|
---|
353 | ;
|
---|
354 | if (FPath = Trim('/')) or (FPath = Trim('\')) then
|
---|
355 | FPath := EmptyStr;
|
---|
356 | if Assigned(FOnMultiItemAdded) then
|
---|
357 | FOnMultiItemAdded(Self, FRef, FProtocol, FRoot, FPath, FFileName,
|
---|
358 | FUser, FPassword, FPort);
|
---|
359 | end;
|
---|
360 | UP.Free;
|
---|
361 | end;
|
---|
362 | end;
|
---|
363 |
|
---|
364 | procedure TIEMultiDownload.DownloadList(const aItems: TDownloadList);
|
---|
365 | var
|
---|
366 | bCancel: Boolean;
|
---|
367 | I: integer;
|
---|
368 | FDLFolder: WideString;
|
---|
369 | begin
|
---|
370 | if (not FAbort) then
|
---|
371 | for I := 0 to aItems.Count - 1 do
|
---|
372 | begin
|
---|
373 | if FAbort then
|
---|
374 | Exit;
|
---|
375 | with aItems.Items[I] do
|
---|
376 | begin
|
---|
377 | bCancel := False;
|
---|
378 | if Assigned(FOnMultiBeforeDownload) then
|
---|
379 | FOnMultiBeforeDownload(Self, aItems.Items[I].FRef, aItems.Items[I], bCancel);
|
---|
380 | if not bCancel then
|
---|
381 | begin
|
---|
382 | FDLFolder := FBaseFolder + aItems.Items[I].FRoot +
|
---|
383 | IncludeTrailingPathDelimiter(aItems.Items[I].FPath);
|
---|
384 | if (aItems.Items[I].FRef <> EmptyStr) then
|
---|
385 | Go(aItems.Items[I].FRef, aItems.Items[I].FFileName, FDLFolder);
|
---|
386 | FDLFolder := EmptyStr;
|
---|
387 | end;
|
---|
388 | end;
|
---|
389 | end;
|
---|
390 | end;
|
---|
391 |
|
---|
392 | procedure TIEMultiDownload.GoMulti(BaseUrl: WideString);
|
---|
393 | var
|
---|
394 | I: integer;
|
---|
395 | begin
|
---|
396 | Reset;
|
---|
397 | FAbort := False;
|
---|
398 | FProgress := 0;
|
---|
399 | FProgressMax := 100;
|
---|
400 | FMultiState := msBusy;
|
---|
401 | if Assigned(FOnMultiStateChange) then
|
---|
402 | FOnMultiStateChange(Self, FMultiState);
|
---|
403 | if OpenDownloadFolder = True then
|
---|
404 | begin
|
---|
405 | FOpenFolder := True;
|
---|
406 | OpenDownloadFolder := False;
|
---|
407 | end;
|
---|
408 | if DownloadFolder = EmptyStr then
|
---|
409 | DownloadFolder := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName) + 'Downloads');
|
---|
410 | FBaseFolder := DownloadFolder;
|
---|
411 | for I := 0 to FItems.Count - 1 do
|
---|
412 | begin
|
---|
413 | if (FItems[i].FRef <> EmptyStr) then
|
---|
414 | DownloadList(FItems);
|
---|
415 | end;
|
---|
416 | if (BaseUrl <> EmptyStr) then
|
---|
417 | begin
|
---|
418 | UrlParser := TUrl.Create(BaseUrl);
|
---|
419 | UrlParser.CrackUrl(BaseUrl, ICU_ESCAPE);
|
---|
420 | FRoorUrl := UrlParser.HostName;
|
---|
421 | with HtmlParser do
|
---|
422 | begin
|
---|
423 | FTimer := TTimer.Create(nil);
|
---|
424 | FTimer.Enabled := True;
|
---|
425 | FTimer.Interval := 500;
|
---|
426 | FTimer.OnTimer := MultiTimer;
|
---|
427 | OnAnchor := MultiAnchor;
|
---|
428 | OnImage := MultiImage;
|
---|
429 | OnParseDocument := MultiParseDocument;
|
---|
430 | OnParseComplete := MultiParseComplete;
|
---|
431 | OnParseError := MultiParseError;
|
---|
432 | OnDocInfo := MultiGetDocInfo;
|
---|
433 | OnQueryInfo := MultiGetQueryInfo;
|
---|
434 | OnStartParsing := MultiStartParsing;
|
---|
435 | Parse(BaseUrl);
|
---|
436 | if (not FGetCompleteBaseSite) then
|
---|
437 | begin
|
---|
438 | if Assigned(FTimer) then
|
---|
439 | FreeAndNil(FTimer);
|
---|
440 | DownloadList(FItems);
|
---|
441 | end
|
---|
442 | else
|
---|
443 | begin
|
---|
444 | if (not FAbort) then
|
---|
445 | for I := 0 to slDownloadedList.Count - 1 do
|
---|
446 | begin
|
---|
447 | Parse(slDownloadedList[I]);
|
---|
448 | if Assigned(FTimer) then
|
---|
449 | FreeAndNil(FTimer);
|
---|
450 | end;
|
---|
451 | DownloadList(FItems);
|
---|
452 | end;
|
---|
453 | end;
|
---|
454 | if UrlParser <> nil then
|
---|
455 | FreeAndNil(UrlParser);
|
---|
456 | end;
|
---|
457 | DoOnExit;
|
---|
458 | end;
|
---|
459 |
|
---|
460 | procedure TIEMultiDownload.MultiTimer(Sender: TObject);
|
---|
461 | begin
|
---|
462 | FProgress := FProgress + 10;
|
---|
463 | if FProgress = FProgressMax then
|
---|
464 | FProgress := 1;
|
---|
465 | if Assigned(FOnMultiParseProgress) then
|
---|
466 | FOnMultiParseProgress(Self, FProgress, FProgressMax);
|
---|
467 | end;
|
---|
468 |
|
---|
469 | procedure TIEMultiDownload.DoOnExit;
|
---|
470 | begin
|
---|
471 | if FOpenFolder then
|
---|
472 | OpenFolder(FBaseFolder);
|
---|
473 | if Assigned(FOnMultiComplete) then
|
---|
474 | FOnMultiComplete(Self, slDownloadedList);
|
---|
475 | slDownloadedList.Clear;
|
---|
476 | Items.Clear;
|
---|
477 | FMultiState := msStopped;
|
---|
478 | if Assigned(FOnMultiStateChange) then
|
---|
479 | FOnMultiStateChange(Self, FMultiState);
|
---|
480 | end;
|
---|
481 |
|
---|
482 | procedure TIEMultiDownload.Stop;
|
---|
483 |
|
---|
484 | begin
|
---|
485 | if FMultiState <> msBusy then
|
---|
486 | Exit;
|
---|
487 | FAbort := True;
|
---|
488 | HtmlParser.Stop;
|
---|
489 | CancelAll;
|
---|
490 | while State <> sBusy do
|
---|
491 | Forms.Application.ProcessMessages;
|
---|
492 | DoOnExit;
|
---|
493 | end;
|
---|
494 |
|
---|
495 | constructor TIEMultiDownload.Create(AOwner: Tcomponent);
|
---|
496 | begin
|
---|
497 | inherited Create(AOwner);
|
---|
498 | FAbout := 'TIEMultiDownload from: http://www.bsalsa.com';
|
---|
499 | FDownloadLevel := 1;
|
---|
500 | FFromBaseSiteOnly := True;
|
---|
501 | FItems := TDownloadList.Create(Self);
|
---|
502 | FMaxItems := 100;
|
---|
503 | FMultiDownloadOptions := doAll;
|
---|
504 | slDownloadedList := TStringList.Create;
|
---|
505 | with slDownloadedList do
|
---|
506 | begin
|
---|
507 | {$IFDEF DELPHI6UP}
|
---|
508 | CaseSensitive := False;
|
---|
509 | {$ENDIF}
|
---|
510 | Sorted := True;
|
---|
511 | Duplicates := dupIgnore;
|
---|
512 | end;
|
---|
513 | FMultiState := msReady;
|
---|
514 | HtmlParser := TIEParser.Create(nil);
|
---|
515 | end;
|
---|
516 |
|
---|
517 | destructor TIEMultiDownload.Destroy;
|
---|
518 | begin
|
---|
519 | slDownloadedList.Free;
|
---|
520 | if HtmlParser <> nil then
|
---|
521 | FreeAndNil(HtmlParser);
|
---|
522 | FItems.Free;
|
---|
523 | inherited Destroy;
|
---|
524 | end;
|
---|
525 |
|
---|
526 | procedure TIEMultiDownload.SetAbout(Value: string);
|
---|
527 | begin
|
---|
528 | Exit;
|
---|
529 | end;
|
---|
530 |
|
---|
531 | procedure TIEMultiDownload.SetDownloadOptions(const Value: TMultiDownloadOptions);
|
---|
532 | begin
|
---|
533 | FMultiDownloadOptions := Value;
|
---|
534 | end;
|
---|
535 |
|
---|
536 | procedure TIEMultiDownload.SetItems(Value: TDownloadList);
|
---|
537 | begin
|
---|
538 | FItems.Assign(Value);
|
---|
539 | end;
|
---|
540 |
|
---|
541 | procedure TIEMultiDownload.SetMaxItems(Value: Integer);
|
---|
542 | begin
|
---|
543 | {$IFDEF DELPHI10_UP}
|
---|
544 | if (Value <> FItems.Capacity) then
|
---|
545 | FItems.Capacity := Value;
|
---|
546 | {$ENDIF}
|
---|
547 | end;
|
---|
548 |
|
---|
549 | procedure TIEMultiDownload.MultiAnchor(Sender: TObject; hRef, Target, Rel, Rev, Urn,
|
---|
550 | Methods, Name, Host, HostName, PathName, Port, Protocol, Search, Hash,
|
---|
551 | AccessKey, ProtocolLong, MimeType, NameProp: string; Element: TElementInfo);
|
---|
552 | var
|
---|
553 | bCancel: Boolean;
|
---|
554 | begin
|
---|
555 | if FMultiDownloadOptions = doImages then
|
---|
556 | Exit;
|
---|
557 | bCancel := False;
|
---|
558 | if (hRef <> EmptyStr) and (not StrContain('mailto', hRef)) then
|
---|
559 | begin
|
---|
560 | if FFromBaseSiteOnly and (not StrContain(FRoorUrl, hRef)) then
|
---|
561 | Exit;
|
---|
562 | if Assigned(FOnMultiGetLink) then
|
---|
563 | FOnMultiGetLink(Self, hRef, Host, HostName, PathName, Port, Protocol,
|
---|
564 | MimeType, NameProp, bCancel);
|
---|
565 | if (not bCancel) and (not FAbort) and ((FMultiDownloadOptions = doAll) and (not FAbort)
|
---|
566 | or (FMultiDownloadOptions = doPages)) then
|
---|
567 | begin
|
---|
568 | AddItem(LowerCase(hRef));
|
---|
569 | end;
|
---|
570 | end;
|
---|
571 | end;
|
---|
572 |
|
---|
573 | procedure TIEMultiDownload.MultiImage(Sender: TObject; Source: string; ImgElement: IHTMLImgElement; Element: TElementInfo);
|
---|
574 | var
|
---|
575 | bCancel: Boolean;
|
---|
576 | begin
|
---|
577 | if FMultiDownloadOptions = doPages then
|
---|
578 | Exit;
|
---|
579 | bCancel := False;
|
---|
580 | if Source <> EmptyStr then
|
---|
581 | begin
|
---|
582 | if Assigned(FOnMultiGetImage) then
|
---|
583 | FOnMultiGetImage(Self, Source, bCancel);
|
---|
584 | if (not bCancel) and (not FAbort) and ((FMultiDownloadOptions = doAll) or
|
---|
585 | (FMultiDownloadOptions = doImages)) then
|
---|
586 | begin
|
---|
587 | AddItem(LowerCase(Source));
|
---|
588 | end;
|
---|
589 | end;
|
---|
590 | end;
|
---|
591 |
|
---|
592 | procedure TIEMultiDownload.MultiGetDocInfo(Sender: TObject; const Text: string);
|
---|
593 | begin
|
---|
594 | if Assigned(FOnMultiGetDocInfo) and not (FAbort) then
|
---|
595 | FOnMultiGetDocInfo(Self, Text);
|
---|
596 | end;
|
---|
597 |
|
---|
598 | procedure TIEMultiDownload.MultiParseError(Sender: TObject; const ErrorCode: integer; const
|
---|
599 | Url, stError: string);
|
---|
600 | begin
|
---|
601 | if Assigned(FOnMultiParseError) then
|
---|
602 | FOnMultiParseError(Self, ErrorCode, Url, stError);
|
---|
603 | end;
|
---|
604 |
|
---|
605 | procedure TIEMultiDownload.MultiStartParsing(Sender: TObject; const aUrl: WideString);
|
---|
606 | begin
|
---|
607 | if Assigned(FOnMultiStartParsing) then
|
---|
608 | FOnMultiStartParsing(Self, aUrl);
|
---|
609 | end;
|
---|
610 |
|
---|
611 | procedure TIEMultiDownload.MultiGetQueryInfo(const MimeType, Encoding, Disposition: string);
|
---|
612 | begin
|
---|
613 | if Assigned(FOnMultiGetQueryInfo) and not (FAbort) then
|
---|
614 | FOnMultiGetQueryInfo(MimeType, Encoding, Disposition);
|
---|
615 | end;
|
---|
616 |
|
---|
617 | procedure TIEMultiDownload.MultiParseDocument(Sender: TObject; const
|
---|
618 | Res: HRESULT; stMessage: string);
|
---|
619 | begin
|
---|
620 | if (Assigned(FOnMultiParseDocument)) and not (FAbort) then
|
---|
621 | FOnMultiParseDocument(Self, Res, stMessage);
|
---|
622 | end;
|
---|
623 |
|
---|
624 | procedure TIEMultiDownload.MultiParseComplete(Sender: TObject;
|
---|
625 | Doc: IhtmlDocument2; All: IHtmlElementCollection);
|
---|
626 | begin
|
---|
627 | if Assigned(FOnMultiParseComplete) then
|
---|
628 | FOnMultiParseComplete(Self, Doc, All);
|
---|
629 |
|
---|
630 | if Assigned(FOnMultiParseProgress) then
|
---|
631 | FOnMultiParseProgress(Self, 0, 0);
|
---|
632 | end;
|
---|
633 |
|
---|
634 | end.
|
---|
635 |
|
---|