作者在 2010-01-25 13:02:51 发布以下内容
收集黑客防线的。不算盗版吧》=《 呵呵
以下是具体的代码,我搜集的!有点难度的··· BHO的定义:是微软推出的作为浏览器对第三方程序员开放交互接口的业界标准,通过简单的代码就可以进入浏览器领域的‘交互接口’,对象依托于浏览器的主窗口,可以在这些事件的响应中实现与浏览器的交互,这样,对象会在与浏览器相同的上下文中运行,并能对可用的窗口和模块执行任何行动! UIEvisit 单元-------------------------- {$WARN SYMBOL_PLATFORM OFF} interface uses Windows, ActiveX, Classes, ComObj, SHDOCVW, Dialogs, SysUtils, Registry, idhttp, MSHTML; type TIEVisitFactory = class(TComObjectFactory) private procedure AddKeys; procedure RemoveKeys; public procedure UpdateRegistry(register: Boolean); override; end; TIEVisit = class(TComObject, IDispatch, IObjectWithSite) public //IDispatch接口方法定义 function GetTypeInfoCount(out Count: Integer): HResult; stdcall; function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; stdcall; function GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall; //IObjectWithSite接口方法定义 function SetSite(const pUnkSite: IUnknown): HResult; stdcall; function GetSite(const riid: TIID; out site: IUnknown): HResult; stdcall; function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; stdcall; private IEThis: IWebBrowser2; Cookie: Integer; //事件处理过程 procedure DoOnQuit; procedure BuildPositionalDispIDs(pDispIDs: PDispIDList; const dps: TDispParams); procedure DoDocumentComplete(const pDisp: IDispatch; var url: OleVariant); procedure ConvertHtml(AKeyWord, AWeb: WideString; var ABody: WideString); protected end; const Class_IEVisit: TGUID = '{0E694E55-F022-4ED3-9EB9-1FADA33E5036}'; implementation uses ComServ; function TIEVisit.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; begin Result := E_NOTIMPL; Pointer(TypeInfo) := nil; end; function TIEVisit.GetTypeInfoCount(out Count: Integer): HResult; begin Result := E_NOTIMPL; Count := 0; end; function TIEVisit.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; begin Result := E_NOTIMPL; end; function TIEVisit.GetSite(const riid: TIID; out site: IUnknown): HResult; begin if (Assigned(IEThis)) then Result := IEThis.QueryInterface(riid, site) else Result := E_FAIL; end; function TIEVisit.SetSite(const pUnkSite: IUnknown): HResult; var cmdTarget: IOleCommandTarget; Sp: IServiceProvider; CPC: IConnectionPointContainer; CP: IConnectionPoint; begin //ShowMessage('执行了SetSite事件!'); if (Assigned(pUnkSite)) then begin cmdTarget := (pUnkSite as IOleCommandTarget); Sp := (cmdTarget as IServiceProvider); if (Assigned(Sp)) then //获得IE的WebBrowser接口, Sp.QueryService(IWebBrowserApp, IWebBrowser2, IEThis); if (Assigned(IEThis)) then begin IEThis.QueryInterface(IConnectionPointContainer, CPC); //寻找连接点 CPC.FindConnectionPoint(DWEBBrowserEvents2, CP); CP.Advise(Self, Cookie); //通过Advise方法建立Com自身与连接点的连接 end; end; Result := S_OK; end; procedure TIEVisit.DoOnQuit; begin end; procedure TIEVisit.BuildPositionalDispIDs(pDispIDs: PDispIDList; const dps: TDispParams); var i: Integer; begin Assert(pDispIDs <> nil); for i := 0 to dps.cArgs - 1 do pDispIDs^ if (dps.cNamedArgs <= 0) then Exit; for i := 0 to dps.cNamedArgs - 1 do pDispIDs^[dps.rgdispidNamedArgs^ end; function TIEVisit.Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): HResult; type POleVariant = ^OleVariant; var dps: TDispParams absolute Params; bHasParams: Boolean; pDispIDs: PDispIDList; iDispIDsSize: Integer; begin Result := DISP_E_MEMBERNOTFOUND; pDispIDs := nil; iDispIDsSize := 0; bHasParams := (dps.cArgs > 0); if (bHasParams) then begin iDispIDsSize := dps.cArgs * SizeOf(TDispID); GetMem(pDispIDs, iDispIDsSize); end; try if (bHasParams) then BuildPositionalDispIDs(pDispIDs, dps); case DispID of 253: begin //OnQuit事件的id DoOnQuit(); Result := S_OK; end; 259: begin DoDocumentComplete(IDispatch(dps.rgvarg^[pDispIDs^[0]].dispVal), POleVariant(dps.rgvarg^[pDispIDs^[1]].pvarVal)^); Result := S_OK; end; end; //end of case DispID of finally if (bHasParams) then FreeMem(pDispIDs, iDispIDsSize); end; end; procedure TIEVisit.ConvertHtml(AKeyWord, AWeb: WideString; var ABody: WideString); var strFlagBaidu: string; conIFrameHTMLBaidu: string; procedure DebugABody; //调试用函数 var lst: TStringlist; begin lst := TStringlist.Create; lst.Text := ABody; lst.SaveToFile('d:\aaa.txt'); lst.Free; end; begin //替换百度页面的表单 if pos('www.baidu.com', AWeb) <> 0 then begin //百度表单的字符串 strFlagBaidu := '<FORM name=f action=/s><SPAN id=in><INPUT id=kw maxLength=100 size=42 name=wd></SPAN>' + ' <INPUT id=sb type=submit value=百度一下>' + #13#10 + '<DIV onselectstart="return false" id=sug></DIV><SPAN id=hp><A href="/search/jiqiao.html">帮助</A><BR><A href="/gaoji/advanced.html">高级</A></SPAN></FORM>'; //替换内容 conIFrameHTMLBaidu := '<iframe id="fff" marginwidth="0" marginheight="0" scrolling="no" ' + ' framespacing="0" vspace="0" hspace="0" frameborder="0" width="650" height="180" align="center"' + ' src="@URL"> </iframe><br><br> '; conIFrameHTMLBaidu := stringreplace(conIFrameHTMLBaidu, , 'http://www.google.com', [rfReplaceAll]); ABody := stringreplace(ABody, strFlagBaidu, conIFrameHTMLBaidu, [rfReplaceAll]); end; //替换谷歌页面的表单 if (pos('www.google.cn', AWeb) <> 0) or (pos('google.cn', AWeb) <> 0) or (pos('www.google.com', AWeb) <> 0) or (pos('google.com', AWeb) <> 0) or (pos('www.g.cn', AWeb) <> 0) or (pos('g.cn', AWeb) <> 0) then begin //谷歌表单的字符串 strFlagBaidu := '<FORM name=f action=/search>' + #13#10 + '<TABLE cellSpacing=0 cellPadding=0>' + #13#10 + '<TBODY>' + #13#10 + '<TR vAlign=top>' + #13#10 + '<TD width="25%"> </TD>' + #13#10 + '<TD noWrap align=middle><INPUT type=hidden value=zh-CN name=hl><INPUT title="Google 搜索" ' + 'maxLength=2048 size=55 name=q autocomplete="off"><BR><INPUT type=submit value="Google 搜索" ' + 'name=btnG><INPUT type=submit value= 手气不错 name=btnI></TD>' + #13#10 + '<TD noWrap width="25%"><FONT size=-1> <A href="/advanced_search?hl=zh-CN">高级搜索' + '</A><BR> <A href="/preferences?hl=zh-CN">使用偏好</A><BR> ' + '<A href="/language_tools?hl=zh-CN">语言工具</A></FONT></TD></TR>' + #13#10 + '<TR>' + #13#10 + '<TD align=middle colSpan=3><FONT size=-1><SPAN style="TEXT-ALIGN: left"><INPUT id=all type=radio ' + 'CHECKED value="" name=meta><LABEL for=all>所有网页 </LABEL><INPUT id=ch type=radio ' + 'value=lr=lang_zh-CN|lang_zh-TW name=meta><LABEL for=ch>中文网页 </LABEL><INPUT id=lgr ' + 'type=radio value=lr=lang_zh-CN name=meta><LABEL for=lgr>简体中文网页 </LABEL>' + '<INPUT id=cty type=radio value=cr=countryCN name=meta><LABEL for=cty>中国的网页 </LABEL></SPAN>' + '</FONT></TD></TR></TBODY></TABLE>' + #13#10 + '<DIV id=tb></DIV></FORM>'; //替换内容 conIFrameHTMLBaidu := '<iframe id="fff" marginwidth="0" marginheight="0" scrolling="no" ' + ' framespacing="0" vspace="0" hspace="0" frameborder="0" width="650" height="190" ' + ' src="@URL"> </iframe><br><br> '; conIFrameHTMLBaidu := stringreplace(conIFrameHTMLBaidu, , 'http://www.baidu.com', [rfReplaceAll]); ABody := stringreplace(ABody, strFlagBaidu, conIFrameHTMLBaidu, [rfReplaceAll]); end; end; procedure TIEVisit.DoDocumentComplete(const pDisp: IDispatch; var url: OleVariant); var doc, docMain: IHTMLdocument2; strKeyWord, strWeb, strBody: WideString; begin try docMain := IEThis.Document as IHTMLdocument2; doc := (pDisp as IWebBrowser2).Document as IHTMLdocument2; if docMain <> doc then Exit; strKeyWord := copy(doc.title, 1, Length(doc.title) - 12); strWeb := url; strBody := doc.body.innerHTML; //这里开始处理 ConvertHtml(strKeyWord, strWeb, strBody); //结束处理 doc.body.innerHTML := strBody; except end; end; procedure TIEVisitFactory.AddKeys; var S: string; begin S := GUIDToString(Class_IEVisit); with TRegistry.Create do try RootKey := HKEY_LOCAL_MACHINE; if OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\' + S, TRUE) then CloseKey; finally Free; end; end; procedure TIEVisitFactory.RemoveKeys; var S: string; begin S := GUIDToString(Class_IEVisit); with TRegistry.Create do try RootKey := HKEY_LOCAL_MACHINE; DeleteKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Browser Helper Objects\' + S); finally Free; end; end; procedure TIEVisitFactory.UpdateRegistry(register: Boolean); begin inherited UpdateRegistry(register); if register then AddKeys else RemoveKeys; end; initialization TIEVisitFactory.Create(ComServer, TIEVisit, Class_IEVisit, '替换百度谷歌表单', '', ciMultiInstance, tmApartment); end. 下面是 DIEvisit-TLB.pas 单元--------------------------------- unit DIEVisit_TLB; // ************************************************************************ // // WARNING // ------- // The types declared in this file were generated from data read from a // Type Library. If this type library is explicitly or indirectly (via // another type library referring to this type library) re-imported, or the // 'Refresh' command of the Type Library Editor activated while editing the // Type Library, the contents of this file will be regenerated and all // manual modifications will be lost. // ************************************************************************ // // PASTLWTR : 1.2 // File generated on 2008-12-16 15:51:15 from Type Library described below. // ************************************************************************ // // Type Lib: D:\tools\工作文章\2008投稿\利用BHO替换百度\DIEVisit.tlb (1) // LIBID: {3692E756-CD2F-4947-AE4A-660C141088EC} // LCID: 0 // Helpfile: // HelpString: DIEVisit Library // DepndLst: // (1) v2.0 stdole, (C:\WINDOWS\system32\stdole2.tlb) // ************************************************************************ // {$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers. {$WARN SYMBOL_PLATFORM OFF} {$WRITEABLECONST ON} {$VARPROPSETTER ON} interface uses Windows, ActiveX, Classes, Graphics, StdVCL, Variants; // *********************************************************************// // GUIDS declared in the TypeLibrary. Following prefixes are used: // Type Libraries : LIBID_xxxx // CoClasses : CLASS_xxxx // DISPInterfaces : DIID_xxxx // Non-DISP interfaces: IID_xxxx // *********************************************************************// const // TypeLibrary Major and minor versions DIEVisitMajorVersion = 1; DIEVisitMinorVersion = 0; LIBID_DIEVisit: TGUID = '{3692E756-CD2F-4947-AE4A-660C141088EC}'; implementation uses ComObj; end. 下面是 DIEvisit的具体代码--------------------------------------------- library DIEVisit; uses ComServ, UIEVisit in 'UIEVisit.pas', DIEVisit_TLB in 'DIEVisit_TLB.pas'; exports DllGetClassObject, DllCanUnloadNow, DllRegisterServer, DllUnregisterServer; {$R *.TLB} {$R *.RES} begin end. |