谁用过mimefilter，请教个问题。 ( 积分: 50 )

在网上找了个mimefilter，注册后，在第一个IE窗口内操作，都起作用，由这个窗口点击，弹出一个新窗口后，就起不到过滤的作用了，这是怎么回事，请用过的朋友帮忙。

分不多了，见谅。

代码如下：
unit _MimeFilter;

(* Simple demo for permanent pluggable Mime Filter
To add more functionality to the Mime Filter
take a look at the following link:

http://msdn.microsoft.com/workshop/networking/pluggable/pluggable.asp

For discussions about APP, namespacehandlers, mimefilters and
other delphi-webbrowser topics use:

http://www.egroups.com/group/delphi-webbrowser/info.html

Go to http://www.euromind.com/iedelphi for more info about
this sample and updated versions.

Per Linds?Larsen, Nov. 1999
*)

(********************************************************
Update Febr. 5 2000:

Fixed bugs:
Solved problems with pages not written to cache
Solved problems with gzip encoding/decoding.

********************************************************)

interface

uses
Windows, Classes, ActiveX, ShlObj, ComServ, ComObj,
Urlmon, registry, dialogs, axctrls, SysUtils, Forms;


const

MimeFilterType = 'text/html';
MimeFilterName = 'IE/Delphi MimeFilter Demo';
CLSID_MimeFilter: TGUID = '{0EB00690-8FA1-11D3-96C7-829E3EA50C29}';
// ******** Create Your own unique identifier for your Band ********
// In Delphi-IDE : Ctrl-Shift-G


type
TMimeFilterFactory = class(TComObjectFactory)
private
procedure AddKeys;
procedure RemoveKeys;
public
procedure UpdateRegistry(Register: Boolean); override;
end;

type
TMimeFilter = class(TComObject, IInternetProtocol, IInternetProtocolSink)
private
CacheFileName: string;
Url: PWideChar;
DataStream: IStream;
UrlMonProtocol: IInternetProtocol;
UrlMonProtocolSink: IInternetProtocolSink;
Written, TotalSize: Integer;
protected
// IInternetProtocolSink Methods
function Switch(const ProtocolData: TProtocolData): HResult; stdcall;
function ReportProgress(ulStatusCode: ULONG; szStatusText: LPCWSTR): HResult; stdcall;
function ReportData(grfBSCF: DWORD; ulProgress, ulProgressMax: ULONG): HResult; stdcall;
function ReportResult(hrResult: HResult; dwError: DWORD; szResult: LPCWSTR): HResult; stdcall;
// IInternetProtocol Methods
function Start(szUrl: PWideChar; OIProtSink: IInternetProtocolSink;
OIBindInfo: IInternetBindInfo; grfPI, dwReserved: DWORD): HResult; stdcall;
function Continue(const ProtocolData: TProtocolData): HResult; stdcall;
function Abort(hrReason: HResult; dwOptions: DWORD): HResult; stdcall;
function Terminate(dwOptions: DWORD): HResult; stdcall;
function Suspend: HResult; stdcall;
function Resume: HResult; stdcall;
function Read(pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult; stdcall;
function Seek(dlibMove: LARGE_INTEGER; dwOrigin: DWORD;
out libNewPosition: ULARGE_INTEGER): HResult; stdcall;
function LockRequest(dwOptions: DWORD): HResult; stdcall;
function UnlockRequest: HResult; stdcall;
end;


implementation


uses wininet;



function TMimeFilter.Start(szUrl: PWideChar; OIProtSink: IInternetProtocolSink;
OIBindInfo: IInternetBindInfo; grfPI, dwReserved: DWORD): HResult;
var
Fetched: Cardinal;
begin
CacheFileName := '';
TotalSize := 0;
Written := 0;
(* Get an interface to transaction handlers IInternetProtocol and IInternetProtocolSink.
I prefer the easy delphi-way: *)
UrlMonProtocol := OIProtSink as IInternetProtocol;
UrlMonProtocolSink := OIProtSink as IInternetProtocolSink;
(* ... but remember that dwReserved points to the address of a
TProtocolFilterData structure, when IInternetProtocol is used in
MIME filters, so instead we could have done:
var
pfd : PProtocolFilterData;
begin
pfd:=Pointer(dwReserved);
UrlMonProtocol := Pfd^.Protocol;
UrlMonProtocolSink := Pfd^.ProtocolSink;
*)
(* If the page is not written to cache, our ReportProgress is not
called with CACHEFILENAMEAVAILABLE. We grab the url here so
we later can create a proper temporary cachefile. Since we are
in a mimefilter szURl don't have the url, so we use GetBindString. *)
OIBindinfo.GetBindString(BINDSTRING_URL, @Url, 1, Fetched);
Result := S_OK;
(* The transaction handler now call our ReportProgress -> *)
end;


function TMimeFilter.ReportProgress(ulStatusCode: ULONG;
szStatusText: LPCWSTR): HResult;
begin
if ulStatusCode = BINDSTATUS_CACHEFILENAMEAVAILABLE then
CacheFileName := SzStatusText;
(* szStatusText contains the name of the cache-file where the downloaded
data will be stored. *)
UrlMonProtocolSink.ReportProgress(ulStatusCode, szStatustext);
(* We pass all information on. *)
Result := S_OK;
(* The transaction handler now call our ReportData -> *)
end;



function TMimeFilter.ReportData(grfBSCF: DWORD; ulProgress,
ulProgressMax: ULONG): HResult;
var
TS: TStringStream;
Dummy: Int64;
hr: HResult;
readTotal: ULONG;
S: string;
Fname: array[0..512] of Char;
p: array[0..1000] of char;
begin
(* This method is must likely called long before the file is downloaded, so
ulProgressMax will be zero and ulProgress not tell anything reliable about
the amount of data available. Instead you can use the outcoming result of
call to UrlMonProtocol.Read:

S_OK : The read was successful, but there is still additional data available.
S_FALSE : All the data has been completely downloaded.

so we just repeat reading until we receive S_FALSE or an error:
INET_E_DATA_NOT_AVAILABLE or INET_E_DOWNLOAD_FAILURE. *)

Ts := TStringStream.Create('');
repeat
hr := UrlMonProtocol.Read(@P, SizeOf(p), Readtotal);
Ts.write(P, Readtotal);
until (hr = S_FALSE) or (hr = INET_E_DOWNLOAD_FAILURE) or (hr = INET_E_DATA_NOT_AVAILABLE);

if hr = S_FALSE then begin
(* Some pages like www.hotmail.com are not written to cache, so we make a temporary
entry and call ReportProgress with CACHEFILENAMEAVAILABLE. *)
if CacheFilename = '' then begin
CreateUrlCacheEntry(@url, ts.Size, Pchar('htm'), FName, 0);
TMemoryStream(ts).SaveToFile(Fname);
StringToWideChar(StrPas(FName), @FName, SizeOf(FName));
ReportProgress(BINDSTATUS_CACHEFILENAMEAVAILABLE, @FName);
end;

///************************************
///* FILTER DATA HERE - something like:
S := StringReplace(Ts.DataString, 'Delphi', 'Borland Inprise', [rfReplaceAll, rfIgnoreCase]);
ts.Size := 0;
ts.WriteString(S);
///************************************

////***** Debug only ******************
ts.Seek(0, 0);
// form1.HtmlMemo.Lines.LoadFromStream(TS);
///************************************

TotalSize := Ts.Size;
ts.Seek(0, 0);
CreateStreamOnHGlobal(0, True, DataStream);
TOlestream.Create(DataStream).CopyFrom(ts, ts.size);
TS.Free;
DataStream.Seek(0, STREAM_SEEK_SET, Dummy);
(* Inform Transaction handler that all data is ready for the browser: *)
UrlMonProtocolSink.ReportData(BSCF_FIRSTDATANOTIFICATION or BSCF_LASTDATANOTIFICATION or BSCF_DATAFULLYAVAILABLE, TotalSize, Totalsize);
(* Here transaction handler call our Read Method -> *)
UrlMonProtocolSink.ReportResult(S_OK, S_OK, nil);
(* Report result OK after sending all data to browser *)
end else Abort(hr, 0); //On Error: INET_E_DOWNLOAD_FAILURE or INET_E_DATA_NOT_AVAILABLE
Result := S_OK;
end;

function TMimeFilter.Read(pv: Pointer; cb: ULONG; out cbRead: ULONG): HResult;
begin
(* All data is avaiable, so we just keep reading while written<totalsize *)
DataStream.Read(pv, cb, @cbRead);
Inc(written, cbread);
if (written = totalsize) then result := S_FALSE else Result := S_OK;
end;



function TMimeFilter.Continue(const ProtocolData: TProtocolData): HResult;
begin
UrlMonProtocol.Continue(ProtocolData);
result := S_OK;
end;

function TMimeFilter.Terminate(dwOptions: DWORD): HResult;
begin
UrlmonProtocol.Terminate(dwOptions);
result := S_OK;
end;

function TMimeFilter.Abort(hrReason: HResult; dwOptions: DWORD): HResult;
begin
UrlMonProtocol.Abort(hrReason, dwOptions);
result := S_OK;
end;

function TMimeFilter.LockRequest(dwOptions: DWORD): HResult;
begin
UrlMonProtocol.LockRequest(dwOptions);
result := S_OK;
end;

function TMimeFilter.Seek(dlibMove: LARGE_INTEGER; dwOrigin: DWORD;
out libNewPosition: ULARGE_INTEGER): HResult;
begin
UrlMonProtocol.Seek(dlibMove, dwOrigin, libNewPosition);
result := S_OK;
end;

function TMimeFilter.UnlockRequest: HResult;
begin
UrlMonProtocol.UnlockRequest;
result := S_OK;
end;

function TMimeFilter.ReportResult(hrResult: HResult; dwError: DWORD;
szResult: LPCWSTR): HResult;
begin
UrlMonProtocolSink.ReportResult(hrResult, dwError, szResult);
Result := S_OK;
end;

function TMimeFilter.Switch(const ProtocolData: TProtocolData): HResult;
begin
UrlMonProtocolSink.Switch(ProtocolData);
result := S_OK;
end;

function TMimeFilter.Suspend: HResult;
begin
// Not implemented
result := E_NOTIMPL;
end;

function TMimeFilter.Resume: HResult;
begin
// Not implemented
result := E_NOTIMPL;
end;



procedure TMimeFilterFactory.UpdateRegistry(Register: Boolean);
begin
inherited UpdateRegistry(Register);
if Register then AddKeys else RemoveKeys;
end;

procedure TMimeFilterFactory.AddKeys;
var S: string;
begin
S := GUIDToString(CLSID_MimeFilter);
with TRegistry.Create do
try
RootKey := HKEY_CLASSES_ROOT;
if OpenKey('PROTOCOLS/Filter/' + MimeFilterType, True) then
begin
WriteString('', MimeFilterName);
WriteString('CLSID', S);
CloseKey;
end;
finally
Free;
end;
end;

procedure TMimeFilterFactory.RemoveKeys;
var S: string;
begin
S := GUIDToString(CLSID_MimeFilter);
with TRegistry.Create do
try
RootKey := HKEY_CLASSES_ROOT;
DeleteKey('PROTOCOLS/Filter/'+MimeFilterType );
finally
Free;
end;
end;

initialization

TMimeFilterFactory.Create(ComServer, TMimeFilter, CLSID_MimeFilter, '', 'MimeFilter', ciMultiInstance);

end.