mime_unit.pas

利用MimeFilter实现网页过滤。IE7下不能使用

unit Mime_unit;

interface

uses
  {$IFDEF VER120} d4_app, {$ENDIF} Classes, Windows, Messages, SysUtils, Graphics, Controls, Forms, Dialogs,
  Activex, UrlMon, StdCtrls, OleCtrls, SHDocVw_TLB;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    Button2: TButton;
    HtmlMemo: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

Uses OurMimeFilter;

var
  Factory: IClassFactory;
  InternetSession: IInternetSession;
  S: string;


procedure TForm1.FormCreate(Sender: TObject);
begin
  S := ExtractFilePath(Application.Exename);

  CoGetClassObject(Class_OurMimeFilter, CLSCTX_SERVER, nil, IClassFactory, Factory);
  CoInternetGetSession(0, InternetSession, 0);
  InternetSession.RegisterMimeFilter(Factory, Class_OurMimeFilter, 'text/html');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  InternetSession.UnregisterMimeFilter(Factory, 'text/html');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Url : WideString;
  V : OleVariant;
begin
  Url:='file://' + S + 'page1.htm';
  Htmlmemo.lines.clear;
  webbrowser1.navigate(Url,V,V,V,V);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  Url : WideString;
  V : OleVariant;
begin
  Url:='http://www.euromind.com/iedelphi';
  Htmlmemo.lines.clear;
  Webbrowser1.navigate(Url,V,V,V,V);
end;


end.