Implement the IDownloadManager
interface with its Download
method to your web browser control and you can simply control what you need. The Download
method is called whenever you're going to download a file (only when the save as dialog pops up).
1. Embedded Web Browser
You can use the Embedded Web Browser
control which has this interface already implemented and which fires the OnFileDownload
that is different from the same named event in TWebBrowser
. See for instance this thread
on how to use it.
2. Do it yourself
Another option is that you can implement it to TWebBrowser
by yourself. In the following example I've used interposed class just for showing the principle, but it's very easy to wrap it as a component (that's why I've made the OnBeforeFileDownload
published).
2.1. OnBeforeFileDownload event
The only extension to TWebBrowser
in this interposed class is the OnBeforeFileDownload
event which fires when the file is going to be downloaded (before save as dialog pops up, but instead of the OnFileDownload
event, not when the document itself is downloaded). If you won't write the event handler for it, the web browser control will behave as before (showing a save as dialog). If you write the event handler and return False to its Allowed
declared parameter, the file saving will be cancelled. If you return True to the Allowed
parameter (what is by default), the save as dialog will be shown.
Note that if you cancel downloading by setting Allowed
to False, you'll need to download the file by yourself (as I did synchronously using Indy in this example). For this purpose there's the FileSource
constant parameter, which contains the downloaded file URL. Here is the event parameters overview:
- Sender (TObject) - event sender
- FileSource (WideString) - source file URL
- Allowed (Boolean) - declared boolean parameter, which decides if the file download will be allowed or not (default value is True)
2.2. IDownloadManager implementation
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
StdCtrls, OleServer, OleCtrls, Dialogs, ActiveX, MSHTML, UrlMon, SHDocVw,
IdHTTP;
const
IID_IDownloadManager: TGUID = '{988934A4-064B-11D3-BB80-00104B35E7F9}';
SID_SDownloadManager: TGUID = '{988934A4-064B-11D3-BB80-00104B35E7F9}';
type
IDownloadManager = interface(IUnknown)
['{988934A4-064B-11D3-BB80-00104B35E7F9}']
function Download(pmk: IMoniker; pbc: IBindCtx; dwBindVerb: DWORD;
grfBINDF: DWORD; pBindInfo: PBindInfo; pszHeaders: PWideChar;
pszRedir: PWideChar; uiCP: UINT): HRESULT; stdcall;
end;
TBeforeFileDownloadEvent = procedure(Sender: TObject; const FileSource: WideString;
var Allowed: Boolean) of object;
TWebBrowser = class(SHDocVw.TWebBrowser, IServiceProvider, IDownloadManager)
private
FFileSource: WideString;
FOnBeforeFileDownload: TBeforeFileDownloadEvent;
function QueryService(const rsid, iid: TGUID; out Obj): HRESULT; stdcall;
function Download(pmk: IMoniker; pbc: IBindCtx; dwBindVerb: DWORD;
grfBINDF: DWORD; pBindInfo: PBindInfo; pszHeaders: PWideChar;
pszRedir: PWideChar; uiCP: UINT): HRESULT; stdcall;
protected
procedure InvokeEvent(ADispID: TDispID; var AParams: TDispParams); override;
published
property OnBeforeFileDownload: TBeforeFileDownloadEvent read FOnBeforeFileDownload write FOnBeforeFileDownload;
end;
type
TForm1 = class(TForm)
Button1: TButton;
WebBrowser1: TWebBrowser;
FileSourceLabel: TLabel;
FileSourceEdit: TEdit;
ShowDialogCheckBox: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
procedure BeforeFileDownload(Sender: TObject; const FileSource: WideString;
var Allowed: Boolean);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TWebBrowser }
function TWebBrowser.Download(pmk: IMoniker; pbc: IBindCtx; dwBindVerb,
grfBINDF: DWORD; pBindInfo: PBindInfo; pszHeaders, pszRedir: PWideChar;
uiCP: UINT): HRESULT;
var
Allowed: Boolean;
begin
Result := E_NOTIMPL;
if Assigned(FOnBeforeFileDownload) then
begin
Allowed := True;
if pszRedir <> '' then
FFileSource := pszRedir;
FOnBeforeFileDownload(Self, FFileSource, Allowed);
if not Allowed then
Result := S_OK;
end;
end;
procedure TWebBrowser.InvokeEvent(ADispID: TDispID; var AParams: TDispParams);
begin
inherited;
// DispID 250 is the BeforeNavigate2 dispinterface and to the FFileSource here
// is stored the URL parameter (for cases, when the IDownloadManager::Download
// won't redirect the URL and pass empty string to the pszRedir)
if ADispID = 250 then
FFileSource := OleVariant(AParams.rgvarg^[5]);
end;
function TWebBrowser.QueryService(const rsid, iid: TGUID; out Obj): HRESULT;
begin
Result := E_NOINTERFACE;
Pointer(Obj) := nil;
if Assigned(FOnBeforeFileDownload) and IsEqualCLSID(rsid, SID_SDownloadManager) and
IsEqualIID(iid, IID_IDownloadManager) then
begin
if Succeeded(QueryInterface(IID_IDownloadManager, Obj)) and
Assigned(Pointer(Obj))
then
Result := S_OK;
end;
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var
HTMLWindow: IHTMLWindow2;
HTMLDocument: IHTMLDocument2;
begin
WebBrowser1.Navigate('http://financials.morningstar.com/income-statement/is.html?t=AAPL&ops=clear');
while WebBrowser1.ReadyState <> READYSTATE_COMPLETE do
Application.ProcessMessages;
HTMLDocument := WebBrowser1.Document as IHTMLDocument2;
if not Assigned(HTMLDocument) then
Exit;
HTMLWindow := HTMLDocument.parentWindow;
if Assigned(HTMLWindow) then
try
HTMLWindow.execScript('SRT_stocFund.Export()', 'JavaScript');
except
on E: Exception do
ShowMessage(E.Message);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ReportMemoryLeaksOnShutdown := True;
WebBrowser1.OnBeforeFileDownload := BeforeFileDownload;
end;
procedure TForm1.BeforeFileDownload(Sender: TObject; const FileSource: WideString;
var Allowed: Boolean);
var
IdHTTP: TIdHTTP;
FileTarget: string;
FileStream: TMemoryStream;
begin
FileSourceEdit.Text := FileSource;
Allowed := ShowDialogCheckBox.Checked;
if not Allowed then
try
IdHTTP := TIdHTTP.Create(nil);
try
FileStream := TMemoryStream.Create;
try
IdHTTP.HandleRedirects := True;
IdHTTP.Get(FileSource, FileStream);
FileTarget := IdHTTP.URL.Document;
if FileTarget = '' then
FileTarget := 'File';
FileTarget := ExtractFilePath(ParamStr(0)) + FileTarget;
FileStream.SaveToFile(FileTarget);
finally
FileStream.Free;
end;
finally
IdHTTP.Free;
end;
ShowMessage('Downloading finished! File has been saved as:' + sLineBreak +
FileTarget);
except
on E: Exception do
ShowMessage(E.Message);
end;
end;
end.
2.3. IDownloadManager project
You can download the above code (written in Delphi 2009) as a complete project from here
.