d4_app.pas

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

unit D4_App;


interface

uses Urlmon, Windows, ActiveX;


const
  IID_IInternet:             TGUID = '{79eac9e0-baf9-11ce-8c82-00aa004ba90b}';
  IID_IInternetBindInfo:     TGUID = '{79eac9e1-baf9-11ce-8c82-00aa004ba90b}';
  IID_IInternetProtocolRoot: TGUID = '{79eac9e3-baf9-11ce-8c82-00aa004ba90b}';
  IID_IInternetProtocol:     TGUID = '{79eac9e4-baf9-11ce-8c82-00aa004ba90b}';
  IID_IInternetProtocolSink: TGUID = '{79eac9e5-baf9-11ce-8c82-00aa004ba90b}';
  IID_IInternetSession:      TGUID = '{79eac9e7-baf9-11ce-8c82-00aa004ba90b}';
  IID_IInternetThreadSwitch: TGUID = '{79eac9e8-baf9-11ce-8c82-00aa004ba90b}';
  IID_IInternetPriority:     TGUID = '{79eac9eb-baf9-11ce-8c82-00aa004ba90b}';
  IID_IInternetProtocolInfo: TGUID = '{79eac9ec-baf9-11ce-8c82-00aa004ba90b}';


const
  BSCF_FIRSTDATANOTIFICATION        = $00000001;
  BSCF_INTERMEDIATEDATANOTIFICATION = $00000002;
  BSCF_LASTDATANOTIFICATION         = $00000004;
  BSCF_DATAFULLYAVAILABLE           = $00000008;
  BSCF_AVAILABLEDATASIZEUNKNOWN     = $00000010;


  BINDSTRING_HEADERS          = 1;
  BINDSTRING_ACCEPT_MIMES     = BINDSTRING_HEADERS + 1;
  BINDSTRING_EXTRA_URL        = BINDSTRING_ACCEPT_MIMES + 1;
  BINDSTRING_LANGUAGE         = BINDSTRING_EXTRA_URL + 1;
  BINDSTRING_USERNAME         = BINDSTRING_LANGUAGE + 1;
  BINDSTRING_PASSWORD         = BINDSTRING_USERNAME + 1;
  BINDSTRING_UA_PIXELS        = BINDSTRING_PASSWORD + 1;
  BINDSTRING_UA_COLOR         = BINDSTRING_UA_PIXELS + 1;
  BINDSTRING_OS               = BINDSTRING_UA_COLOR + 1;
  BINDSTRING_USER_AGENT       = BINDSTRING_OS + 1;
  BINDSTRING_ACCEPT_ENCODINGS = BINDSTRING_USER_AGENT + 1;
  BINDSTRING_POST_COOKIE      = BINDSTRING_ACCEPT_ENCODINGS + 1;
  BINDSTRING_POST_DATA_MIME   = BINDSTRING_POST_COOKIE + 1;
  BINDSTRING_URL              = BINDSTRING_POST_DATA_MIME + 1;

type
  POLEStrArray = ^TOLESTRArray;
  TOLEStrArray = array[0..MaxLongint div SizeOf(POLEStr) - 1] of POLEStr;

  IInternetBindInfo = interface
    ['{79eac9e1-baf9-11ce-8c82-00aa004ba90b}']
    function GetBindInfo(out grfBINDF: DWORD; var bindinfo: TBindInfo): HResult; stdcall;
    function GetBindString(ulStringType: ULONG; wzStr: POLEStrArray; cEl: ULONG;
      var cElFetched: ULONG): HResult; stdcall;
  end;

const
  PI_PARSE_URL                = $00000001;
  PI_FILTER_MODE              = $00000002;
  PI_FORCE_ASYNC              = $00000004;
  PI_USE_WORKERTHREAD         = $00000008;
  PI_MIMEVERIFICATION         = $00000010;
  PI_CLSIDLOOKUP              = $00000020;
  PI_DATAPROGRESS             = $00000040;
  PI_SYNCHRONOUS              = $00000080;
  PI_APARTMENTTHREADED        = $00000100;
  PI_CLASSINSTALL             = $00000200;
  PD_FORCE_SWITCH             = $00010000;
  PI_DOCFILECLSIDLOOKUP       = PI_CLSIDLOOKUP;

type
  PProtocolData = ^TProtocolData;
  _tagPROTOCOLDATA = packed record
    grfFlags: DWORD;
    dwState: DWORD;
    pData: Pointer;
    cbData: ULONG;
  end;
  TProtocolData = _tagPROTOCOLDATA;
  PROTOCOLDATA = _tagPROTOCOLDATA;

  IInternetProtocolSink = interface;

  IInternetProtocolRoot = interface
    ['{79eac9e3-baf9-11ce-8c82-00aa004ba90b}']
    function Start(szUrl: LPCWSTR; 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;
  end;

  IInternetProtocol = interface(IInternetProtocolRoot)
    ['{79eac9e4-baf9-11ce-8c82-00aa004ba90b}']
    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;

  IInternetProtocolSink = interface
    ['{79eac9e5-baf9-11ce-8c82-00aa004ba90b}']
    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;
  end;


type

  TLPCWSTRArray = array[0..MaxLongInt div SizeOf(LPCWSTR) - 1] of LPCWSTR;
  PLPCWSTRArray = ^TLPCWSTRArray;

  IInternetSession = interface
    ['{79eac9e7-baf9-11ce-8c82-00aa004ba90b}']
    function RegisterNameSpace(CF: IClassFactory; const clsid: TCLSID; pwzProtocol: LPCWSTR;
      cPatterns: ULONG; const pwzPatterns: PLPCWSTRArray; dwReserved: DWORD): HResult; stdcall;
    function UnregisterNameSpace(CF: IClassFactory; pszProtocol: LPCWSTR): HResult; stdcall;
    function RegisterMimeFilter(CF: IClassFactory; const rclsid: TCLSID;
      pwzType: LPCWSTR): HResult; stdcall;
    function UnregisterMimeFilter(CF: IClassFactory; pwzType: LPCWSTR): HResult; stdcall;
    function CreateBinding(BC: IBindCtx; szUrl: LPCWSTR; UnkOuter: IUnknown; out Unk: IUnknown;
      out OINetProt: IInternetProtocol; dwOption: DWORD): HResult; stdcall;
    function SetSessionOption(dwOption: DWORD; pBuffer: Pointer; dwBufferLength: DWORD;
      dwReserved: DWORD): HResult; stdcall;
    function GetSessionOption(dwOption: DWORD; pBuffer: Pointer; var dwBufferLength: DWORD;
      dwReserved: DWORD): HResult; stdcall;
  end;



const

  INET_E_USE_DEFAULT_PROTOCOLHANDLER = HResult($800C0011);
  INET_E_USE_DEFAULT_SETTING         = HResult($800C0012);
  INET_E_DEFAULT_ACTION              = HResult($800C0011);
  INET_E_QUERYOPTION_UNKNOWN         = HResult($800C0013);
  INET_E_REDIRECTING                 = HResult($800C0014);




function CoInternetGetSession(dwSessionMode: DWORD; var pIInternetSession: IInternetSession;
  dwReserved: DWORD): HResult; stdcall;


implementation

const
UrlMonLib = 'URLMON.DLL';

function CoInternetGetSession;  external UrlMonLib name 'CoInternetGetSession';

end.