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