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