Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

IEDownload.pas@ 833

Last change on this file since 833 was 541, checked in by Kevin Toppenberg, 15 years ago
TMG Ver 1.1 Added HTML Support, better demographics editing
File size: 100.1 KB

Rev	Line
[541]	1	//*************************************************************************
	2	// *
	3	// IEDownload 2009 *
	4	// IEDownload is a UrlMon wrapper with a build-in Callback *
	5	// *
	6	// Freeware Component *
	7	// for Delphi by *
	8	// Eran Bodankin *
	9	// and Per Lindsø Larsen *
	10	// *
	11	// *
	12	// Updated versions: *
	13	// http://www.bsalsa.com *
	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. BSALSA PRODUCTIONS SPECIFICALLY
	27	DISCLAIMS ANY EXPRESS 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	//$Id: IEDownload.pas,v 1.6 2009/02/25 11:56:31 bsalsa Exp $
	37
	38
	39	unit IEDownload;
	40
	41	{To use the MSHTML, just remove the dot in the line below like {$DEFINE USE_MSHTML}{
	42	and re-compile the package.}
	43	{$DEFINE USE_MSHTML}
	44
	45	interface
	46
	47	{$I EWB.inc}
	48
	49
	50	uses
	51	Dialogs, IEDownloadAcc, Controls, Shellapi, IEConst, ActiveX,
	52	Contnrs, ExtCtrls, Windows, WinInet, UrlMon, Classes, SysUtils
	53	{$IFDEF DELPHI5}, FileCtrl{$ENDIF}{$IFDEF USE_MSHTML}, MSHTML_EWB{$ENDIF};
	54
	55	const
	56	WAIT_BSCB = WAIT_OBJECT_0 + 1;
	57
	58	{$IFNDEF UNICODE}
	59	type
	60	RawByteString = AnsiString;
	61	{$ENDIF UNICODE}
	62
	63	type
	64	TProxySettings = class(TPersistent)
	65	private
	66	FPort: Integer;
	67	FServer: string;
	68	FAutoLoadProxy: Boolean;
	69	public
	70	function SetProxy(const FullUserAgent, ProxyServer: string): Boolean;
	71	published
	72	property AutoLoadProxy: Boolean read FAutoLoadProxy write FAutoLoadProxy
	73	default False;
	74	property Port: Integer read FPort write FPort default 80;
	75	property Server: string read FServer write FServer;
	76	end;
	77
	78	TCustomIEDownload = class;
	79
	80	TInfoData = class(TList)
	81	public
	82	infAdditionalHeader: TStrings;
	83	infBindF_Value: Cardinal;
	84	infBindF2_Value: Cardinal;
	85	infBindInfoF_Value: Cardinal;
	86	infBindInfoOptions_Value: Cardinal;
	87	infBindVerb_Value: Cardinal;
	88	infCodePage_Value: Cardinal;
	89	infCustomVerb: string;
	90	infDescriptor: RawByteString;
	91	infDownloadFolder: string;
	92	infExtraInfo: string;
	93	infFileExt: string;
	94	infFileName: string;
	95	infFileSize: Cardinal;
	96	infHost: string;
	97	infIndex: Integer;
	98	infInheritHandle: Boolean;
	99	infPassword: string;
	100	infPostData: string;
	101	infPutFileName: string;
	102	infRangeBegin: Cardinal;
	103	infRangeEnd: Integer;
	104	infSender: TCustomIEDownload;
	105	infTimeOut: Integer;
	106	infUrl: PWideChar;
	107	infUserAgent: string;
	108	infUserName: string;
	109	Sender: TObject;
	110	public
	111	constructor Create;
	112	destructor Destroy; override;
	113	end;
	114
	115	TThreadStatus = (tsRunning, tsSuspended, tsWaiting, tsTerminated);
	116	TState = (sBusy, sReady, sStopped);
	117
	118	TBSCB = class(TThread,
	119	IAuthenticate,
	120	{$IFDEF DELPHI6_UP}
	121	IAuthenticateEx,
	122	IMonikerProp,
	123	{$ENDIF}
	124	IBindHost,
	125	IWindowForBindingUI,
	126	IBindStatusCallback,
	127	IBindStatusCallbackEx,
	128	ICodeInstall,
	129	IHttpNegotiate,
	130	IHttpNegotiate2,
	131	IHttpNegotiate3,
	132	IHTTPSecurity,
	133	{$IFDEF USE_MSHTML}
	134	IPropertyNotifySink,
	135	{$ENDIF}
	136	IServiceProvider,
	137	IUnknown)
	138
	139	private
	140	Frequency: Int64;
	141	TimeStarted: Int64;
	142	TimeNow: Int64;
	143	FSender: TCustomIEDownload;
	144	FBindCtx: IBindCtx;
	145	FBSCBTimer: TTimer;
	146	FDataSize: Integer;
	147	FGlobalData: HGLOBAL;
	148	FMoniker: IMoniker;
	149	FRedirect: Boolean;
	150	fOutStream: IStream;
	151	FTimedOut: Boolean;
	152	FTotalRead: Cardinal;
	153	m_pPrevBSCB: IBindStatusCallback;
	154	fsOutputFile: TFileStream;
	155
	156	function GetSerializedClientCertContext(out ppbCert: Byte; var pcbCert: DWORD): HResult; stdcall;
	157	{$IFDEF DELPHI6_UP}
	158	function AuthenticateEx(out phwnd: HWND; out pszUsername,
	159	pszPassword: LPWSTR; var pauthinfo: AUTHENTICATEINFO): HResult; stdcall;
	160	{IMonikerProp Interface}
	161	function PutProperty(mkp: MONIKERPROPERTY; val: LPCWSTR): HResult;
	162	stdcall;
	163	{$ENDIF}
	164
	165	{IBindStatusCallbackEx}
	166	function GetBindInfoEx(out grfBINDF: DWORD; var pbindinfo: BINDINFO;
	167	out grfBINDF2: DWORD; out pdwReserved: DWORD): HResult; stdcall;
	168
	169
	170	{$IFDEF USE_MSHTML}
	171	{IPropertyNotifySink Interface}
	172	function OnChanged(dispId: TDispId): HRESULT; stdcall;
	173	function OnRequestEdit(dispId: TDispId): HRESULT; stdcall;
	174	{$ENDIF}
	175
	176	{IHttpNegotiate2 Interface}
	177	function GetRootSecurityId(var SecurityIdBuffer: TByteArray; var
	178	BufferSize: DWord; dwReserved: DWORD): HResult; stdcall;
	179
	180	{IBindStatusCallback Interface}
	181	function GetBindInfo(out grfBINDF: DWORD; var BindInfo: TBindInfo): HRESULT;
	182	stdcall;
	183	function GetPriority(out nPriority): HRESULT; stdcall;
	184	function OnDataAvailable(grfBSCF: DWORD; dwSize: DWORD; FormatEtc:
	185	PFormatEtc; stgmed: PStgMedium): HRESULT; stdcall;
	186	function OnLowResource(Reserved: DWORD): HRESULT; stdcall;
	187	function OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
	188	szStatusText: LPCWSTR): HRESULT; stdcall;
	189	function OnObjectAvailable(const IID: TGUID; punk: IUnknown): HRESULT;
	190	stdcall;
	191	function OnStartBinding(dwReserved: DWORD; pib: IBinding): HRESULT; stdcall;
	192	function OnStopBinding(HRESULT: HRESULT; szError: LPCWSTR): HRESULT;
	193	stdcall;
	194	function OnSecurityProblem(dwProblem: DWORD): HRESULT; stdcall;
	195
	196	{IHTTPNegotiate methods}
	197	function OnResponse(dwResponseCode: DWORD; szResponseHeaders,
	198	szRequestHeaders: LPCWSTR;
	199	out szAdditionalRequestHeaders: LPWSTR): HRESULT; stdcall;
	200	function BeginningTransaction(szURL, szHeaders: LPCWSTR; dwReserved: DWORD;
	201	out szAdditionalHeaders: LPWSTR): HRESULT; stdcall;
	202
	203	{IUnknown Interface}
	204	function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
	205	function _AddRef: Integer; stdcall;
	206	function _Release: Integer; stdcall;
	207
	208	{IWindowForBindingUI methods}
	209	function GetWindow(const GUIDReason: TGUID; out hwnd): HRESULT; stdcall;
	210
	211	{IAuthenticate Interface}
	212	function Authenticate(var hwnd: HWnd; var szUserName, szPassWord: LPWSTR):
	213	HResult; stdcall;
	214
	215	{ICodeInstall Interface}
	216	function OnCodeInstallProblem(ulStatusCode: ULONG; szDestination, szSource:
	217	LPCWSTR;
	218	dwReserved: DWORD): HResult; stdcall;
	219
	220	{IBindHost Interface}
	221	function CreateMoniker(szName: POLEStr; BC: IBindCtx; out mk: IMoniker;
	222	dwReserved: DWORD): HResult; stdcall;
	223	function MonikerBindToStorage(Mk: IMoniker; BC: IBindCtx; BSC:
	224	IBindStatusCallback;
	225	const iid: TGUID; out pvObj{$IFNDEF DELPHI8_UP}: Pointer{$ENDIF}): HResult; stdcall;
	226	function MonikerBindToObject(Mk: IMoniker; BC: IBindCtx; BSC:
	227	IBindStatusCallback;
	228	const iid: TGUID; out pvObj{$IFNDEF DELPHI8_UP}: Pointer{$ENDIF}): HResult; stdcall;
	229
	230	{IServiceProvider Interface}
	231	function QueryService(const rsid, iid: TGUID; out Obj): HRESULT; stdcall;
	232
	233	function GetBindResult(out clsidProtocol: TCLSID; out dwResult: DWORD;
	234	out szResult: POLEStr): HRESULT;
	235	private
	236	function CheckCancelState: Integer;
	237	procedure ClearAll;
	238	procedure TimerExpired(Sender: TObject);
	239	procedure DoConnect;
	240	procedure DoDownloadToFile;
	241	procedure DoDownloadToCache;
	242	procedure ReceiveData;
	243	procedure ReturnData;
	244	procedure GetData(aSender: TCustomIEDownload);
	245	procedure SetComponents;
	246	protected
	247	procedure Execute; override;
	248	procedure Suspend;
	249	procedure Terminate;
	250	procedure Resume;
	251
	252	public
	253	Stream: TStream;
	254	Binding: IBinding;
	255	BscbInfo: TInfoData;
	256	ThreadStatus: TThreadStatus;
	257	constructor Create(aSender: TCustomIEDownload; const pmk: IMoniker;
	258	const pbc: IBindCtx; CreateSuspended: boolean);
	259	destructor Destroy; override;
	260	function QueryInfoFileName: HRESULT;
	261	function DoSaveFileAs: string;
	262	function QueryInfo(dwOption: DWORD; var Info: Cardinal): Boolean; overload;
	263	function QueryInfo(dwOption: DWORD; var Info: string): Boolean; overload;
	264	function QueryInfo(dwOption: DWORD; var Info: TDateTime): Boolean; overload;
	265	function IsRunning: Boolean;
	266	function GetDisplayName: PWideChar;
	267	function GetFileNameFromUrl(Url: string): string;
	268	function AbortBinding: Hresult;
	269	function MkParseDisplayName(var DisplayName: PWideChar): IMoniker;
	270	end;
	271
	272	TBSCBList = class(TObjectList) {by Jury Gerasimov}
	273	private
	274	function GetItem(Index: Integer): TBSCB;
	275	procedure SetItem(Index: Integer; Value: TBSCB);
	276	public
	277	SessionList: TStrings;
	278	constructor Create;
	279	destructor Destroy; override;
	280	property Items[Index: Integer]: TBSCB read GetItem write SetItem; default;
	281	function byURL(Url: string): TBSCB;
	282	end;
	283
	284	TSecurity = class(TPersistent)
	285	private
	286	FInheritHandle: Boolean;
	287	FDescriptor: RawByteString;
	288	published
	289	property InheritHandle: boolean read FInheritHandle write FInheritHandle
	290	default False;
	291	property Descriptor: RawByteString read FDescriptor write FDescriptor;
	292	end;
	293
	294	TRange = class(TPersistent)
	295	private
	296	FRangeBegin: Integer;
	297	FRangeEnd: Integer;
	298	published
	299	property RangeBegin: Integer read FRangeBegin write FRangeBegin default 0;
	300	property RangeEnd: Integer read FRangeEnd write FRangeEnd default 0;
	301	end;
	302	{http://msdn.microsoft.com/en-us/library/ms775130(VS.85).aspx}
	303	TBindF = (Asynchronous, AsyncStorage, NoProgressiveRendering,
	304	OfflineOperation, GetNewestVersion, NoWriteCache, NeedFile, PullData,
	305	IgnoreSecurityProblem, Resynchronize, AllowHyperlink, No_UI,
	306	SilentOperation, Pragma_No_Cache, GetClassObject, Reserved_1,
	307	Free_Threaded, DirectReadIgnoreSize, HandleAsFormsSubmit,
	308	GetFromCacheIfNetFail, FromUrlmon, FisrtTryCache, PreferDefaultHandler,
	309	RestrictedSitesZone);
	310	TBindF_Options = set of TBindF;
	311	TBindF2 = (DisableBasicAuth, DisableAutoCookie, DisableRedirectUnlessSID,
	312	ReadDataOver4GB, Reserved_2, Reserved_11);
	313	TBindF2_Options = set of TBindF2;
	314	TBindInfoF = (PostData, ExtraInfo);
	315	TBindInfoF_Options = set of TBindInfoF;
	316	TBindInfoOption = (UseBindInfoOptions, EnableUtf8, DisableUtf8, UseIE_Encoding,
	317	BindToObject, SecurityOptOut, IgnoreMimeTextPlain, UseBindStrCredentials,
	318	IgnoreHttp2HttpsRedirect, IgnoreSslErrOnce, WpcDownloadBlocked, WpcLoggingEnabled,
	319	DisableAutoRedirect, ShDocVw_Reserved, AllowConnectMessages);
	320	TBindInfoOptions_Options = set of TBindInfoOption;
	321	TBindVerb = (Get, Post, Put, Custom);
	322	TCodePageOption = (
	323	Ansi, {default to ANSI code page}
	324	OEM, {default to OEM code page}
	325	Mac, {default to MAC code page}
	326	ThreadsAnsi, {Current thread's ANSI code page}
	327	Symbol, {Symbol code page (42)}
	328	UTF7, {Translate using UTF-7}
	329	UTF8); {Translate using UTF-8}
	330
	331	TDownloadTo = (dtNormal, dtDownloadToFile, dtDownloadToCache, dtMoniker);
	332	TDownloadMethod = (dmStream, dmFile); {Set download to a file or astream}
	333	TFileExistsOption = (feOverWrite, feSkip, feRename); {If file exsits then..}
	334
	335	TQueryInterfaceEvent = function(const IID: TGUID; out Obj): HRESULT of object;
	336	TAuthenticateEvent = procedure(Sender: TBSCB; var tmpHWND: HWnd;
	337	var szUserName, szPassWord: WideString; var Rezult: HRESULT) of object;
	338	{$IFDEF DELPHI6_UP}
	339	TAuthenticateExEvent = procedure(Sender: TBSCB; var tmpHWND: HWnd;
	340	var szUserName, szPassWord: WideString; pauthinfo: AUTHENTICATEINFO;
	341	var Rezult: HRESULT) of object;
	342	TOnPutPropertyEvent = function(Sender: TBSCB; mkp: MONIKERPROPERTY; val: LPCWSTR): HResult of object;
	343	{$ENDIF}
	344
	345	TOnCodeInstallProblemEvent = function(Sender: TBSCB; ulStatusCode: ULONG;
	346	szDestination, szSource: LPCWSTR;
	347	dwReserved: DWORD; stResult: string): HRESULT of object;
	348	TStateChangeEvent = procedure(const State: TState) of object;
	349	TErrorEvent = procedure(const ErrorCode: integer; const
	350	stError: string) of object;
	351	TOnConnectEvent = procedure(Sender: TBSCB; Res: HRESULT; stMessage: string) of
	352	object;
	353	TOnGetBindInfoEvent = function(Sender: TBSCB; out grfBINDF: DWORD; var
	354	BindInfo: TBindInfo): HRESULT of object;
	355	TOnGetBindInfoExEvent = function(Sender: TBSCB; out grfBINDF: DWORD; pbindinfo: BINDINFO;
	356	out grfBINDF2: DWORD): HRESULT of object;
	357	TRedirect = procedure(Sender: TBSCB; var AbortRedirect: boolean; const
	358	FromUrl: string; const DestUrl: string) of object;
	359	TBeginningTransactionEvent = function(Sender: TBSCB; szURL, szHeaders:
	360	LPCWSTR; dwReserved: DWORD;
	361	out szAdditionalHeaders: LPWSTR): HRESULT of object;
	362	TOnResponseEvent = function(Sender: TBSCB; dwResponseCode: DWORD;
	363	szResponseHeaders, szRequestHeaders: LPCWSTR;
	364	out szAdditionalRequestHeaders: LPWSTR): HRESULT of object;
	365	TOnSecurityProblemEvent = function(Sender: TBSCB; dwProblem: DWORD; Problem:
	366	string): HRESULT of object;
	367	TFileExistsEvent = procedure(var Action: TFileExistsOption; const aFileName:
	368	WideString; var NewFileName: WideString) of object;
	369	TOnProgressEvent = procedure(Sender: TBSCB; ulProgress, ulProgressMax,
	370	ulStatusCode, FileSize: ULONG; szStatusText: LPCWSTR; Downloaded,
	371	ElapsedTime, Speed, RemainingTime, Status, Percent: string) of object;
	372	TOnDataAvailableEvent = procedure(Sender: TBSCB; var Buffer: PByte; var
	373	BufLength: Cardinal) of object;
	374	TOnDataAvailableInfoEvent = procedure(Sender: TBSCB; grfBSCF: DWORD;
	375	Status: string {; FormatEtc: PFormatEtc}) of object;
	376	TOnCompleteEvent = procedure(Sender: TCustomIEDownload; aFileNameAndPath, aFileName,
	377	aFolderName, aExtension: WideString; const ActiveConnections: Integer) of object;
	378	TOnStreamCompleteEvent = procedure(Sender: TBSCB; Stream: TStream; Result:
	379	HRESULT) of object;
	380	TOnResumeEvent = procedure(Sender: TBSCB; FileName: string; var Action:
	381	Cardinal) of object;
	382	TGetWindowEvent = function(Sender: TBSCB; const GUIDReason: TGUID; out hwnd:
	383	LongWord): HRESULT of object;
	384	TOnStartBindingEvent = procedure(Sender: TBSCB; var Cancel: Boolean; pib:
	385	IBinding; const FileName: WideString; const FileSize: integer) of object;
	386	TOnStopBindingEvent = procedure(Sender: TBSCB; HRESULT: HRESULT;
	387	szError: LPCWSTR) of object;
	388	TOnGetBindResultsEvent = procedure(var Sender: TBSCB; out clsidProtocol:
	389	TCLSID; out dwResult: DWORD; out szResult: POLEStr;
	390	const stResult: string) of object;
	391	TOnGetClientCertEvent = function(var Sender: TBSCB; out ppbCert: Byte; var pcbCert: DWORD): HResult of object;
	392	TTerminateEvent = procedure(const Sender: TBSCB; const ThreadId: Integer;
	393	const aFileName: Widestring; var bCancel: Boolean) of object;
	394	TOnGetRootSecurityIdEvent = function(var SecurityIdBuffer: TByteArray; var
	395	BufferSize: DWord): HRESULT of object;
	396	{IServiceProvider Interface}
	397	TQueryServiceEvent = procedure(Sender: TObject; const rsid, iid: TGUID; var
	398	Obj: IUnknown) of object;
	399	TOnBeforeDownloadEvent = procedure(Sender: TInfoData; const Url, FileName,
	400	FileExtension, Host, DownloadFolder: string; const FileSize: Integer; var Cancel: Boolean) of object;
	401
	402	TCustomIEDownload = class(TComponent)
	403
	404	private
	405	FAbout: string;
	406	bCancelAll: boolean;
	407	bDone: boolean;
	408	bRenamed: boolean;
	409	BS: TBSCB;
	410	FActiveConnections: integer;
	411	FAdditionalHeader: TStrings;
	412	FBeginningTransaction: TBeginningTransactionEvent;
	413	FBindF: TBindF_Options;
	414	FBindF_Value: Cardinal;
	415	FBindF2: TBindF2_Options;
	416	FBindF2_Value: Cardinal;
	417	FBindInfoF: TBindInfoF_Options;
	418	FBindInfoF_Value: Cardinal;
	419	FBindInfoOption_: TBindInfoOptions_Options;
	420	FBindInfoOption_Value: Cardinal;
	421	FBindVerb: TBindVerb;
	422	FBindVerb_Value: Cardinal;
	423	FBusy: Boolean;
	424	FCancel: Boolean;
	425	FCodePageOption: TCodePageOption;
	426	FCodePageValue: Cardinal;
	427	FCustomVerb: string;
	428	FDefaultProtocol: string;
	429	FDefaultUrlFileName: string;
	430	FDisplayName: PWideChar;
	431	FdlCounter: integer;
	432	FDownloadedFile: string;
	433	FDownloadFolder: string;
	434	FDownloadMethod: TDownloadMethod;
	435	FDownloadTo: TDownloadTo;
	436	FExtraInfo: string;
	437	FFileExistsOption: TFileExistsOption;
	438	FFileExtension: string;
	439	FFileName: string;
	440	FFileSize: ULong;
	441	FFullUserAgent: string;
	442	FGetWindow: TGetWindowEvent;
	443	FHWnd: HWND;
	444	FMimeType: string;
	445	FOnAuthenticate: TAuthenticateEvent;
	446	{$IFDEF DELPHI6_UP}
	447	FOnAuthenticateEx: TAuthenticateExEvent;
	448	FOnPutProperty: TOnPutPropertyEvent;
	449	{$ENDIF}
	450	FOnCodeInstallProblem: TOnCodeInstallProblemEvent;
	451	FOnComplete: TOnCompleteEvent;
	452	FOnConnect: TOnConnectEvent;
	453	FOnBeforeDownload: TOnBeforeDownloadEvent;
	454	FOnDataAvailable: TOnDataAvailableEvent;
	455	FOnDataAvailableInfo: TOnDataAvailableInfoEvent;
	456	FOnError: TErrorEvent;
	457	FOnFileExists: TFileExistsEvent;
	458	FOnGetBindInfo: TOnGetBindInfoEvent;
	459	FOnGetBindInfoEx: TOnGetBindInfoExEvent;
	460	FOnGetBindResults: TOnGetBindResultsEvent;
	461	FOnGetClientCert: TOnGetClientCertEvent;
	462	FOnGetRootSecurityId: TOnGetRootSecurityIdEvent;
	463	FOnProgress: TOnProgressEvent;
	464	FOnQueryInterface: TQueryInterfaceEvent;
	465	FOnQueryService: TQueryServiceEvent;
	466	FOnRedirect: TRedirect;
	467	FOnResponse: TOnResponseEvent;
	468	FOnResume: TOnResumeEvent;
	469	FOnSecurityProblem: TOnSecurityProblemEvent;
	470	FOnStartBinding: TOnStartBindingEvent;
	471	FOnStateChange: TStateChangeEvent;
	472	FOnStopBinding: TOnStopBindingEvent;
	473	FOnStreamComplete: TOnStreamCompleteEvent;
	474	FOnTerminate: TTerminateEvent;
	475	FOpenDownloadFolder: Boolean;
	476	FPassword: string;
	477	FPostData: string;
	478	FProxySettings: TProxySettings;
	479	FPutFileName: string;
	480	FRange: TRange;
	481	FRefCount: Integer;
	482	FSecurity: TSecurity;
	483	FServerAddress: string;
	484	FServerIP: string;
	485	FStartTick: Integer;
	486	FState: TState;
	487	FTimeOut: Integer;
	488	FUrl: string;
	489	FUserAgent: string;
	490	FUserName: string;
	491	FUseSystemDownloadFolder: boolean;
	492	FValidateUrl: boolean;
	493	hProcess: THandle;
	494	hStop: THandle;
	495
	496	private
	497	function GoAction(const actUrl, actFileName, actDownloadFolder: string;
	498	pmk: IMoniker; pbc: IBindCtx): boolean;
	499	function GoInit(const inUrl: string; const inFileName: string;
	500	const inDownloadFolder: string): boolean;
	501	function SetDownloadFolder(const aDownloadFolder: string): string;
	502	function SetHttpProtocol(const aUrl: string): string;
	503	procedure DoUpdate;
	504	procedure ExtractDataFromFile(const aFileName: string);
	505	procedure PrepareForExit;
	506	procedure PrepareForStart;
	507	procedure SetAbout(Value: string);
	508	procedure SetAdditionalHeader(const Value: TStrings);
	509	procedure SetBeforeExit;
	510	procedure SetBindF(const Value: TBindF_Options);
	511	procedure SetBindF2(const Value: TBindF2_Options);
	512	procedure SetBindInfoF(const Value: TBindInfoF_Options);
	513	procedure SetBindInfoOption(const Value: TBindInfoOptions_Options);
	514	procedure SetBindVerb(const Value: TBindVerb);
	515	procedure SetCodePage(const Value: TCodePageOption);
	516	procedure SetDefaultProtocol(const Value: string);
	517	procedure SetDownloadMethod(const Value: TDownloadMethod);
	518	procedure SetFileName(const Value: string);
	519	procedure SetUserAgent;
	520	procedure Update_BindF_Value;
	521	procedure Update_BindF2_Value;
	522	procedure Update_BindInfoF_Value;
	523	procedure Update_BindInfoOptions_Value;
	524
	525	public
	526	ItemsManager: TBSCBList;
	527	constructor Create(AOwner: TComponent); override;
	528	destructor Destroy; override;
	529	function CheckFileExists(const aFileName: string): boolean;
	530	function CodeInstallProblemToStr(const ulStatusCode: Integer): string;
	531	function FormatSize(const Byte: Double): string;
	532	function FormatTickToTime(const TickCount: Cardinal): string;
	533	function IsAsyncMoniker(const pmk: IMoniker): HRESULT;
	534	function IsSynchronous(iedInfo: TInfoData): boolean;
	535	function IsUrlValid(const isUrl: string): Boolean;
	536	function OpenFolder(const aFolderName: string): Boolean;
	537	function ResponseCodeToStr(const dwResponse: Integer): string;
	538	function SetFileNameFromUrl(const aUrl: string): string;
	539	function URLDownloadToCacheFile(const aUrl: string): string;
	540	function UrlDownloadToFile(const aUrl: string): HRESULT;
	541	function WaitForProcess(var EventName: THandle; var aStartTick,
	542	aTimeOut: Integer): Boolean;
	543	function WideStringToLPOLESTR(const Source: string): POleStr;
	544	procedure BeforeDestruction; override;
	545	procedure Cancel(const Item: TBSCB); overload;
	546	procedure Cancel; overload;
	547	procedure Reset;
	548	procedure CancelAll;
	549	procedure Download(const pmk: IMoniker; const pbc: IBindCtx); overload;
	550	procedure Go(const aUrl: string); overload;
	551	procedure Go(const aUrl: string; const aFileName: string); overload;
	552	procedure Go(const aUrl: string; const aFileName: string; const
	553	aDownloadFolder: string); overload;
	554	procedure GoList(const UrlsList: TStrings); overload;
	555	procedure GoList(const UrlsList: TStrings; const FileNameList: TStrings);
	556	overload;
	557	procedure GoList(const UrlsList: TStrings; const FileNameList: TStrings;
	558	const DownloadFolderList: TStrings); overload;
	559	procedure Loaded; override;
	560	procedure Resume;
	561	procedure Suspend;
	562
	563	public
	564	property ActiveConnections: integer read FActiveConnections;
	565	property Busy: Boolean read FBusy;
	566	property DisplayName: PWideChar read FDisplayName;
	567	property DownloadedFile: string read FDownloadedFile;
	568	property DownloadsCounter: integer read FdlCounter;
	569	property FileExtension: string read FFileExtension;
	570	property FileSize: ULong read FFileSize;
	571	property MimeType: string read FMimeType;
	572	property ServerAddress: string read FServerAddress;
	573	property ServerIP: string read FServerIP;
	574	property State: TState read FState;
	575
	576	published
	577	property About: string read FAbout write SetAbout;
	578	property AdditionalHeader: TStrings read FAdditionalHeader write
	579	SetAdditionalHeader;
	580	property BindF: TBindF_Options read FBindF write
	581	SetBindF default [Asynchronous, AsyncStorage, PullData,
	582	NoWriteCache, GetNewestVersion];
	583	property BindF2: TBindF2_Options read FBindF2 write
	584	SetBindF2 default [ReadDataOver4GB];
	585	property BindInfoF: TBindInfoF_Options read FBindInfoF write
	586	SetBindInfoF default [];
	587	property BindVerb: TBindVerb read FBindVerb write
	588	SetBindVerb default Get;
	589	property BindInfoOptions: TBindInfoOptions_Options read FBindInfoOption_
	590	write SetBindInfoOption default [UseBindInfoOptions, AllowConnectMessages];
	591	property CodePage: TCodePageOption read FCodePageOption write
	592	SetCodePage default Ansi;
	593	property CustomVerb: string read FCustomVerb write FCustomVerb;
	594	property DefaultProtocol: string read FDefaultProtocol write
	595	SetDefaultProtocol;
	596	property DefaultUrlFileName: string read FDefaultUrlFileName write
	597	FDefaultUrlFileName;
	598	property DownloadFolder: string read FDownloadFolder write
	599	FDownloadFolder;
	600	property DownloadMethod: TDownloadMethod read FDownloadMethod write
	601	SetDownloadMethod default dmFile;
	602	property ExtraInfo: string read FExtraInfo write FExtraInfo;
	603	property FileExistsOption: TFileExistsOption read FFileExistsOption write
	604	FFileExistsOption default feOverwrite;
	605	property FileName: string read FFileName write SetFileName;
	606	property OnAuthenticate: TAuthenticateEvent read FOnAuthenticate
	607	write FOnAuthenticate;
	608	{$IFDEF DELPHI6_UP}
	609	property OnAuthenticateEx: TAuthenticateExEvent read FOnAuthenticateEx
	610	write FOnAuthenticateEx;
	611	property OnPutProperty: TOnPutPropertyEvent read FOnPutProperty write FOnPutProperty;
	612	{$ENDIF}
	613	property OnBeforeDownload: TOnBeforeDownloadEvent read FOnBeforeDownload write FOnBeforeDownload;
	614	property OnBeginningTransaction: TBeginningTransactionEvent read
	615	FBeginningTransaction write FBeginningTransaction;
	616	property OnCodeInstallProblem: TOnCodeInstallProblemEvent read
	617	FOnCodeInstallProblem write FOnCodeInstallProblem;
	618	property OnDataAvailable: TOnDataAvailableEvent read
	619	FOnDataAvailable write FOnDataAvailable;
	620	property OnDataAvailableInfo: TOnDataAvailableInfoEvent read
	621	FOnDataAvailableInfo write FOnDataAvailableInfo;
	622	property OnConnect: TOnConnectEvent read FOnConnect write FOnConnect;
	623	property OnComplete: TOnCompleteEvent read FOnComplete write FOnComplete;
	624	property OnStreamComplete: TOnStreamCompleteEvent read
	625	FOnStreamComplete write FOnStreamComplete;
	626	property OnError: TErrorEvent read FOnError write FOnError;
	627	property OnGetBindResults: TOnGetBindResultsEvent read
	628	FOnGetBindResults write FOnGetBindResults;
	629	property OnGetBindInfo: TOnGetBindInfoEvent read
	630	FOnGetBindInfo write FOnGetBindInfo;
	631	property OnGetBindInfoEx: TOnGetBindInfoExEvent read
	632	FOnGetBindInfoEx write FOnGetBindInfoEx;
	633	property OnGetSerializedClientCertContext: TOnGetClientCertEvent read FOnGetClientCert
	634	write FOnGetClientCert;
	635	property OnGetRootSecurityId: TOnGetRootSecurityIdEvent
	636	read FOnGetRootSecurityId write FOnGetRootSecurityId;
	637	property OnGetWindow: TGetWindowEvent read FGetWindow write
	638	FGetWindow;
	639	property OnFileExists: TFileExistsEvent read FOnFileExists write
	640	FOnFileExists;
	641	property OnProgress: TOnProgressEvent read FOnProgress write
	642	FOnProgress;
	643	property OnQueryInterface: TQueryInterfaceEvent read
	644	FOnQueryInterface write FOnQueryInterface;
	645	property OnQueryService: TQueryServiceEvent read FOnQueryService write
	646	FOnQueryService;
	647	property OnRedirect: TRedirect read FOnRedirect write FOnRedirect;
	648	property OnResponse: TOnResponseEvent read FOnResponse
	649	write FOnResponse;
	650	property OnResume: TOnResumeEvent read FOnResume write FOnResume;
	651	property OnSecurityProblem: TOnSecurityProblemEvent read FOnSecurityProblem
	652	write FOnSecurityProblem;
	653	property OnStartBinding: TOnStartBindingEvent read FOnStartBinding write
	654	FOnStartBinding;
	655	property OnStateChange: TStateChangeEvent read FOnStateChange write
	656	FOnStateChange;
	657	property OnTerminate: TTerminateEvent read FOnTerminate write FOnTerminate;
	658	property OnStopBinding: TOnStopBindingEvent read FOnStopBinding
	659	write FOnStopBinding;
	660	property OpenDownloadFolder: Boolean read FOpenDownloadFolder write
	661	FOpenDownloadFolder default False;
	662	property Password: string read FPassword write FPassword;
	663	property PostData: string read FPostData write FPostData;
	664	property ProxySettings: TProxySettings read FProxySettings write
	665	FProxySettings;
	666	property PutFileName: string read FPutFileName write FPutFileName;
	667	property Range: TRange read FRange write FRange;
	668	property Security: TSecurity read FSecurity write FSecurity;
	669	property TimeOut: Integer read FTimeOut write FTimeOut default 0;
	670	property Url: string read FUrl write FUrl;
	671	property UserAgent: string read FUserAgent write FUserAgent;
	672	property UserName: string read FUserName write FUserName;
	673	property UseSystemDownloadFolder: boolean read FUseSystemDownloadFolder write
	674	FUseSystemDownloadFolder default False;
	675	property ValidateUrl: boolean read FValidateUrl write FValidateUrl default
	676	False;
	677	end;
	678
	679	TIEDownload = class(TCustomIEDownload)
	680	published
	681	end;
	682
	683	var
	684	ThreadStatusDesc: array[TThreadStatus] of string = ('Running', 'Suspended',
	685	'Waiting', 'Terminated');
	686
	687	implementation
	688
	689	uses
	690	IEDownloadStrings, EwbUrl, IEDownloadTools, Forms
	691	{$IFDEF DELPHI6_UP}, StrUtils{$ENDIF};
	692
	693
	694	{TInfoData---------------------------------------------------------------------}
	695
	696	constructor TInfoData.Create;
	697	begin
	698	inherited Create;
	699	InfAdditionalHeader := TStringList.Create;
	700	end;
	701
	702	destructor TInfoData.Destroy;
	703	begin {Cleaning out and free our resources}
	704	Clear;
	705	Remove(Sender);
	706	Extract(Self);
	707	{Its just to make sure we cleanly remove the IEDownload as an object}
	708	Remove(infSender);
	709	Extract(Self);
	710	if Assigned(infAdditionalHeader) then
	711	FreeAndNil(infAdditionalHeader);
	712	inherited;
	713	end;
	714	{End of TInfoData--------------------------------------------------------------}
	715
	716	{Proxy Settings-----------------------------------------------------------------}
	717
	718	function TProxySettings.SetProxy(const FullUserAgent, ProxyServer: string):
	719	Boolean; //mladen
	720	var
	721	intList: INTERNET_PER_CONN_OPTION_List;
	722	dwBufSize: DWORD;
	723	hInternet: Pointer;
	724	intOptions: array[1..3] of INTERNET_PER_CONN_OPTION;
	725	begin
	726	Result := False;
	727	dwBufSize := SizeOf(intList);
	728	intList.dwSize := SizeOf(intList);
	729	intList.pszConnection := nil;
	730	intList.dwOptionCount := High(intOptions);
	731	// the highest index of the array (in this case 3)
	732	intOptions[1].dwOption := INTERNET_PER_CONN_FLAGS;
	733	intOptions[1].Value.dwValue := PROXY_TYPE_DIRECT or PROXY_TYPE_PROXY;
	734	intOptions[2].dwOption := INTERNET_PER_CONN_PROXY_SERVER;
	735	intOptions[2].Value.pszValue := PChar(ProxyServer);
	736	intOptions[3].dwOption := INTERNET_PER_CONN_PROXY_BYPASS;
	737	intOptions[3].Value.pszValue := '<local>';
	738	intList.intOptions := @intOptions;
	739	hInternet := InternetOpen(PChar(FullUserAgent), INTERNET_OPEN_TYPE_DIRECT,
	740	nil, nil, 0);
	741	if hInternet <> nil then
	742	try
	743	Result := InternetSetOption(hInternet,
	744	INTERNET_OPTION_PER_CONNECTION_OPTION,
	745	@intList, dwBufSize);
	746	Result := Result and InternetSetOption(hInternet, INTERNET_OPTION_REFRESH,
	747	nil, 0);
	748	finally
	749	InternetCloseHandle(hInternet)
	750	end;
	751	end;
	752	{End of Proxy Settings-----------------------------------------------------------}
	753
	754	{$IFDEF USE_MSHTML}
	755
	756	function TBSCB.OnChanged(dispId: TDispId): HRESULT;
	757	var
	758	DP: TDispParams;
	759	vResult: OLEVariant;
	760	Doc: IHTMLDocument2;
	761	begin
	762	if (DISPID_READYSTATE = DispId) then
	763	if Succeeded((Doc as IHTMLDocument2).Invoke(DISPId_READYSTATE, GUId_null,
	764	LOCALE_System_DEFAULT, DISPATCH_PROPERTYGET, DP, @vResult, nil, nil)) then
	765	if Integer(vResult) = READYSTATE_COMPLETE then
	766	PostThreadMessage(GetCurrentThreadId, WM_USER_STARTWALKING, 0, 0);
	767	Result := S_OK;
	768	end;
	769
	770	function TBSCB.OnRequestEdit(dispId: TDispId): HRESULT;
	771	begin
	772	Result := E_NOTIMPL;
	773	end;
	774	{$ENDIF}
	775	{Callback procedure--------------------------------------------------------------}
	776	{IAuthenticate Interface
	777	Provides the URL moniker with information to authenticate the user}
	778
	779	function TBSCB.Authenticate(var hwnd: HWnd; var szUserName, szPassWord: LPWSTR):
	780	HResult;
	781	{Provides the URL moniker with information to authenticate the user.
	782	S_OK Authentication was successful.
	783	E_ACCESSDENIED Authentication failed.
	784	E_INVALIDARG One or more parameters are invalid. }
	785	var
	786	aUser, aPwd: WideString;
	787	begin
	788	Result := S_OK;
	789	hwnd := FSender.FHWnd;
	790	aUser := EmptyStr;
	791	aPwd := EmptyStr;
	792	if Assigned(FSender.FOnAuthenticate) then
	793	FSender.FOnAuthenticate(Self, hwnd, aUser, aPwd, Result);
	794	if aUser <> EmptyStr then
	795	szUserName := WidestringToLPOLESTR(aUser)
	796	else
	797	szUserName := nil;
	798	if aPwd <> EmptyStr then
	799	szPassWord := WidestringToLPOLESTR(aPwd)
	800	else
	801	szPassWord := nil;
	802	end;
	803
	804	{IHttpNegotiate Interface
	805	Implemented by a client application to provide support for HTTP negotiations}
	806
	807	function TBSCB.BeginningTransaction(szURL, szHeaders: LPCWSTR; dwReserved:
	808	DWORD; out szAdditionalHeaders: LPWSTR): HRESULT;
	809	{IHttpNegotiate::BeginningTransaction Method
	810	Notifies the client of the URL that is being bound to at the beginning of an HTTP transaction.
	811	S_OK The HTTP transaction completed successfully and any additional headers specified have been appended.
	812	E_ABORT The HTTP transaction has been terminated.
	813	E_INVALIDARG A parameter is invalid.}
	814	var
	815	sr: TSearchRec;
	816	Action: Cardinal;
	817	tmpNewName: WideString;
	818	NewHeaders: string;
	819	Size: Longint;
	820	x, Len: Integer;
	821	ActExists: TFileExistsOption;
	822	begin
	823	ActExists := FSender.FFileExistsOption;
	824	tmpNewName := '';
	825	dwReserved := 0;
	826	if (FSender.FCancel) and (Binding <> nil) then
	827	begin
	828	Result := E_ABORT;
	829	binding.Abort;
	830	Exit;
	831	end;
	832	NewHeaders := FSender.FFullUserAgent + #13 + #10;
	833	if (BscbInfo.infFileName <> EmptyStr) then
	834	begin
	835	if FindFirst(BscbInfo.infFileName, faAnyFile, sr) = 0 then
	836	begin
	837	Size := sr.Size;
	838	FindClose(sr);
	839	BscbInfo.infRangeEnd := 0;
	840	Action := 0;
	841
	842	{IBinding still do not support resume (By MS 4.2009)}
	843	if Assigned(FSender.FOnResume) then
	844	begin
	845	FSender.FOnResume(Self, BscbInfo.infFileName, Action);
	846	BscbInfo.infRangeBegin := Size;
	847	end;
	848
	849	if Assigned(FSender.FOnFileExists) then
	850	FSender.FOnFileExists(ActExists, BscbInfo.infFileName, tmpNewName);
	851
	852	if tmpNewName = EmptyStr then
	853	tmpNewName := TimeToStr(now) + '_' + BscbInfo.infFileName;
	854	case ActExists of
	855	feOverwrite:
	856	begin
	857	Binding.Resume;
	858	if Assigned(FSender.FOnResume) then
	859	FSender.FOnResume(Self, BscbInfo.infFileName, Action);
	860	BscbInfo.infRangeBegin := 0
	861	end;
	862	feSkip:
	863	begin
	864	Result := E_ABORT;
	865	Binding.Abort;
	866	Exit;
	867	end;
	868	feRename: BscbInfo.infFileName := tmpNewName;
	869	end
	870	end;
	871	end
	872	else {Download is starting}
	873	begin {Set the range to 0 which means start download from scratch}
	874	BscbInfo.infRangeBegin := 0;
	875	BscbInfo.infRangeEnd := 0;
	876	end;
	877
	878	if ((BscbInfo.infRangeBegin <> 0) or (BscbInfo.infRangeEnd <> 0)) then
	879	begin {We set the new headers to send to the server}
	880	NewHeaders := NewHeaders + 'Range: bytes=' +
	881	IntToStr(BscbInfo.infRangeBegin) + '-';
	882	if BscbInfo.infRangeEnd <> 0 then
	883	NewHeaders := NewHeaders + IntToStr(BscbInfo.infRangeEnd) + #13#10
	884	else
	885	NewHeaders := NewHeaders + #13#10;
	886	end;
	887	if (BscbInfo.infAdditionalHeader.Text <> EmptyStr) then
	888	for x := 0 to BscbInfo.infAdditionalHeader.Count - 1 do
	889	NewHeaders := NewHeaders + BscbInfo.infAdditionalHeader[x] + #13#10;
	890	Len := Length(NewHeaders);
	891	szAdditionalHeaders := CoTaskMemAlloc((Len + 1) * SizeOf(WideChar));
	892	StringToWideChar(NewHeaders, szAdditionalHeaders, Len + 1);
	893	{We will post the event}
	894	if Assigned(FSender.FBeginningTransaction) then
	895	Result := FSender.FBeginningTransaction(Self, szURL, szHeaders,
	896	dwReserved, szAdditionalHeaders)
	897	else
	898	Result := S_OK;
	899	FBSCBTimer.Enabled := True; {Timeout timer}
	900	FTimedOut := False;
	901	Self._Release;
	902	end;
	903
	904	function TBSCB.OnResponse(dwResponseCode: DWORD; szResponseHeaders,
	905	szRequestHeaders: LPCWSTR; out szAdditionalRequestHeaders: LPWSTR): HRESULT;
	906	{Enables the client of a bind operation to examine the response headers,
	907	optionally terminate the bind operation, and add HTTP headers to a
	908	request before resending the request.
	909	Returns one of the following values.
	910	S_OK The operation completed successfully.
	911	E_ABORT Terminate the HTTP transaction.
	912	E_INVALIDARG The parameter is invalid.}
	913	var
	914	Len: Cardinal;
	915	S: string;
	916	tmpName: string;
	917	begin
	918	if (FSender.FCancel) and (Binding <> nil) then
	919	begin
	920	Result := E_ABORT;
	921	binding.Abort;
	922	Exit;
	923	end;
	924	Result := S_OK;
	925	if (QueryInfo(HTTP_QUERY_CUSTOM, Len) and (Len = 0)) {file size = 0}
	926	or (QueryInfo(HTTP_QUERY_CONTENT_LENGTH, Len) and (Len = 0)) {file size = 0}
	927	or (dwResponseCode >= 400) then {An Error}
	928	begin
	929	Result := E_ABORT;
	930	if Assigned(FSender.FOnError) then
	931	FSender.FOnError(dwResponseCode,
	932	ResponseCodeToStr(dwResponseCode));
	933	end;
	934	begin {Publish the event}
	935	if Assigned(FSender.FOnResponse) then
	936	Result := FSender.FOnResponse(Self, dwResponseCode,
	937	szResponseHeaders, szRequestHeaders, szAdditionalRequestHeaders);
	938	if (FSender.FDownloadTo = dtDownloadToFile)
	939	or (FSender.FDownloadTo = dtDownloadToCache) then
	940	begin
	941	Result := S_OK;
	942	Exit;
	943	end;
	944
	945	if (BscbInfo.infRangeBegin <> 0) and (BscbInfo.infFileName <> EmptyStr) then
	946	begin {Retrieves the types of range requests that are accepted for a resource.}
	947	QueryInfo(HTTP_QUERY_ACCEPT_RANGES, S);
	948	{'Partial Content'}
	949	if (S = 'bytes') or (dwResponseCode = 206) then
	950	begin {Create an output file as a stream back from where we finished}
	951	tmpName := DoSaveFileAs;
	952	if tmpName <> EmptyStr then
	953	begin
	954	fsOutputFile := TFileStream.Create(tmpName, fmOpenReadWrite);
	955	fsOutputFile.Seek(0, soFromEnd);
	956	end;
	957	end
	958	else
	959	begin {'Create an output file as a stream from range begin 0'}
	960	// not needed
	961	tmpName := DoSaveFileAs;
	962	if tmpName <> EmptyStr then
	963	begin
	964	fsOutputFile := TFileStream.Create(tmpName, fmCreate);
	965	BscbInfo.infRangeBegin := 0;
	966	end;
	967	end;
	968	end
	969	else
	970	begin {Here we create the file}
	971	if (FSender.FDownloadMethod = dmFile) then
	972	begin
	973	tmpName := DoSaveFileAs;
	974	if tmpName <> EmptyStr then
	975	begin
	976	fsOutputFile := TFileStream.Create(tmpName, fmCreate);
	977	fsOutputFile.Seek(0, soFromBeginning);
	978	end;
	979	end;
	980	end
	981	end;
	982	end;
	983
	984	{IHttpNegotiate2 Interface}
	985
	986	function TBSCB.GetRootSecurityId(var SecurityIdBuffer: TByteArray; var
	987	BufferSize: DWord; dwReserved: DWORD): HResult;
	988	begin {Gets a root security ID.}
	989	if Assigned(FSender.FOnGetRootSecurityId) then
	990	Result := FSender.FOnGetRootSecurityId(SecurityIdBuffer, BufferSize)
	991	else
	992	Result := E_NOTIMPL;
	993	end;
	994
	995	function TBSCB.GetBindInfoEx(out grfBINDF: DWORD; var pbindinfo: BINDINFO;
	996	out grfBINDF2: DWORD; out pdwReserved: DWORD): HResult;
	997	var
	998	PutFile: TFileStream;
	999	Len: Integer;
	1000	begin
	1001	pdwReserved := 0;
	1002	if Assigned(FSender.FOnGetBindInfoEx) then
	1003	FSender.FOnGetBindInfoEx(Self, grfBINDF, pbindinfo, grfBINDF2);
	1004	grfBINDF := BscbInfo.infBindF_Value; {Insert our options.}
	1005	grfBINDF2 := BscbInfo.infBindF2_Value; {Insert our options 2.}
	1006	with pbindinfo do {Lets play with our options.}
	1007	begin
	1008	cbSize := SizeOf(TBindInfo);
	1009	if FRedirect then
	1010	begin {Set method to get in case of redirect}
	1011	dwBindVerb := BINDVERB_GET;
	1012	end
	1013	else {Insert the options}
	1014	dwBindVerb := BscbInfo.infBindVerb_Value;
	1015	grfBindInfoF := BscbInfo.infBindInfoF_Value;
	1016	dwCodePage := BscbInfo.infCodePage_Value;
	1017	{Insert security arguments}
	1018	with SecurityAttributes do
	1019	begin
	1020	nLength := SizeOf(TSecurityAttributes);
	1021	bInheritHandle := BscbInfo.infInheritHandle;
	1022	if BscbInfo.infDescriptor <> '' then
	1023	lpSecurityDescriptor := PAnsiChar(BscbInfo.infDescriptor)
	1024	else
	1025	lpSecurityDescriptor := nil;
	1026	end;
	1027	{Insert Extra Info}
	1028	if BscbInfo.infExtraInfo <> EmptyStr then
	1029	begin
	1030	Len := Length(BscbInfo.infExtraInfo);
	1031	szExtraInfo := CoTaskMemAlloc((Len + 1) * SizeOf(WideChar));
	1032	StringToWideChar(BscbInfo.infExtraInfo, szExtraInfo, Len + 1);
	1033	end
	1034	else
	1035	szExtraInfo := nil;
	1036	case BscbInfo.infBindVerb_Value of
	1037	{Now we will set by our BindVerbOption}
	1038	BINDVERB_PUT: {Perform an HTTP PUT operation. The data to put should be
	1039	specified in the stgmedData member of the BINDINFO structure.}
	1040	if BscbInfo.infPutFileName <> EmptyStr then
	1041	begin
	1042	PutFile := TFileStream.Create(BscbInfo.infPutFileName,
	1043	fmOpenRead);
	1044	try
	1045	PutFile.Seek(0, 0);
	1046	FGlobalData := GlobalAlloc(GPTR, PutFile.Size);
	1047	FDataSize := PutFile.Size;
	1048	PutFile.ReadBuffer(Pointer(FGlobalData)^, PutFile.Size);
	1049	finally
	1050	PutFile.Free;
	1051	end;
	1052	end;
	1053	BINDVERB_POST: {Perform an HTTP POST operation.
	1054	The data to be posted should be specified in the stgmedData
	1055	member of the BINDINFO structure.}
	1056	if BscbInfo.infPostData <> EmptyStr then
	1057	begin
	1058	FGlobalData := GlobalAlloc(GPTR, Length(BscbInfo.infPostData)
	1059	+ 1);
	1060	FDataSize := Length(BscbInfo.infPostData) + 1;
	1061	Move(BscbInfo.infPostData[1], Pointer(FGlobalData)^,
	1062	Length(BscbInfo.infPostData));
	1063	end;
	1064	BINDVERB_CUSTOM: {Perform a custom operation that is protocol-specific
	1065	See the szCustomVerb member of the BINDINFO structure.
	1066	The data to be used in the custom operation should be specified
	1067	in the stgmedData structure.}
	1068	if (BscbInfo.infCustomVerb <> EmptyStr) then
	1069	begin
	1070	Len := Length(BscbInfo.infCustomVerb);
	1071	szCustomVerb := CoTaskMemAlloc((Len + 1) * SizeOf(WideChar));
	1072	StringToWideChar(BscbInfo.infCustomVerb, szCustomVerb, Len + 1);
	1073	end
	1074	else {BINDVERB_GET so no need to play arround.}
	1075	szCustomVerb := nil;
	1076	end;
	1077	FillChar(stgmedData, 0, SizeOf(STGMEDIUM));
	1078	cbStgmedData := FDataSize;
	1079	with StgmedData do
	1080	begin
	1081	if dwBindVerb = BINDVERB_GET then
	1082	{The stgmedData member of the BINDINFO
	1083	structure should be set to TYMED_NULL for the GET operation}
	1084	Tymed := TYMED_NULL
	1085	else
	1086	Tymed := TYMED_HGLOBAL;
	1087	{this is the only medium urlmon supports right now}
	1088	hGlobal := FGlobalData;
	1089	IUnknown(unkForRelease) := Self; {Set the IUnknown interface}
	1090	end;
	1091	end;
	1092	Result := S_OK;
	1093	end;
	1094
	1095	{IBindStatusCallback Interface}
	1096	{Accepts information on an asynchronous bind operation.}
	1097
	1098	function TBSCB.GetBindInfo(out grfBINDF: DWORD; var BindInfo: TBindInfo):
	1099	HRESULT;
	1100	{Provides information about how the bind operation is handled when
	1101	it is called by an asynchronous moniker.
	1102	Returns S_OK if this is successful or E_INVALIDARG if one or more parameters are invalid.}
	1103	var
	1104	PutFile: TFileStream;
	1105	Len: Integer;
	1106	begin
	1107	grfBINDF := BscbInfo.infBindF_Value; {Insert our options.}
	1108	with BindInfo do {Lets play with our options.}
	1109	begin
	1110	cbSize := SizeOf(TBindInfo);
	1111	if FRedirect then
	1112	begin {Set method to get in case of redirect}
	1113	dwBindVerb := BINDVERB_GET;
	1114	end
	1115	else {Insert the options}
	1116	dwBindVerb := BscbInfo.infBindVerb_Value;
	1117	grfBindInfoF := BscbInfo.infBindInfoF_Value;
	1118	dwCodePage := BscbInfo.infCodePage_Value;
	1119	{Insert security arguments}
	1120	with SecurityAttributes do
	1121	begin
	1122	nLength := SizeOf(TSecurityAttributes);
	1123	bInheritHandle := BscbInfo.infInheritHandle;
	1124	if BscbInfo.infDescriptor <> '' then
	1125	lpSecurityDescriptor := PAnsiChar(BscbInfo.infDescriptor)
	1126	else
	1127	lpSecurityDescriptor := nil;
	1128	end;
	1129	{Insert Extra Info}
	1130	if BscbInfo.infExtraInfo <> EmptyStr then
	1131	begin
	1132	Len := Length(BscbInfo.infExtraInfo);
	1133	szExtraInfo := CoTaskMemAlloc((Len + 1) * SizeOf(WideChar));
	1134	StringToWideChar(BscbInfo.infExtraInfo, szExtraInfo, Len + 1);
	1135	end
	1136	else
	1137	szExtraInfo := nil;
	1138	case BscbInfo.infBindVerb_Value of
	1139	{Now we will set by our BindVerbOption}
	1140	BINDVERB_PUT: {Perform an HTTP PUT operation. The data to put should be
	1141	specified in the stgmedData member of the BINDINFO structure.}
	1142	if BscbInfo.infPutFileName <> EmptyStr then
	1143	begin {Create a process to put a file}
	1144	PutFile := TFileStream.Create(BscbInfo.infPutFileName,
	1145	fmOpenRead);
	1146	try
	1147	PutFile.Seek(0, 0);
	1148	FGlobalData := GlobalAlloc(GPTR, PutFile.Size);
	1149	FDataSize := PutFile.Size;
	1150	PutFile.ReadBuffer(Pointer(FGlobalData)^, PutFile.Size);
	1151	finally
	1152	PutFile.Free;
	1153	end;
	1154	end;
	1155
	1156	BINDVERB_POST: {Perform an HTTP POST operation.
	1157	The data to be posted should be specified in the stgmedData
	1158	member of the BINDINFO structure.}
	1159	if BscbInfo.infPostData <> EmptyStr then
	1160	begin
	1161	FGlobalData := GlobalAlloc(GPTR, Length(BscbInfo.infPostData)
	1162	+ 1);
	1163	FDataSize := Length(BscbInfo.infPostData) + 1;
	1164	Move(BscbInfo.infPostData[1], Pointer(FGlobalData)^,
	1165	Length(BscbInfo.infPostData));
	1166	end;
	1167	BINDVERB_CUSTOM: {Perform a custom operation that is protocol-specific
	1168	See the szCustomVerb member of the BINDINFO structure.
	1169	The data to be used in the custom operation should be specified
	1170	in the stgmedData structure.}
	1171	if (BscbInfo.infCustomVerb <> EmptyStr) then
	1172	begin
	1173	Len := Length(BscbInfo.infCustomVerb);
	1174	szCustomVerb := CoTaskMemAlloc((Len + 1) * SizeOf(WideChar));
	1175	StringToWideChar(BscbInfo.infCustomVerb, szCustomVerb, Len + 1);
	1176	end
	1177	else {BINDVERB_GET so no need to play arround.}
	1178	szCustomVerb := nil;
	1179	end;
	1180	FillChar(stgmedData, 0, SizeOf(STGMEDIUM));
	1181	cbStgmedData := FDataSize;
	1182	with StgmedData do
	1183	begin
	1184	if dwBindVerb = BINDVERB_GET then
	1185	{The stgmedData member of the BINDINFO
	1186	structure should be set to TYMED_NULL for the GET operation}
	1187	Tymed := TYMED_NULL
	1188	else
	1189	Tymed := TYMED_HGLOBAL;
	1190	{this is the only medium urlmon supports right now}
	1191	hGlobal := FGlobalData;
	1192	IUnknown(unkForRelease) := Self; {Set the IUnknown interface}
	1193	end;
	1194	end;
	1195	if Assigned(FSender.FOnGetBindInfo) then
	1196	FSender.FOnGetBindInfo(Self, grfBINDF, BindInfo);
	1197	Result := S_OK;
	1198	end;
	1199
	1200
	1201	function TBSCB.GetPriority(out nPriority): HRESULT;
	1202	{Gets the priority for the bind operation when it is called by an asynchronous moniker.}
	1203	{Returns S_OK if this is successful or E_INVALIDARG if the pnPriority parameter is invalid.}
	1204	begin {if you want to set priority you should implement SetPriority in your application}
	1205	Result := S_OK;
	1206	if (FSender.FCancel) and (Binding <> nil) then
	1207	binding.Abort
	1208	end;
	1209
	1210	function TBSCB.OnDataAvailable(grfBSCF, dwSize: DWORD; FormatEtc: PFormatEtc;
	1211	stgmed: PStgMedium): HRESULT;
	1212	{Provides data to the client as it becomes available during
	1213	asynchronous bind operations.OnDataAvailable return E_PENDING
	1214	when they reference data not yet available through their read
	1215	methods, rather than blocking until the data becomes available.
	1216	This flag applies only to ASYNCHRONOUS operations}
	1217	{Returns S_OK if this is successful or E_INVALIDARG if one or more parameters are invalid.}
	1218	var
	1219	Data: PByte;
	1220	BufL, dwRead, dwActuallyRead: Cardinal;
	1221	begin
	1222	if (FSender.FCancel) and (Binding <> nil) then
	1223	binding.Abort
	1224	else
	1225	begin
	1226
	1227	if Assigned(FSender.FOnDataAvailableInfo) then
	1228	FSender.FOnDataAvailableInfo(Self, grfBSCF,
	1229	DataAvalibleToStr(grfBSCF) {, FormatEtc});
	1230
	1231	if Assigned(FBSCBTimer) then {reset our timer.}
	1232	begin
	1233	FBSCBTimer.Enabled := False;
	1234	FBSCBTimer.Enabled := True;
	1235	end;
	1236
	1237	if (grfBSCF = grfBSCF or BSCF_FIRSTDATANOTIFICATION) then
	1238	begin
	1239
	1240	if (fOutStream = nil) and (stgmed.tymed = TYMED_ISTREAM) then
	1241	fOutStream := IStream(stgmed.stm);
	1242	if Assigned(m_pPrevBSCB) and not Assigned(fsOutputFile)
	1243	and (BscbInfo.infFileName <> '') then
	1244	try
	1245	//TODO: check for resume
	1246	fsOutputFile := TFileStream.Create(DoSaveFileAs, fmCreate);
	1247	BscbInfo.infRangeBegin := 0;
	1248	except on EFCreateError do
	1249	begin
	1250	Binding.Abort;
	1251	Result := E_FAIL;
	1252	Exit;
	1253	fsOutputFile.Free;
	1254	end;
	1255	end;
	1256	end;
	1257	dwRead := dwSize - FTotalRead;
	1258	dwActuallyRead := 0;
	1259	if (dwRead > 0) then
	1260	repeat
	1261	Data := AllocMem(dwRead + 1);
	1262	fOutStream.Read(Data, dwRead, @dwActuallyRead);
	1263	BufL := dwActuallyRead;
	1264	if Assigned(FSender.FOnDataAvailable) then
	1265	begin
	1266	FSender.FOnDataAvailable(self, Data, BufL);
	1267	end;
	1268	if (BscbInfo.infFileName <> '') and Assigned(fsOutputFile) then
	1269	begin
	1270	fsOutputFile.WriteBuffer(Data^, BufL);
	1271	end
	1272	else if Assigned(Stream) then
	1273	Stream.WriteBuffer(Data^, BufL);
	1274	Inc(FTotalRead, dwActuallyRead);
	1275	FreeMem(Data);
	1276	until dwActuallyRead = 0;
	1277	end;
	1278	Result := S_OK;
	1279	{if (grfBSCF = grfBSCF or BSCF_FIRSTDATANOTIFICATION) then
	1280	begin
	1281	if (fOutStream = nil) and (stgmed.tymed = TYMED_ISTREAM) then
	1282	fOutStream := IStream(stgmed.stm);
	1283	if Assigned(m_pPrevBSCB) and not Assigned(fsOutputFile)
	1284	//and (BscbInfo.infFileName <> '')
	1285	then
	1286	// and (FSender.FDownloadMethod = dmFile) then
	1287	try
	1288	fsOutputFile := TFileStream.Create(DoSaveFileAs, fmCreate);
	1289	BscbInfo.infRangeBegin := 0;
	1290	except on EFCreateError do
	1291	begin
	1292	Binding.Abort;
	1293	Result := E_INVALIDARG;
	1294	if Assigned(FSender.FOnError) then
	1295	FSender.FOnError(GetLastError, SysErrorMessage(GetLastError));
	1296	fsOutputFile.Free;
	1297	Exit;
	1298	end;
	1299	end;
	1300	end;
	1301	dwRead := dwSize - FTotalRead;
	1302	dwActuallyRead := 0;
	1303	if (dwRead > 0) then
	1304	repeat
	1305	Data := AllocMem(dwRead + 1); //to fix stack overflow
	1306	fOutStream.Read(Data, dwRead, @dwActuallyRead);
	1307	BufL := dwActuallyRead;
	1308	if Assigned(FSender.FOnDataAvailable) then
	1309	FSender.FOnDataAvailable(Self, Data, Bufl);
	1310	try
	1311	Stream.WriteBuffer(Data^, Bufl);
	1312	except
	1313	on EWriteError do
	1314	begin
	1315	Binding.Abort;
	1316	Result := E_INVALIDARG;
	1317	if Assigned(FSender.FOnError) then
	1318	FSender.FOnError(GetLastError, SysErrorMessage(GetLastError));
	1319	fsOutputFile.Free;
	1320	Exit;
	1321	end;
	1322	end;
	1323
	1324	if (FSender.FDownloadMethod = dmFile) and Assigned(fsOutputFile) then
	1325	begin
	1326	try
	1327	fsOutputFile.WriteBuffer(Data^, bufl);
	1328	except
	1329	on EWriteError do
	1330	begin
	1331	Binding.Abort;
	1332	Result := E_INVALIDARG;
	1333	if Assigned(FSender.FOnError) then
	1334	FSender.FOnError(GetLastError, SysErrorMessage(GetLastError));
	1335	fsOutputFile.Free;
	1336	Exit;
	1337	end
	1338	end;
	1339	end;
	1340	Inc(FTotalRead, dwActuallyRead);
	1341	FreeMem(Data);
	1342	until dwActuallyRead = 0;
	1343	end;
	1344	Result := S_OK;}
	1345	end;
	1346
	1347	function TBSCB.OnLowResource(Reserved: DWORD): HRESULT;
	1348	{Not implemented by MS.}
	1349	begin
	1350	Result := E_NOTIMPL;
	1351	end;
	1352
	1353	function TBSCB.OnObjectAvailable(const IID: TGUID; punk: IUnknown): HRESULT;
	1354	{Passes the requested object interface pointer to the client.}
	1355	{Returns S_OK if this is successful or E_INVALIDARG if one or more parameters are invalid.}
	1356	begin
	1357	Self._AddRef;
	1358	if (FSender.FCancel) and (Binding <> nil) then
	1359	binding.Abort;
	1360	Result := S_OK;
	1361	end;
	1362
	1363	function TBSCB.OnProgress(ulProgress, ulProgressMax, ulStatusCode: ULONG;
	1364	szStatusText: LPCWSTR): HRESULT;
	1365	{Indicates the progress and the status of the bind operation.}
	1366	{Returns S_OK if this is successful or E_INVALIDARG if one or more parameters are invalid.}
	1367	{Avalible flags: http://msdn.microsoft.com/en-us/library/ms775133(VS.85).aspx}
	1368	var
	1369	Percent, Speed, Elapsed, Downloaded, RemainingTime, Status: string;
	1370	_Speed: Single;
	1371	bAbort: Boolean;
	1372	tmpElapsed, iFileSize: integer;
	1373	begin
	1374	if (FSender.FCancel) and (Binding <> nil) then
	1375	Binding.Abort
	1376	else
	1377	begin
	1378	tmpElapsed := 0;
	1379	bAbort := False;
	1380	Status := ResponseCodeToStr(ulStatusCode);
	1381	if (ulProgress > ulProgressMax) then
	1382	ulProgressMax := ulProgress;
	1383	iFileSize := ulProgressMax;
	1384	FSender.FFileSize := ulProgressMax;
	1385	{For a download manager}
	1386	if Assigned(m_pPrevBSCB) then
	1387	begin
	1388	{Weed to do this otherwise a filedownload dlg will be displayed
	1389	as we are downloading the file.}
	1390	if (ulStatusCode = BINDSTATUS_CONTENTDISPOSITIONATTACH) then
	1391	begin
	1392	Result := S_OK;
	1393	Exit; {We must exit so no DLG will be displayed}
	1394	end;
	1395	m_pPrevBSCB.OnProgress(ulProgress, ulProgressMax, ulStatusCode,
	1396	szStatusText);
	1397	end;
	1398	case ulStatusCode of
	1399	BINDSTATUS_REDIRECTING: {redirecting}
	1400	begin
	1401	FRedirect := True;
	1402	FSender.FServerAddress := szStatusText;
	1403	if (Assigned(FSender.FOnRedirect)) and
	1404	(FSender.FUrl <> szStatusText) then
	1405	FSender.FOnRedirect(Self, bAbort, FSender.FUrl, szStatusText);
	1406	if bAbort then {If we do not wish to be redirect}
	1407	begin
	1408	FSender.FCancel := True;
	1409	Result := E_INVALIDARG;
	1410	Exit;
	1411	end;
	1412	{Get the new addreess after redirecing}
	1413	if (FSender.FDownloadMethod = dmFile) then
	1414	FSender.SetFileNameFromUrl(szStatusText);
	1415	end;
	1416	BINDSTATUS_CONNECTING: FSender.FServerIP := szStatusText;
	1417	BINDSTATUS_MIMETYPEAVAILABLE: FSender.FMimeType := szStatusText;
	1418	BINDSTATUS_BEGINDOWNLOADDATA: FSender.FServerAddress := szStatusText;
	1419	BINDSTATUS_DOWNLOADINGDATA: {We are downloading so here we will calculate download variables}
	1420	if Assigned(FSender.FOnProgress) then
	1421	begin
	1422	if (ulProgress {+ BscbInfo.infRangeBegin} > 0) then
	1423	Downloaded := FormatSize(ulProgress {+ BscbInfo.infRangeBegin});
	1424	if (ulProgressMax > 0) and (ulProgress > 0) then
	1425	Percent := Format('%.1f %%', [ulProgress / ulProgressMax * 100]);
	1426	QueryPerformanceCounter(TimeNow);
	1427	if (TimeNow > TimeStarted)
	1428	{and (Round((TimeNow-TimeStarted)/Frequency) <= tmpElapsed)}then
	1429	begin
	1430	tmpElapsed := Round((TimeNow - TimeStarted) / Frequency);
	1431	Elapsed := SecToStr(tmpElapsed);
	1432	end;
	1433	try
	1434	if (ulProgress > 0) and (tmpElapsed > 0) then
	1435	_Speed := ulProgress / 1024 / tmpElapsed
	1436	else
	1437	_Speed := 0;
	1438	Speed := Format('%.1f ' + kb_sec, [_Speed]);
	1439	if (ulProgressMax > 0) and ((_Speed) > 0) and (ulProgressMax >
	1440	ulProgress) then
	1441	RemainingTime := SecToStr(Round(ulProgressMax / _speed / 1000)
	1442	- Round(ulProgress / _speed / 1000))
	1443	else
	1444	RemainingTime := TimeToStr(0);
	1445	except
	1446	on EZeroDivide do
	1447	RemainingTime := TimeToStr(0);
	1448	end;
	1449	end;
	1450
	1451	BINDSTATUS_ENDDOWNLOADDATA: {You are joking right? NO MORE DATA TO DOWNLOAD}
	1452	begin
	1453	Downloaded := done;
	1454	ulProgress := 0;
	1455	ulProgressMax := 0;
	1456	Speed := '0/00' + kb_sec;
	1457	RemainingTime := '00.00.00';
	1458	Status := done;
	1459	Percent := '100%';
	1460	end;
	1461	{Here you can add more handlers to any BINDSTATUS_ you like}
	1462	end;
	1463
	1464	if Assigned(FSender.FOnProgress) then {Publish the event}
	1465	FSender.FOnProgress(Self, ulProgress {+ BscbInfo.infRangeBegin},
	1466	ulProgressMax {+ BscbInfo.infRangeBegin}, ulStatusCode, iFileSize, szStatusText,
	1467	Downloaded, Elapsed, Speed, RemainingTime, Status, Percent);
	1468	end;
	1469	Result := S_OK;
	1470	end;
	1471
	1472	function TBSCB.GetFileNameFromUrl(Url: string): string;
	1473	var
	1474	Ut: TUrl;
	1475	begin
	1476	Ut := TUrl.Create(Url);
	1477	try
	1478	Ut.CrackUrl(Url, ICU_ESCAPE);
	1479	if AnsiPos('.', Ut.ExtraInfo) = 0 then
	1480	Result := FSender.FDefaultUrlFileName
	1481	else
	1482	Result := Ut.ExtraInfo;
	1483	finally
	1484	Ut.Free;
	1485	end;
	1486	end;
	1487
	1488	function TBSCB.OnStartBinding(dwReserved: DWORD; pib: IBinding): HRESULT;
	1489	{Notifies the client about the callback methods that it is registered to receive.}
	1490	{Returns S_OK if this is successful or
	1491	E_INVALIDARG if the pib parameter is invalid.
	1492	To abort the binding we should return E_FAIL.}
	1493	var
	1494	bAbort: Boolean;
	1495	begin
	1496	//dwReserved:= 0; // A demand by ms that is not needed.}
	1497	if FSender.FCancel then
	1498	Result := E_FAIL
	1499	else
	1500	begin
	1501
	1502	Result := S_OK;
	1503	bAbort := False;
	1504	Binding := pib; {A pointer to the IBinding interface}
	1505	Binding._AddRef; {To be released on StopBinding}
	1506	{We will try to get the file size using query info}
	1507	QueryInfo(HTTP_QUERY_CONTENT_LENGTH, BscbInfo.infFileSize);
	1508	QueryInfoFileName;
	1509	if Assigned(FSender.FOnBeforeDownload) then
	1510	FSender.FOnBeforeDownload(BscbInfo, BscbInfo.infUrl, BscbInfo.infFileName,
	1511	BscbInfo.infFileExt, BscbInfo.infHost, BscbInfo.infDownloadFolder,
	1512	BscbInfo.infFileSize, bAbort);
	1513
	1514	{For the download manager}
	1515	FSender.FFileName := BscbInfo.infFileName;
	1516	FSender.FDownloadFolder := BscbInfo.infDownloadFolder;
	1517	if Assigned(m_pPrevBSCB) then
	1518	m_pPrevBSCB.OnStopBinding(HTTP_STATUS_OK, nil);
	1519
	1520	{Remove file name which is not needed for stream}
	1521	case FSender.FDownloadMethod of
	1522	dmStream: BscbInfo.infFileName := EmptyStr;
	1523	dmFile:
	1524	begin {Try # 2}
	1525	if (BscbInfo.infFileName = EmptyStr) and (FSender.FDownloadTo = dtMoniker) then
	1526	BscbInfo.infFileName := GetFileNameFromUrl(FSender.FUrl)
	1527	else
	1528	begin
	1529	if (BscbInfo.infFileName = EmptyStr) and (not FSender.bRenamed) and
	1530	(BscbInfo.infFileName <> GetFileNameFromUrl(BscbInfo.infUrl)) then
	1531	BscbInfo.infFileName := GetFileNameFromUrl(BscbInfo.infUrl);
	1532	end;
	1533	end;
	1534	end;
	1535	if Assigned(FSender.FOnStartBinding) then
	1536	FSender.FOnStartBinding(Self, bAbort, Binding, BscbInfo.infFileName, BscbInfo.infFileSize);
	1537	if bAbort then
	1538	begin {Note: We are still in busy state until OnStopBinding!!}
	1539	Result := E_FAIL; {Do not use Binding.Abort! Just send E_FAIL}
	1540	FSender.FCancel := True;
	1541	end;
	1542	end;
	1543	end;
	1544
	1545	function TBSCB.OnStopBinding(HRESULT: HRESULT; szError: LPCWSTR): HRESULT;
	1546	{This method indicates the end of the bind operation.
	1547	Returns S_OK if this is successful or an error value otherwise.}
	1548	var
	1549	clsidProtocol: TCLSID;
	1550	dwResult: DWORD;
	1551	szResult: POLEStr;
	1552	HR: System.HRESULT;
	1553	begin //OK
	1554	if (FSender.FDownloadTo = dtDownloadToFile)
	1555	or (FSender.FDownloadTo = dtDownloadToCache) then
	1556	begin
	1557	Result := S_OK;
	1558	Exit;
	1559	end;
	1560
	1561	if (Assigned(m_pPrevBSCB) and Assigned(FBindCtx)) then
	1562	{Stores an IUnknown pointer on the specified object }
	1563	begin {To be used with a download manager}
	1564	HR := FBindCtx.RegisterObjectParam('_BSCB_Holder_', m_pPrevBSCB);
	1565	if Failed(HR) and Assigned(FSender.FOnError) then
	1566	FSender.FOnError(GetLastError, SysErrorMessage(GetLastError))
	1567	else if (Assigned(FSender.FOnConnect)) then
	1568	FSender.FOnConnect(Self, HR, Registering_new_moniker +
	1569	ResponseCodeToStr(HR));
	1570	m_pPrevBSCB._Release;
	1571	m_pPrevBSCB := nil;
	1572	FBindCtx._Release;
	1573	FBindCtx := nil;
	1574	Dec(FSender.FRefCount);
	1575	end;
	1576
	1577	GetBindResult(clsidProtocol, dwResult, szResult);
	1578	if FTimedOut then
	1579	begin {If we reached TimeOut them we will post the event}
	1580	HRESULT := INET_E_CONNECTION_TIMEOUT;
	1581	if Assigned(FSender.FOnError) then
	1582	FSender.FOnError(HRESULT, ResponseCodeToStr(HRESULT));
	1583	end;
	1584	if Assigned(FSender.FOnStopBinding) then
	1585	FSender.FOnStopBinding(Self, HRESULT, szError);
	1586	Result := HRESULT;
	1587	FSender.FState := sStopped;
	1588	if Assigned(FSender.FOnStateChange) then
	1589	FSender.FOnStateChange(FSender.FState);
	1590
	1591	if Assigned(FSender.FOnStreamComplete) then
	1592	FSender.FOnStreamComplete(Self, Stream, HRESULT);
	1593	FSender.bDone := True;
	1594	SetEvent(FSender.hStop);
	1595	Terminate;
	1596	Dec(FSender.FActiveConnections);
	1597	if FSender.FActiveConnections = 0 then
	1598	SetEvent(FSender.hProcess);
	1599	end;
	1600
	1601	{IServiceProvider Interface}
	1602
	1603	function TBSCB.QueryService(const rsid, iid: TGUID; out Obj): HRESULT;
	1604	begin
	1605	Pointer(Obj) := nil;
	1606	if Assigned(FSender.FOnQueryService) then
	1607	FSender.FOnQueryService(Self, rsid, iid, IUnknown(obj));
	1608	if Pointer(Obj) <> nil then
	1609	Result := S_OK
	1610	else
	1611	Result := E_NOINTERFACE;
	1612	end;
	1613
	1614	{ICodeInstall Interface}
	1615
	1616	function TBSCB.OnCodeInstallProblem(ulStatusCode: ULONG; szDestination,
	1617	szSource: LPCWSTR; dwReserved: DWORD): HResult; stdcall;
	1618	{Returns a value based on the status passed in, which indicates
	1619	whether to abort the application installation or file download.
	1620	S_OK Indicates that the installation or download should continue.
	1621	E_ABORT Indicates that the installation or download should abort.}
	1622	begin
	1623	dwReserved := 0;
	1624	if Assigned(FSender.FOnCodeInstallProblem) then
	1625	Result := FSender.FOnCodeInstallProblem(Self, ulStatusCode, szDestination,
	1626	szSource, dwReserved, ResponseCodeToStr(ulStatusCode))
	1627	else
	1628	Result := S_OK;
	1629	end;
	1630
	1631	{IUnknown Interface}
	1632
	1633	function TBSCB.QueryInterface(const IID: TGUID; out Obj): HRESULT;
	1634	{S_OK if the interface is supported, E_NOINTERFACE if not.}
	1635	begin
	1636	Self._AddRef;
	1637	if Assigned(FSender.OnQueryInterface) then
	1638	FSender.OnQueryInterface(IID, Obj);
	1639	if GetInterface(IID, Obj) then
	1640	Result := 0
	1641	else
	1642	Result := E_NOINTERFACE;
	1643	end;
	1644
	1645	function TBSCB._AddRef: Integer;
	1646	{The IUnknown::AddRef method increments the reference count for
	1647	an interface on an object.}
	1648	begin
	1649	Result := InterlockedIncrement(FSender.FRefCount);
	1650	end;
	1651
	1652	function TBSCB._Release: Integer;
	1653	{Decrements the reference count for the calling interface on a object. }
	1654	begin
	1655	Result := InterlockedDecrement(FSender.FRefCount);
	1656	if Result = 0 then
	1657	Destroy;
	1658	end;
	1659
	1660	{IWindowForBindingUI Interface}
	1661
	1662	function TBSCB.GetWindow(const GUIDReason: TGUID; out hwnd): HRESULT;
	1663	{Returns S_OK if the window handle was successfully returned,
	1664	or E_INVALIDARG if the phwnd parameter is invalid.
	1665	If you implement this interface, you can return S_FALSE
	1666	for this method to indicate that no window is available for
	1667	to display user interface information.}
	1668	begin
	1669	if Assigned(FSender.FGetWindow) then
	1670	Result := FSender.FGetWindow(Self, GUIDReason, LongWord(hwnd))
	1671	else
	1672	Result := S_OK;
	1673	end;
	1674
	1675	{IHttpSecurity}
	1676
	1677	function TBSCB.OnSecurityProblem(dwProblem: DWORD): HResult;
	1678	{RPC_E_RETRY The calling application should continue or retry the download.
	1679	S_FALSE The calling application should open a dialog box to warn the user.
	1680	E_ABORT The calling application should abort the download.}
	1681	begin
	1682	if Assigned(FSender.FOnSecurityProblem) then
	1683	Result := FSender.FOnSecurityProblem(Self, dwProblem,
	1684	ResponseCodeToStr(dwProblem))
	1685	else
	1686	Result := S_FALSE;
	1687	end;
	1688
	1689	function TBSCB.GetSerializedClientCertContext(out ppbCert: Byte; var pcbCert: DWORD): HResult; stdcall;
	1690	begin
	1691	if Assigned(FSender.FOnGetClientCert) then
	1692	Result := FSender.FOnGetClientCert(Self, ppbCert, pcbCert)
	1693	else
	1694	Result := S_FALSE;
	1695	end;
	1696	{$IFDEF DELPHI6_UP}
	1697
	1698	function TBSCB.AuthenticateEx(out phwnd: HWND; out pszUsername,
	1699	pszPassword: LPWSTR; var pauthinfo: AUTHENTICATEINFO): HResult; stdcall;
	1700	var
	1701	aUser, aPwd: WideString;
	1702	tmpHWND: HWND;
	1703	begin
	1704	Result := S_OK;
	1705	phwnd := FSender.FHWnd;
	1706	aUser := EmptyStr;
	1707	aPwd := EmptyStr;
	1708	if Assigned(FSender.FOnAuthenticateEx) then
	1709	FSender.FOnAuthenticateEx(Self, tmpHWND, aUser, aPwd,
	1710	pauthinfo, Result);
	1711	if aUser <> EmptyStr then
	1712	pszUserName := WidestringToLPOLESTR(aUser)
	1713	else
	1714	pszUserName := nil;
	1715	if aPwd <> EmptyStr then
	1716	pszPassWord := WidestringToLPOLESTR(aPwd)
	1717	else
	1718	pszPassWord := nil;
	1719	end;
	1720
	1721	function TBSCB.PutProperty(mkp: MONIKERPROPERTY; val: LPCWSTR): HResult;
	1722	{This interface is implemented by persistent monikers,
	1723	such as a MIME handler, to get properties about the moniker
	1724	being handled.}
	1725	begin
	1726	if Assigned(FSender.FOnPutProperty) then
	1727	Result := FSender.FOnPutProperty(Self, mkp, val)
	1728	else
	1729	Result := E_NOTIMPL;
	1730	end;
	1731	{$ENDIF}
	1732
	1733	function TBSCB.GetBindResult(out clsidProtocol: TCLSID; out dwResult: DWORD;
	1734	out szResult: POLEStr): HRESULT;
	1735	{Gets the protocol-specific outcome of a bind operation.}
	1736	var
	1737	dwReserved: DWORD;
	1738	begin
	1739	dwReserved := 0;
	1740	if (Binding <> nil) then
	1741	Result := Binding.GetBindResult(clsidProtocol, dwResult, szResult,
	1742	dwReserved)
	1743	else
	1744	Result := E_FAIL;
	1745	if Assigned(FSender.FOnGetBindResults) then
	1746	FSender.FOnGetBindResults(Self, clsidProtocol, dwResult,
	1747	szResult, ResponseCodeToStr(dwResult));
	1748	if (Result <> S_OK) and (Assigned(FSender.FOnError)) then
	1749	FSender.FOnError(Result, ResponseCodeToStr(Result));
	1750	end;
	1751
	1752	function TBSCB.CheckCancelState: Integer;
	1753	begin
	1754	if (FSender.FCancel = True) then
	1755	Result := E_ABORT
	1756	else
	1757	Result := S_OK;
	1758	end;
	1759
	1760	procedure TBSCB.TimerExpired(Sender: TObject);
	1761	begin
	1762	FTimedOut := True;
	1763	end;
	1764
	1765	procedure TBSCB.ClearAll;
	1766	begin {Reset our resources}
	1767	if Assigned(Binding) then
	1768	Binding.Abort;
	1769	FGlobalData := 0;
	1770	FTotalRead := 0;
	1771	if m_pPrevBSCB <> nil then
	1772	m_pPrevBSCB := nil;
	1773	end;
	1774
	1775	function TBSCB.QueryInfo(dwOption: DWORD; var Info: Cardinal): Boolean;
	1776	var
	1777	HttpInfo: IWinInetHttpInfo;
	1778	C: Cardinal;
	1779	BufferLength: Cardinal;
	1780	Reserved, dwFlags: Cardinal;
	1781	begin
	1782	if (Assigned(Binding) and (Binding.QueryInterface(IWinInetHttpInfo, HttpInfo)
	1783	= S_OK)) then
	1784	begin
	1785	Info := 0;
	1786	Reserved := 0;
	1787	dwFlags := 0;
	1788	BufferLength := SizeOf(Cardinal);
	1789	Result := not Boolean(HttpInfo.QueryInfo(dwOption or HTTP_QUERY_FLAG_NUMBER,
	1790	@C, BufferLength, dwFlags, Reserved));
	1791	HttpInfo := nil;
	1792	if Result then
	1793	Info := C;
	1794	end
	1795	else
	1796	Result := False;
	1797	end;
	1798
	1799	function TBSCB.QueryInfo(dwOption: DWORD; var Info: string): Boolean;
	1800	var
	1801	Buf: array[0..INTERNET_MAX_PATH_LENGTH] of AnsiChar;
	1802	HttpInfo: IWinInetHttpInfo;
	1803	BufLength, dwReserved, dwFlags: Cardinal;
	1804	begin
	1805	if (Assigned(Binding) and (Binding.QueryInterface(IWinInetHttpInfo, HttpInfo)
	1806	= S_OK)) then
	1807	begin
	1808	Info := '';
	1809	dwReserved := 0;
	1810	dwFlags := 0;
	1811	BufLength := INTERNET_MAX_PATH_LENGTH + 1;
	1812	Result := not Boolean(HttpInfo.QueryInfo(dwOption, @Buf, BufLength, dwFlags,
	1813	dwReserved));
	1814	HttpInfo := nil;
	1815	if Result then
	1816	Info := string(Buf);
	1817	end
	1818	else
	1819	Result := False;
	1820	end;
	1821
	1822	function TBSCB.QueryInfo(dwOption: DWORD; var Info: TDateTime): Boolean;
	1823	var
	1824	HttpInfo: IWinInetHttpInfo;
	1825	SysTime: TSystemtime;
	1826	BufferLength: Cardinal;
	1827	Reserved, dwFlags: Cardinal;
	1828	begin
	1829	if (Assigned(Binding) and (Binding.QueryInterface(IWinInetHttpInfo, HttpInfo)
	1830	= S_OK)) then
	1831	begin
	1832	Info := 0;
	1833	Reserved := 0;
	1834	dwFlags := 0;
	1835	BufferLength := SizeOf(TSystemTime);
	1836	Result := not Boolean(HttpInfo.QueryInfo(dwOption or
	1837	HTTP_QUERY_FLAG_SYSTEMTIME,
	1838	@SysTime, BufferLength, dwFlags, Reserved));
	1839	HttpInfo := nil;
	1840	if Result then
	1841	Info := SystemTimeToDateTime(SysTime);
	1842	end
	1843	else
	1844	Result := False;
	1845	end;
	1846
	1847	function TBSCB.DoSaveFileAs: string;
	1848	begin
	1849	if FSender.FDownloadMethod = dmFile then
	1850	begin
	1851	with BscbInfo do
	1852	begin
	1853	if (infFileName = EmptyStr) then
	1854	infFileName := FSender.SetFileNameFromUrl(infUrl);
	1855	if (infFileName = EmptyStr) then
	1856	infFileName := FSender.FDefaultUrlFileName;
	1857	end;
	1858	with FSender do
	1859	begin
	1860	FDownloadedFile := BscbInfo.infDownloadFolder + BscbInfo.infFileName;
	1861	FFileExtension := ExtractFileExt(FSender.FDownloadedFile);
	1862	BscbInfo.infFileExt := FFileExtension;
	1863	FFileName := BscbInfo.infFileName;
	1864	FDownloadFolder := BscbInfo.infDownloadFolder;
	1865	end;
	1866	Result := CharReplace(FSender.FDownloadedFile, '?', '_'); ;
	1867	end;
	1868	end;
	1869
	1870	function TBSCB.QueryInfoFileName: HRESULT;
	1871	const
	1872	CD_FILE_PARAM = 'filename=';
	1873	var
	1874	i: Integer;
	1875	st, sTmp: string;
	1876	res: Boolean;
	1877	begin
	1878	Result := E_FAIL;
	1879	sTmp := '';
	1880	res := QueryInfo(HTTP_QUERY_CONTENT_DISPOSITION, sTmp);
	1881	if not res then
	1882	Exit;
	1883	i := Pos(CD_FILE_PARAM, sTmp);
	1884	if (i > 0) then
	1885	begin
	1886	sTmp := Copy(sTmp, i + Length(CD_FILE_PARAM), Length(sTmp) - i);
	1887	if (sTmp[1] = '"') then
	1888	i := Pos('";', sTmp)
	1889	else
	1890	i := Pos(';', sTmp);
	1891	//TODO: what's happen, if the filename contains a quotion mark?
	1892	if (i > 0) then
	1893	sTmp := Copy(sTmp, 1, i);
	1894	if (sTmp[1] = '"') then
	1895	begin
	1896	st := (Copy(sTmp, 2, Length(sTmp) - 2));
	1897	BscbInfo.infFileName := Copy(sTmp, 2, Length(sTmp) - 2);
	1898	end
	1899	else
	1900	BscbInfo.infFileName := sTmp;
	1901	if (Length(sTmp) > 0) then
	1902	Result := S_OK;
	1903	end;
	1904	FSender.FFileName := BscbInfo.infFileName; {Return Data}
	1905	end;
	1906
	1907	function TBSCB.IsRunning: Boolean;
	1908	begin
	1909	if (Succeeded(FMoniker.IsRunning(FBindCtx, FMoniker, nil))) then
	1910	Result := True
	1911	else
	1912	Result := False;
	1913	end;
	1914
	1915	function TBSCB.GetDisplayName: PWideChar;
	1916	begin {Expensive operation so I'll do it only once.
	1917	For extra info use MkParseDisplayName }
	1918	if IsRunning then
	1919	FMoniker.GetDisplayName(FBindCtx, nil, Result);
	1920	end;
	1921
	1922	function TBSCB.MkParseDisplayName(var DisplayName: PWideChar): IMoniker;
	1923	var
	1924	i: cardinal;
	1925	begin
	1926	UrlMon.MkParseDisplayNameEx(FBindCtx, DisplayName, i, Result);
	1927	end;
	1928
	1929	function TBSCB.CreateMoniker(szName: POLEStr; BC: IBindCtx; out mk: IMoniker;
	1930	dwReserved: DWORD): HResult;
	1931	begin
	1932	szName := StringToOleStr(BscbInfo.infUrl);
	1933	Result := CreateURLMonikerEx(nil, szName, FMoniker, URL_MK_UNIFORM {URL_MK_LEGACY});
	1934	end;
	1935
	1936	function TBSCB.MonikerBindToStorage(Mk: IMoniker; BC: IBindCtx; BSC:
	1937	IBindStatusCallback;
	1938	const iid: TGUID; out pvObj{$IFNDEF DELPHI8_UP}: Pointer{$ENDIF}): HResult;
	1939	begin
	1940	Mk := FMoniker;
	1941	BC := FBindCtx;
	1942	BSC := Self;
	1943	Result := Mk.BindToStorage(BC, nil, IStream, fOutStream);
	1944	end;
	1945
	1946	function TBSCB.MonikerBindToObject(Mk: IMoniker; BC: IBindCtx; BSC:
	1947	IBindStatusCallback;
	1948	const iid: TGUID; out pvObj{$IFNDEF DELPHI8_UP}: Pointer{$ENDIF}): HResult;
	1949	begin
	1950	Mk := FMoniker;
	1951	BC := FBindCtx;
	1952	BSC := Self;
	1953	Result := Mk.BindToObject(BC, nil, IStream, fOutStream);
	1954	end;
	1955
	1956	function TBSCB.AbortBinding: HRESULT;
	1957	begin
	1958	Result := E_Fail;
	1959	if Assigned(Binding) then
	1960	Result := Binding.Abort;
	1961	end;
	1962
	1963	destructor TBSCB.Destroy;
	1964	begin {Cleaning out and free our resources}
	1965	ClearAll;
	1966	if Assigned(Stream) then
	1967	FreeAndNil(Stream);
	1968	if Assigned(FBSCBTimer) then
	1969	FreeAndNil(FBSCBTimer);
	1970	if Assigned(fsOutputFile) then
	1971	FreeAndNil(fsOutputFile);
	1972	if (FGlobalData <> 0) then
	1973	GlobalFree(FGlobalData);
	1974	inherited;
	1975	end;
	1976
	1977	constructor TBSCB.Create(aSender: TCustomIEDownload; const pmk: IMoniker;
	1978	const pbc: IBindCtx; CreateSuspended: boolean);
	1979	var
	1980	tmp: PWideChar;
	1981	begin
	1982	inherited Create(CreateSuspended);
	1983	FreeOnTerminate := False;
	1984	if CreateSuspended then
	1985	ThreadStatus := tsSuspended
	1986	else
	1987	ThreadStatus := tsWaiting;
	1988	Stream := TMemoryStream.Create; {A stream to contain the download}
	1989	FSender := aSender;
	1990	FMoniker := pmk;
	1991	FBindCtx := pbc;
	1992	if FSender.FDownloadTo = dtMoniker then
	1993	begin
	1994	FSender.FBindF := FSender.FBindF + [GetNewestVersion];
	1995	FSender.DoUpdate;
	1996	FMoniker.GetDisplayName(FBindCtx, nil, tmp);
	1997	FSender.FUrl := tmp;
	1998	FSender.ItemsManager.SessionList.Add(tmp);
	1999	end;
	2000	end;
	2001
	2002	procedure TBSCB.SetComponents;
	2003	begin {Initial all internals before the process}
	2004	QueryPerformanceFrequency(Frequency);
	2005	QueryPerformanceCounter(TimeStarted);
	2006	ClearAll; {Clearing Internals}
	2007	FBSCBTimer := TTimer.Create(nil); {Creating Timer for a TimeOut option}
	2008	FBSCBTimer.OnTimer := TimerExpired;
	2009	FBSCBTimer.Interval := BscbInfo.infTimeOut;
	2010	FTimedOut := False;
	2011	LongTimeFormat := Frmt_Time;
	2012	if not FSender.IsSynchronous(BscbInfo) then {We are on Asynchronous mode}
	2013	begin
	2014	FSender.ItemsManager.Add(Self); {Adding asynchronous items}
	2015	Inc(BscbInfo.infIndex); {Pass the index}
	2016	Inc(FSender.FdlCounter);
	2017	end;
	2018	end;
	2019
	2020	procedure TBSCB.Resume;
	2021	begin
	2022	inherited;
	2023	ThreadStatus := tsRunning;
	2024	end;
	2025
	2026	procedure TBSCB.Suspend;
	2027	begin
	2028	inherited;
	2029	ThreadStatus := tsSuspended;
	2030	end;
	2031
	2032	procedure TBSCB.Terminate;
	2033	var
	2034	bCanc: Boolean;
	2035	begin
	2036	if FSender.ActiveConnections = 0 then
	2037	FSender.FBusy := False;
	2038	ThreadStatus := tsTerminated;
	2039	bCanc := False;
	2040	if Assigned(FSender.FOnTerminate) then
	2041	FSender.FOnTerminate(Self, ThreadID, BscbInfo.infFileName, bCanc);
	2042	if bCanc then
	2043	FSender.CancelAll;
	2044	inherited;
	2045	end;
	2046
	2047	procedure TBSCB.Execute;
	2048	begin
	2049	if Terminated then
	2050	Exit;
	2051	try
	2052	{Dont be in shock, as a tread it sometimes fail so we should succeed now}
	2053	OleInitialize(nil);
	2054	except
	2055	end;
	2056	ThreadStatus := tsRunning;
	2057	Synchronize(ReceiveData);
	2058	Synchronize(SetComponents);
	2059	case FSender.FDownloadTo of
	2060	dtNormal:
	2061	begin
	2062	Synchronize(DoConnect);
	2063	Synchronize(ReturnData);
	2064	end;
	2065	dtMoniker:
	2066	begin
	2067	Synchronize(DoConnect);
	2068	Synchronize(ReturnData);
	2069	end;
	2070	dtDownloadToCache: Synchronize(DoDownloadToCache);
	2071	dtDownloadToFile: Synchronize(DoDownloadToFile);
	2072	end;
	2073	try
	2074	if (Assigned(BscbInfo)) then
	2075	finally
	2076	BscbInfo.Clear;
	2077	FreeAndNil(BscbInfo);
	2078	end;
	2079	OleUninitialize;
	2080	end;
	2081
	2082	procedure TBSCB.ReceiveData;
	2083	begin
	2084	BscbInfo := TInfoData.Create;
	2085	GetData(FSender); {Pass Data to the TObject}
	2086	FSender := TCustomIEDownload(BscbInfo.Sender);
	2087	end;
	2088
	2089	procedure TBSCB.ReturnData;
	2090	begin
	2091	with FSender do
	2092	begin
	2093	FDownloadedFile := BscbInfo.infDownloadFolder + BscbInfo.infFileName;
	2094	FFileExtension := ExtractFileExt(FSender.FDownloadedFile);
	2095	BscbInfo.infFileExt := FFileExtension;
	2096	FFileName := BscbInfo.infFileName;
	2097	FDownloadFolder := BscbInfo.infDownloadFolder;
	2098	end;
	2099	end;
	2100
	2101	procedure TBSCB.DoDownloadToCache;
	2102	var
	2103	Buf: array[0..INTERNET_MAX_PATH_LENGTH] of char;
	2104	begin
	2105	if Succeeded(UrlMon.URLDownloadToCacheFile(nil, Pchar(BscbInfo.infUrl),
	2106	Buf, SizeOf(Buf), 0, Self)) then
	2107	FSender.ExtractDataFromFile(Buf);
	2108	FSender.ItemsManager.Extract(Self);
	2109	end;
	2110
	2111	procedure TBSCB.DoDownloadToFile;
	2112	var
	2113	HR: integer;
	2114	tmp: string;
	2115	begin
	2116	tmp:= BscbInfo.infDownloadFolder + BscbInfo.infFileName;
	2117	HR := UrlMon.URLDownloadToFile(nil, Pchar(BscbInfo.infUrl),
	2118	PChar(tmp), 0, Self);
	2119	if Failed(HR) and Assigned(FSender.FOnError) then
	2120	FSender.FOnError(GetLastError, Err_ToFile + SysErrorMessage(GetLastError))
	2121	else if (Assigned(FSender.FOnConnect)) then
	2122	FSender.FOnConnect(Self, HR, DL_ToFile + ResponseCodeToStr(HR));
	2123	FSender.ExtractDataFromFile(tmp);
	2124	FSender.ItemsManager.Extract(Self);
	2125	end;
	2126
	2127	procedure TBSCB.DoConnect;
	2128	var
	2129	Ut: TUrl;
	2130	HR: HRESULT;
	2131	pPrevBSCB, tmpBSC: IBindStatusCallback;
	2132	begin
	2133	FSender.bDone := False;
	2134	FSender.hStop := 0;
	2135	if FSender.FDownloadTo <> dtMoniker then
	2136	begin
	2137	HR := CreateURLMonikerEx(nil, BscbInfo.infUrl, FMoniker, URL_MK_UNIFORM {URL_MK_LEGACY});
	2138	if Failed(HR) and Assigned(FSender.FOnError) then
	2139	begin
	2140	FSender.FOnError(GetLastError, Err_URLMEx +
	2141	ResponseCodeToStr(HR));
	2142	Exit;
	2143	end
	2144	else if (Assigned(FSender.FOnConnect)) then
	2145	FSender.FOnConnect(Self, HR, CreateURLMEx + ResponseCodeToStr(HR));
	2146
	2147	HR := CreateAsyncBindCtx(0, Self, nil, FBindCtx);
	2148	if Failed(HR) and Assigned(FSender.FOnError) then
	2149	begin
	2150	FSender.FOnError(GetLastError, Err_AsyncBindCtx +
	2151	ResponseCodeToStr(HR));
	2152	Exit;
	2153	end
	2154	else if (Assigned(FSender.FOnConnect)) then
	2155	FSender.FOnConnect(Self, HR, CreateABindCtx + ResponseCodeToStr(HR));
	2156	end;
	2157
	2158	FSender.FDisplayName := GetDisplayName;
	2159	begin
	2160	if FSender.FDisplayName <> EmptyStr then
	2161	begin
	2162	BscbInfo.infUrl := FSender.FDisplayName;
	2163	FSender.FUrl := FSender.FDisplayName;
	2164	end;
	2165	Ut := TUrl.Create(BscbInfo.infUrl);
	2166	try
	2167	Ut.QueryUrl(BscbInfo.infUrl);
	2168	BscbInfo.infFileName := Ut.Document;
	2169	BscbInfo.infHost := Ut.HostName;
	2170	finally
	2171	Ut.Free;
	2172	end;
	2173	end;
	2174
	2175	HR := RegisterBindStatusCallback(FBindCtx, Self, pPrevBSCB, 0);
	2176	if Failed(HR) and Assigned(pPrevBSCB) then
	2177	begin
	2178	HR := FBindCtx.RevokeObjectParam('_BSCB_Holder_');
	2179	if (Succeeded(HR)) then
	2180	begin {Attempt register again, should succeed now}
	2181	HR := RegisterBindStatusCallback(FBindCtx, Self, tmpBSC, 0);
	2182	if (SUCCEEDED(HR)) then
	2183	begin //Need to pass a pointer for BindCtx and previous BSCB to our implementation
	2184	m_pPrevBSCB := pPrevBSCB;
	2185	Self._AddRef;
	2186	m_pPrevBSCB._AddRef;
	2187	FBindCtx._AddRef;
	2188	if (Assigned(FSender.FOnConnect)) then
	2189	FSender.FOnConnect(Self, HR, Reg_BSCB + ResponseCodeToStr(HR));
	2190	end
	2191	else if Assigned(FSender.FOnError) then
	2192	FSender.FOnError(GetLastError, Err_RegBSCB
	2193	+ ResponseCodeToStr(HR));
	2194	end;
	2195	end
	2196	else if (Assigned(FSender.FOnConnect)) then
	2197	FSender.FOnConnect(Self, HR, Reg_BSCB +
	2198	ResponseCodeToStr(HR));
	2199	FSender.hStop := CreateEvent(nil, True, False, nil);
	2200	HR := FMoniker.BindToStorage(FBindCtx, nil, IStream, fOutStream);
	2201	if Failed(HR) and Assigned(FSender.FOnError) then
	2202	begin
	2203	FSender.FOnError(GetLastError, Err_BindToSt +
	2204	ResponseCodeToStr(HR));
	2205	Exit;
	2206	end
	2207	else if (Assigned(FSender.FOnConnect)) then
	2208	FSender.FOnConnect(Self, HR, Bind_To_St + ResponseCodeToStr(HR));
	2209	repeat
	2210	try
	2211	if FSender.WaitForProcess(FSender.hStop, FSender.FStartTick,
	2212	FSender.FTimeOut) then
	2213	except
	2214	if Assigned(FSender.FOnError) then
	2215	FSender.FOnError(E_FAIL, Err_Proc_Ev);
	2216	raise;
	2217	end;
	2218	until (FSender.FCancel) or (FSender.bDone)
	2219	{and (stream = nil)}{or (BscbInfo.infIndex = 0)};
	2220	HR := RevokeBindStatusCallback(FBindCtx, pPrevBSCB);
	2221	if Failed(HR) then
	2222	HR := RevokeBindStatusCallback(FBindCtx, tmpBSC);
	2223	if Failed(HR) and Assigned(FSender.FOnError) then
	2224	FSender.FOnError(HR, Err_Revoke + ResponseCodeToStr(HR))
	2225	else if (Assigned(FSender.FOnConnect)) then
	2226	FSender.FOnConnect(Self, HR, Revoke_BSCB + ResponseCodeToStr(S_OK));
	2227
	2228	if FSender.FActiveConnections = 0 then
	2229	FSender.FBusy := False;
	2230	if not FSender.IsSynchronous(BscbInfo) then {We are on asynchronous mode}
	2231	begin
	2232	FSender.ItemsManager.Extract(Self);
	2233	{Remove the item from our list because we finished}
	2234	Dec(BscbInfo.infIndex); {Pass the new index}
	2235	end;
	2236	end;
	2237
	2238	procedure TBSCB.GetData(aSender: TCustomIEDownload);
	2239	begin {Get data from IEDownload to the iedInfo}
	2240	with BscbInfo do
	2241	begin
	2242	infAdditionalHeader.AddStrings(aSender.FAdditionalHeader);
	2243	infBindF_Value := aSender.FBindF_Value;
	2244	infBindF2_Value := aSender.FBindF2_Value;
	2245	infBindInfoF_Value := aSender.FBindInfoF_Value;
	2246	infBindVerb_Value := aSender.FBindVerb_Value;
	2247	infBindInfoOptions_Value := aSender.FBindVerb_Value;
	2248	infCodePage_Value := aSender.FCodePageValue;
	2249	infCustomVerb := aSender.FCustomVerb;
	2250	infDescriptor := aSender.Security.FDescriptor;
	2251	infDownloadFolder := aSender.FDownloadFolder;
	2252	infExtraInfo := aSender.FExtraInfo;
	2253	infFileName := aSender.FFileName;
	2254	inFFileSize := 0;
	2255	infInheritHandle := aSender.Security.FInheritHandle;
	2256	infPassword := aSender.FPassword;
	2257	infPostData := aSender.FPostData;
	2258	infPutFileName := aSender.FPutFileName;
	2259	infRangeBegin := aSender.Range.FRangeBegin;
	2260	infRangeEnd := aSender.Range.FRangeEnd;
	2261	infTimeOut := aSender.FTimeOut;
	2262	infUrl := StringToOleStr(aSender.FUrl);
	2263	infUserName := aSender.FUserName;
	2264	Sender := aSender;
	2265	end;
	2266	end;
	2267
	2268	{Enf of Callback procedure------------------------------------------------------}
	2269
	2270	{BSCBList----------------------------------------------------------------------}
	2271
	2272	function TBSCBList.byURL(Url: string): TBSCB; //by Jury Gerasimov
	2273	var
	2274	i: integer;
	2275	begin
	2276	Result := nil;
	2277	for i := 0 to Count - 1 do
	2278	if Items[i].BscbInfo.infUrl = Url then
	2279	begin
	2280	Result := Items[i];
	2281	Break;
	2282	end;
	2283	end;
	2284
	2285	function TBSCBList.GetItem(Index: Integer): TBSCB;
	2286	begin
	2287	Result := TBSCB(inherited GetItem(Index));
	2288	end;
	2289
	2290	procedure TBSCBList.SetItem(Index: Integer; Value: TBSCB);
	2291	begin
	2292	inherited SetItem(Index, Value);
	2293	end;
	2294
	2295	constructor TBSCBList.Create;
	2296	begin
	2297	inherited Create;
	2298	SessionList := TStringList.Create;
	2299	end;
	2300
	2301	destructor TBSCBList.Destroy;
	2302	begin
	2303	FreeAndNil(SessionList);
	2304	inherited Destroy;
	2305	end;
	2306
	2307	{End of BSCBList---------------------------------------------------------------}
	2308
	2309	{IEDownload--------------------------------------------------------------------}
	2310
	2311	constructor TCustomIEDownload.Create(AOwner: TComponent);
	2312	begin
	2313	inherited;
	2314	TimeSeparator := '_'; {For the feRename}
	2315	FAbout := IED_INFO;
	2316	hProcess := 0;
	2317	bDone := False;
	2318	bCancelAll := False;
	2319	FAdditionalHeader := TStringlist.Create;
	2320	FAdditionalHeader.Add('Content-Type: application/x-www-form-urlencoded ');
	2321	FBindF := [Asynchronous, AsyncStorage, PullData, NoWriteCache,
	2322	GetNewestVersion];
	2323	FBindF2 := [ReadDataOver4GB];
	2324	FBindVerb := Get;
	2325	FCodePageOption := Ansi;
	2326	FBindInfoOption_ := [UseBindInfoOptions, AllowConnectMessages];
	2327	FDefaultProtocol := 'http://';
	2328	FDefaultUrlFileName := 'index.html';
	2329	FdlCounter := 0;
	2330	FActiveConnections := 0;
	2331	FDownloadMethod := dmFile;
	2332	FProxySettings := TProxySettings.Create;
	2333	FProxySettings.FPort := 80;
	2334	FRange := TRange.Create;
	2335	FRefCount := 0;
	2336	FSecurity := TSecurity.Create;
	2337	FState := sReady;
	2338	FBindInfoF := [];
	2339	ItemsManager := TBSCBList.Create;
	2340	SetUserAgent;
	2341	end;
	2342
	2343	procedure TCustomIEDownload.Loaded;
	2344	begin
	2345	inherited Loaded;
	2346	if FTimeOut = 0 then
	2347	FTimeOut := MaxInt;
	2348	if (FProxySettings.FAutoLoadProxy) and (FProxySettings.FServer <> EmptyStr)
	2349	then
	2350	FProxySettings.SetProxy(FFullUserAgent, FProxySettings.FServer + ':' +
	2351	IntToStr(FProxySettings.FPort));
	2352	end;
	2353
	2354	procedure TCustomIEDownload.Resume;
	2355	begin
	2356	if BS <> nil then
	2357	BS.Resume;
	2358	end;
	2359
	2360	procedure TCustomIEDownload.Suspend;
	2361	begin
	2362	if BS <> nil then
	2363	BS.Suspend;
	2364	end;
	2365
	2366	destructor TCustomIEDownload.Destroy;
	2367	begin
	2368	FTimeOut := 0;
	2369	FRange.Free;
	2370	FSecurity.Free;
	2371	FProxySettings.Free;
	2372	ItemsManager.Free;
	2373	if Assigned(FAdditionalHeader) then
	2374	FreeAndNil(FAdditionalHeader);
	2375	inherited;
	2376	end;
	2377
	2378	procedure TCustomIEDownload.BeforeDestruction;
	2379	begin
	2380	if FProxySettings.FAutoLoadProxy then
	2381	FProxySettings.SetProxy(EmptyStr, EmptyStr); {To restore proxy settings}
	2382	inherited BeforeDestruction;
	2383	end;
	2384
	2385	procedure TCustomIEDownload.Cancel;
	2386	begin
	2387	if (not FBusy) or (FState <> sBusy) then Exit;
	2388	FCancel := True;
	2389	Application.ProcessMessages;
	2390	end;
	2391
	2392	procedure TCustomIEDownload.Reset;
	2393	begin
	2394	if (FState = sBusy) then Exit;
	2395	FCancel := False;
	2396	bCancelAll := False;
	2397	Application.ProcessMessages;
	2398	end;
	2399
	2400	procedure TCustomIEDownload.CancelAll;
	2401	begin
	2402	if (not FBusy) or (FState <> sBusy) then Exit;
	2403	bCancelAll := True;
	2404	FCancel := True;
	2405	Application.ProcessMessages;
	2406	end;
	2407
	2408	procedure TCustomIEDownload.Cancel(const Item: TBSCB);
	2409	begin
	2410	Item.CheckCancelState;
	2411	FCancel := True;
	2412	end;
	2413
	2414	procedure TCustomIEDownload.Update_BindInfoF_Value;
	2415	const
	2416	Acard_BindInfoF_Values: array[TBindInfoF] of Cardinal = (
	2417	$00000001, $00000002);
	2418	var
	2419	i: TBindInfoF;
	2420	begin
	2421	FBindInfoF_Value := 0;
	2422	if (FBindInfoF <> []) then
	2423	for i := Low(TBindInfoF) to High(TBindInfoF) do
	2424	if (i in FBindInfoF) then
	2425	Inc(FBindInfoF_Value, Acard_BindInfoF_Values[i]);
	2426	end;
	2427
	2428	procedure TCustomIEDownload.Update_BindF_Value;
	2429	const
	2430	Acard_BindF_Values: array[TBindF] of Cardinal = (
	2431	$00000001, $00000002, $00000004, $00000008, $00000010, $00000020,
	2432	$00000040, $00000080, $00000100, $00000200, $00000400, $00000800,
	2433	$00001000, $00002000, $00004000, $00008000, $00010000, $00020000,
	2434	$00040000, $00080000, $00100000, $00200000, $00400000, $00800000);
	2435	var
	2436	i: TBindF;
	2437	begin
	2438	FBindF_Value := 0;
	2439	if (FBindF <> []) then
	2440	for i := Low(TBindF) to High(TBindF) do
	2441	if (i in FBindF) then
	2442	Inc(FBindF_Value, Acard_BindF_Values[i]);
	2443	end;
	2444
	2445	procedure TCustomIEDownload.Update_BindInfoOptions_Value;
	2446	const
	2447	AcardBindInfoOption_Values: array[TBindInfoOption] of Cardinal = (
	2448	$00010000, $00020000, $00040000, $00080000, $00100000, $00200000,
	2449	$00400000, $00800000, $01000000, $02000000, $08000000, $10000000,
	2450	$40000000, $80000000, $20000000);
	2451	var
	2452	i: TBindInfoOption;
	2453	begin
	2454	FBindInfoOption_Value := 0;
	2455	if (FBindInfoOption_ <> []) then
	2456	for i := Low(TBindInfoOption) to High(TBindInfoOption) do
	2457	if (i in FBindInfoOption_) then
	2458	Inc(FBindInfoOption_Value, AcardBindInfoOption_Values[i]);
	2459	end;
	2460
	2461
	2462	procedure TCustomIEDownload.Update_BindF2_Value;
	2463	const
	2464	AcardBindF2_Values: array[TBindF2] of Cardinal = ($00000001,
	2465	$00000002, $00000004, $00000008, $40000000, $80000000);
	2466	var
	2467	i: TBindF2;
	2468	begin
	2469	FBindF2_Value := 0;
	2470	if (FBindF2 <> []) then
	2471	for i := Low(TBindF2) to High(TBindF2) do
	2472	if (i in FBindF2) then
	2473	Inc(FBindF2_Value, AcardBindF2_Values[i]);
	2474	end;
	2475
	2476	function TCustomIEDownload.OpenFolder(const aFolderName: string): Boolean;
	2477	var
	2478	Int: integer;
	2479	begin
	2480	Result := False;
	2481	if (FDownloadMethod = dmFile) then
	2482	begin
	2483	Int := ShellExecute(Forms.Application.Handle, PChar('explore'),
	2484	PChar(aFolderName), nil, nil, SW_SHOWNORMAL);
	2485	Result := (Int > 32);
	2486	if not Result and Assigned(FOnError) then
	2487	FOnError(Int, Err_Folder);
	2488	end;
	2489	end;
	2490
	2491	procedure TCustomIEDownload.DoUpdate;
	2492	begin
	2493	Update_BindF_Value;
	2494	Update_BindF2_Value;
	2495	Update_BindInfoF_Value;
	2496	Update_BindInfoOptions_Value;
	2497	end;
	2498
	2499	function TCustomIEDownload.CodeInstallProblemToStr(const ulStatusCode: Integer):
	2500	string;
	2501	begin
	2502	Result := IEDownloadTools.CodeInstallProblemToStr(ulStatusCode);
	2503	end;
	2504
	2505	function TCustomIEDownload.CheckFileExists(const aFileName: string): boolean;
	2506	begin
	2507	Result := FileExists(aFileName);
	2508	end;
	2509
	2510	procedure TCustomIEDownload.Go(const aUrl: string);
	2511	begin
	2512	GoAction(aUrl, EmptyStr, EmptyStr, nil, nil);
	2513	if FOpenDownloadFolder then
	2514	OpenFolder(FDownloadFolder);
	2515	end;
	2516
	2517	procedure TCustomIEDownload.Go(const aUrl: string; const aFileName: string);
	2518	begin
	2519	GoAction(aUrl, aFileName, EmptyStr, nil, nil);
	2520	if FOpenDownloadFolder then
	2521	OpenFolder(FDownloadFolder);
	2522	end;
	2523
	2524	procedure TCustomIEDownload.Go(const aUrl: string; const aFileName: string;
	2525	const aDownloadFolder: string);
	2526	begin
	2527	GoAction(aUrl, aFileName, aDownloadFolder, nil, nil);
	2528	if FOpenDownloadFolder then
	2529	OpenFolder(FDownloadFolder);
	2530	end;
	2531
	2532	procedure TCustomIEDownload.GoList(const UrlsList: TStrings);
	2533	var
	2534	Idx: integer;
	2535	begin
	2536	for Idx := 0 to UrlsList.Count - 1 do
	2537	if (UrlsList[Idx] <> EmptyStr) and (not bCancelAll) then
	2538	GoAction(UrlsList[Idx], EmptyStr, EmptyStr, nil, nil);
	2539	if FOpenDownloadFolder then
	2540	OpenFolder(FDownloadFolder);
	2541	end;
	2542
	2543	procedure TCustomIEDownload.GoList(const UrlsList: TStrings; const FileNameList:
	2544	TStrings);
	2545	var
	2546	Idx: integer;
	2547	begin
	2548	for Idx := 0 to UrlsList.Count - 1 do
	2549	if (UrlsList[Idx] <> EmptyStr) and (not bCancelAll) then
	2550	GoAction(UrlsList[Idx], FileNameList[Idx], EmptyStr, nil, nil);
	2551	if FOpenDownloadFolder then
	2552	OpenFolder(FDownloadFolder);
	2553	end;
	2554
	2555	procedure TCustomIEDownload.GoList(const UrlsList: TStrings; const FileNameList:
	2556	TStrings;
	2557	const DownloadFolderList: TStrings);
	2558	var
	2559	Idx: integer;
	2560	begin
	2561	for Idx := 0 to UrlsList.Count - 1 do
	2562	if (UrlsList[Idx] <> EmptyStr) and (not bCancelAll) then
	2563	GoAction(UrlsList[Idx], FileNameList[Idx], DownloadFolderList[Idx], nil,
	2564	nil);
	2565	if FOpenDownloadFolder then
	2566	OpenFolder(FDownloadFolder);
	2567	end;
	2568
	2569	procedure TCustomIEDownload.Download(const pmk: IMoniker; const pbc: IBindCtx);
	2570	begin
	2571	FDownloadTo := dtMoniker;
	2572	PrepareForStart;
	2573	hProcess := CreateEvent(nil, True, False, nil);
	2574	if (not GoInit('', FFileName, FDownloadFolder)) then
	2575	begin
	2576	PrepareForExit;
	2577	Exit;
	2578	end;
	2579	BS := TBSCB.Create(Self, pmk, pbc, True);
	2580	try
	2581	BS.Execute;
	2582	repeat
	2583	try
	2584	if WaitForProcess(hProcess, FStartTick, FTimeOut) then
	2585	except
	2586	if Assigned(FOnError) then
	2587	FOnError(E_FAIL, Err_Proc_Ev);
	2588	raise;
	2589	end;
	2590	until (FCancel) or (FActiveConnections = 0);
	2591	finally
	2592	FreeAndNil(BS);
	2593	end;
	2594	PrepareForExit;
	2595	end;
	2596
	2597	function TCustomIEDownload.GoAction(const actUrl, actFileName, actDownloadFolder: string;
	2598	pmk: IMoniker; pbc: IBindCtx): boolean;
	2599	begin
	2600	Result := False;
	2601	PrepareForStart;
	2602	hProcess := CreateEvent(nil, True, False, nil);
	2603	if (not GoInit(actUrl, actFileName, actDownloadFolder)) then
	2604	begin
	2605	PrepareForExit;
	2606	Exit;
	2607	end;
	2608	BS := TBSCB.Create(Self, pmk, pbc, True); {Creating Download Callback}
	2609	try //Fix Deadlock?
	2610	BS.Execute;
	2611	repeat
	2612	try
	2613	if WaitForProcess(hProcess, FStartTick, FTimeOut) then
	2614	except
	2615	if Assigned(FOnError) then
	2616	FOnError(E_FAIL, Err_Proc_Ev);
	2617	raise;
	2618	end;
	2619	until (FCancel) or (FActiveConnections = 0);
	2620	finally
	2621	FreeAndNil(BS);
	2622	end;
	2623	PrepareForExit;
	2624	Result := True;
	2625	end;
	2626
	2627	function TCustomIEDownload.URLDownloadToCacheFile(const aUrl: string): string;
	2628	begin
	2629	Result := EmptyStr;
	2630	PrepareForStart;
	2631	if not GoInit(aUrl, '', '') then
	2632	Exit;
	2633	FDownloadTo := dtDownloadToCache;
	2634	BS := TBSCB.Create(Self, nil, nil, True);
	2635	try
	2636	BS.Execute;
	2637	BS.Terminate;
	2638	Dec(FActiveConnections);
	2639	finally
	2640	FreeAndNil(BS);
	2641	end;
	2642	SetBeforeExit;
	2643	PrepareForExit;
	2644	Result := FDownloadFolder;
	2645	end;
	2646
	2647	function TCustomIEDownload.UrlDownloadToFile(const aUrl: string): HRESULT;
	2648	begin
	2649	Result := E_FAIL;
	2650	PrepareForStart;
	2651	if not GoInit(aUrl, '', '') then
	2652	Exit;
	2653	FDownloadTo := dtDownloadToFile;
	2654	BS := TBSCB.Create(Self, nil, nil, True);
	2655	try
	2656	BS.Execute;
	2657	BS.Terminate;
	2658	Dec(FActiveConnections);
	2659	finally
	2660	FreeAndNil(BS);
	2661	end;
	2662	SetBeforeExit;
	2663	PrepareForExit;
	2664	Result := S_OK;
	2665	end;
	2666
	2667	procedure TCustomIEDownload.SetBeforeExit;
	2668	begin
	2669	if FOpenDownloadFolder then
	2670	OpenFolder(FDownloadFolder);
	2671	if FActiveConnections = 0 then
	2672	FBusy := False;
	2673	FState := sStopped;
	2674	if Assigned(FOnStateChange) then
	2675	FOnStateChange(FState);
	2676	end;
	2677
	2678	function TCustomIEDownload.GoInit(const inUrl: string; const inFileName:
	2679	string; const inDownloadFolder: string): boolean;
	2680	var
	2681	tmpNewName: WideString;
	2682	Act: TFileExistsOption;
	2683	begin
	2684	act := FFileExistsOption;
	2685	tmpNewName := '';
	2686	Result := False;
	2687	if FDownloadTo <> dtMoniker then
	2688	begin
	2689	if inUrl = EmptyStr then
	2690	begin
	2691	PrepareForExit;
	2692	Exit;
	2693	end;
	2694	FUrl := SetHttpProtocol(inUrl); {We pass the Address we got to the component}
	2695	if (FValidateUrl) and not (IsUrlValid(FUrl)) then
	2696	begin
	2697	PrepareForExit;
	2698	Exit;
	2699	end;
	2700	ItemsManager.SessionList.Add(FUrl);
	2701	if FDownloadMethod = dmFile then
	2702	begin
	2703	FDownloadFolder := SetDownloadFolder(inDownloadFolder);
	2704	if FDownloadFolder = EmptyStr then Exit;
	2705	FFileName := inFileName;
	2706	if (FFileName = EmptyStr) then
	2707	FFileName := SetFileNameFromUrl(FUrl); {First try}
	2708	if (CheckFileExists(FDownloadFolder + FFileName)) then
	2709	begin
	2710	if Assigned(FOnFileExists) then
	2711	FOnFileExists(Act, FDownloadFolder + FFileName, tmpNewName);
	2712	case Act of
	2713	feSkip:
	2714	begin
	2715	PrepareForExit;
	2716	Exit;
	2717	end;
	2718	feRename:
	2719	begin
	2720	if tmpNewName = EmptyStr then
	2721	tmpNewName := TimeToStr(now) + '_' + FFileName;
	2722	FFileName := tmpNewName;
	2723	bRenamed := True;
	2724	end;
	2725	feOverwrite: FBindF := FBindF + [GetNewestVersion];
	2726	end;
	2727	end;
	2728	end
	2729	else
	2730	FBindF := FBindF + [GetNewestVersion];
	2731	end;
	2732	DoUpdate;
	2733	Result := True;
	2734	end;
	2735
	2736	function TCustomIEDownload.WaitForProcess(var EventName: THandle;
	2737	var aStartTick, aTimeOut: Integer): Boolean;
	2738	var
	2739	dwResult: DWORD;
	2740	Msg: TMsg;
	2741	EventList: array[0..0] of THandle;
	2742	begin
	2743	EventList[0] := EventName;
	2744	dwResult := MsgWaitForMultipleObjects(1, EventList, False, DWORD(ATimeOut),
	2745	QS_ALLEVENTS);
	2746
	2747	case dwResult of
	2748	WAIT_FAILED: {Waiting failed}
	2749	begin
	2750	if Assigned(FOnError) then
	2751	FOnError(GetLastError, SysErrorMessage(GetLastError));
	2752	end;
	2753	WAIT_TIMEOUT: {Waiting Timo out}
	2754	begin
	2755	if Assigned(FOnError) then
	2756	FOnError(GetLastError, SysErrorMessage(GetLastError));
	2757	end;
	2758	WAIT_BSCB: {Our state to process messages}
	2759	begin
	2760	while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
	2761	begin
	2762	TranslateMessage(Msg);
	2763	DispatchMessage(Msg);
	2764	if (Integer(GetTickCount) - aStartTick > aTimeOut) then
	2765	begin
	2766	if Assigned(FOnError) then
	2767	FOnError(GetLastError, Err_TimeOut);
	2768	end;
	2769	end;
	2770	if (Integer(GetTickCount) - aStartTick > aTimeOut) then
	2771	begin
	2772	if Assigned(FOnError) then
	2773	FOnError(GetLastError, Err_TimeOut);
	2774	end;
	2775	end;
	2776	end;
	2777	Result := (dwResult = WAIT_OBJECT_0); {We are done waiting}
	2778	end;
	2779
	2780	function TCustomIEDownload.IsSynchronous(iedInfo: TInfoData): boolean;
	2781	begin {Return True if mode is Synchronous}
	2782	if iedInfo.infBindF_Value <> (iedInfo.infBindF_Value or
	2783	BINDF_ASYNCHRONOUS) then
	2784	Result := True
	2785	else
	2786	Result := False;
	2787	end;
	2788
	2789	function TCustomIEDownload.IsAsyncMoniker(const pmk: IMoniker): HRESULT;
	2790	begin
	2791	Result := UrlMon.IsAsyncMoniker(pmk);
	2792	end;
	2793
	2794	function TCustomIEDownload.FormatSize(const Byte: Double): string;
	2795	begin
	2796	Result := IEDownloadTools.FormatSize(Byte);
	2797	end;
	2798
	2799	function TCustomIEDownload.FormatTickToTime(const TickCount: Cardinal): string;
	2800	begin
	2801	Result := IEDownloadTools.FormatTickToTime(TickCount);
	2802	end;
	2803
	2804	function TCustomIEDownload.IsUrlValid(const isUrl: string): Boolean;
	2805	var
	2806	U: TUrl;
	2807	begin
	2808	U := TUrl.Create(isUrl);
	2809	try
	2810	Result := U.IsUrlValid(isUrl);
	2811	if not Result and Assigned(FOnError) then
	2812	FOnError(GetLastError, SysErrorMessage(GetLastError) + isUrl);
	2813	finally
	2814	U.Free;
	2815	end;
	2816	end;
	2817
	2818	procedure TCustomIEDownload.PrepareForExit;
	2819	begin
	2820	if Assigned(FOnComplete) then
	2821	FOnComplete(Self, FDownloadedFile, FFileName, FDownloadFolder,
	2822	FFileExtension, ActiveConnections);
	2823	FState := sReady;
	2824	if Assigned(FOnStateChange) then
	2825	FOnStateChange(FState);
	2826	end;
	2827
	2828	procedure TCustomIEDownload.PrepareForStart;
	2829	begin
	2830	FBusy := True;
	2831	bRenamed := False;
	2832	FCancel := False;
	2833	FDownloadedFile := EmptyStr;
	2834	FDownloadFolder := EmptyStr;
	2835	FFileExtension := EmptyStr;
	2836	FFileName := EmptyStr;
	2837	FFileSize := 0;
	2838	FMimeType := EmptyStr;
	2839	FServerAddress := EmptyStr;
	2840	FServerIP := EmptyStr;
	2841	FUrl := EmptyStr;
	2842	FState := sBusy;
	2843	if Assigned(FOnStateChange) then
	2844	FOnStateChange(FState);
	2845	FStartTick := GetTickCount;
	2846	Inc(FRefCount);
	2847	Inc(FActiveConnections);
	2848	end;
	2849
	2850	procedure TCustomIEDownload.SetCodePage(const Value: TCodePageOption);
	2851	begin
	2852	FCodePageOption := Value;
	2853	case FCodePageOption of
	2854	Ansi: FCodePageValue := CP_ACP;
	2855	Mac: FCodePageValue := CP_MACCP;
	2856	OEM: FCodePageValue := CP_OEMCP;
	2857	Symbol: FCodePageValue := CP_SYMBOL;
	2858	ThreadsAnsi: FCodePageValue := CP_THREAD_ACP;
	2859	UTF7: FCodePageValue := CP_UTF7;
	2860	UTF8: FCodePageValue := CP_UTF8;
	2861	end;
	2862	end;
	2863
	2864	procedure TCustomIEDownload.SetBindVerb(const Value: TBindVerb);
	2865	begin {Contains values that specify an action, such as an HTTP request, to be performed during the binding operation.}
	2866	FBindVerb := Value;
	2867	case FBindVerb of
	2868	Get: FBindVerb_Value := BINDVERB_GET;
	2869	Put: FBindVerb_Value := BINDVERB_PUT;
	2870	Post: FBindVerb_Value := BINDVERB_POST;
	2871	Custom: FBindVerb_Value := BINDVERB_CUSTOM;
	2872	end;
	2873	end;
	2874
	2875	procedure TCustomIEDownload.SetFileName(const Value: string);
	2876	begin
	2877	FFileName := Value;
	2878	end;
	2879
	2880	function TCustomIEDownload.SetFileNameFromUrl(const aUrl: string): string;
	2881	var
	2882	Ut: TUrl;
	2883	sTmp1, sTmp2: string;
	2884	begin
	2885	if FDownloadMethod = dmFile then
	2886	begin
	2887	Ut := TUrl.Create(aUrl);
	2888	try
	2889	Ut.CrackUrl(aUrl, ICU_ESCAPE);
	2890	if AnsiPos('.', Ut.ExtraInfo) <> 0 then
	2891	sTmp1 := Ut.ExtraInfo;
	2892	Ut.QueryUrl(aUrl);
	2893	sTmp2 := Ut.Document;
	2894	finally
	2895	Ut.Free;
	2896	end;
	2897	if sTmp1 <> EmptyStr then
	2898	begin
	2899	Result := sTmp1;
	2900	Exit;
	2901	end
	2902	else
	2903	Result := sTmp2;
	2904	end;
	2905	end;
	2906
	2907	procedure TCustomIEDownload.ExtractDataFromFile(const aFileName: string);
	2908	begin
	2909	FDownloadedFile := aFileName;
	2910	FFileName := ExtractFileName(aFileName);
	2911	FDownloadFolder := ExtractFilePath(aFileName);
	2912	FFileExtension := ExtractFileExt(aFileName);
	2913	end;
	2914
	2915	procedure TCustomIEDownload.SetAdditionalHeader(const Value: TStrings);
	2916	begin {Sets additional headers to append to the HTTP request.}
	2917	FAdditionalHeader.Assign(Value);
	2918	end;
	2919
	2920	procedure TCustomIEDownload.SetAbout(Value: string);
	2921	begin
	2922	Exit;
	2923	end;
	2924
	2925	procedure TCustomIEDownload.SetDefaultProtocol(const Value: string);
	2926	begin
	2927	FDefaultProtocol := (Value);
	2928	if FDefaultProtocol = EmptyStr then
	2929	FDefaultProtocol := 'http://';
	2930	end;
	2931
	2932	procedure TCustomIEDownload.SetUserAgent;
	2933	begin
	2934	FFullUserAgent := USER_AGENT_IE6 + '(' + FUserAgent + ')' + #13#10;
	2935	end;
	2936
	2937	procedure TCustomIEDownload.SetBindInfoF(const Value: TBindInfoF_Options);
	2938	begin
	2939	FBindInfoF := Value;
	2940	Update_BindInfoF_Value;
	2941	end;
	2942
	2943	procedure TCustomIEDownload.SetBindF2(const Value: TBindF2_Options);
	2944	begin
	2945	FBindF2 := Value;
	2946	Update_BindF2_Value;
	2947	end;
	2948
	2949	procedure TCustomIEDownload.SetBindInfoOption(const Value: TBindInfoOptions_Options);
	2950	begin
	2951	FBindInfoOption_ := Value;
	2952	Update_BindInfoOptions_Value;
	2953	end;
	2954
	2955	procedure TCustomIEDownload.SetBindF(const Value: TBindF_Options);
	2956	begin
	2957	if FFileExistsOption = feOverWrite then
	2958	FBindF := FBindF + [GetNewestVersion];
	2959	FBindF := Value;
	2960	Update_BindF_Value;
	2961	end;
	2962
	2963	procedure TCustomIEDownload.SetDownloadMethod(const Value: TDownloadMethod);
	2964	begin
	2965	FDownloadMethod := Value;
	2966	end;
	2967
	2968	function TCustomIEDownload.SetHttpProtocol(const aUrl: string): string;
	2969	type {Insert http to an address like bsalsa.com }
	2970	TProtocols = array[1..23] of string;
	2971	const
	2972	Protocols: TProtocols = (
	2973	'about', 'cdl', 'dvd', 'file', 'ftp', 'gopher', 'http', 'ipp', 'its',
	2974	'javascript', 'local', 'mailto', 'mk', 'msdaipp', 'ms-help', 'ms-its',
	2975	'mso', 'res', 'sysimage', 'tv', 'vbscript', 'via', 'https');
	2976	var
	2977	i: Integer;
	2978	begin
	2979	for i := 1 to 23 do
	2980	begin
	2981	if (AnsiPos(AnsiUpperCase(Protocols[i]), AnsiUpperCase(aUrl)) <> 0) then
	2982	begin
	2983	Result := aUrl;
	2984	Exit;
	2985	end;
	2986	end;
	2987	Result := 'http://' + aUrl;
	2988	end;
	2989
	2990	function TCustomIEDownload.SetDownloadFolder(const aDownloadFolder: string):
	2991	string;
	2992	begin
	2993	if (FDownloadMethod = dmFile) then
	2994	begin
	2995	Result := aDownloadFolder;
	2996	if (Result = EmptyStr) then
	2997	Result := ExtractFilePath(Application.ExeName) + DL_DIR;
	2998	if Result <> EmptyStr then
	2999	try
	3000	ForceDirectories(Result);
	3001	except
	3002	if Assigned(FOnError) then
	3003	FOnError(GetLastError, SysErrorMessage(GetLastError) +
	3004	Err_Creating_Dir);
	3005	end;
	3006	end;
	3007	end;
	3008
	3009	function TCustomIEDownload.ResponseCodeToStr(const dwResponse: Integer): string;
	3010	begin
	3011	Result := IEDownloadTools.ResponseCodeToStr(dwResponse);
	3012	end;
	3013
	3014	function TCustomIEDownload.WideStringToLPOLESTR(const Source: string): POleStr;
	3015	begin
	3016	Result := IEDownloadTools.WidestringToLPOLESTR(Source);
	3017	end;
	3018
	3019	initialization
	3020	coInitialize(nil);
	3021	finalization
	3022	coUninitialize;
	3023	end.
	3024

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: cprs/branches/tmg-cprs/CPRS-Chart/TMG_Extra/HTMLEdit/IEDownload.pas@ 833

Download in other formats: