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