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