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