[541] | 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 |
|
---|