5,928
社区成员




unit LookInBHO;
{$WARN SYMBOL_PLATFORM OFF}
{$B-}
interface
uses
ComObj, ActiveX, LookInBHO_TLB, StdVcl, SHDOCVW, Registry, Windows, DateUtils,
StrUtils, SysUtils, Dialogs, wininet, Classes, SQLiteTable3;
type
TLooKInBHO = class(TComObject,IDispatch,IObjectWithSite, ILooKInBHO)
public
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;
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;
procedure DoDocumentComplete(const pDisp: IDispatch; var URL: OleVariant);
procedure DoOnQuit();
procedure WriteDB();
function getLastPos(const substr,s:string):integer;
procedure DoBeforeNavigate2(const pDisp:IDispatch;var URL:OleVariant;var Flags:OleVariant;var
TargetFrameName:OleVariant;var PostData:OleVariant;var Headers:OleVariant;var Cancel:WordBool);
private
IEThis:IWebBrowser2;
Cookie:Integer;
end;
type
TLookinBHOFactory = class(TComObjectFactory)
private
procedure AddKeys;
procedure RemoveKeys;
public
procedure UpdateRegistry(Register:Boolean); override;
end;
implementation
uses ComServ;
var
HasDb : boolean;
iRnd : int64;
sTime, eTime : TDatetime;
vistacount : integer;
sUrl,LastUrl : string;
/////////定义结束///////////////
//////////以下省去部分实现代码/////////
procedure TLooKInBHO.WriteDB;
var
dbPath,sql : string;
db : TSQLiteDatabase;
begin
dbPath := 'D:\Project\Delphi\';{这个是测试用地址}
if FileExists(dbPath + 'IEHistory.dat') then
begin
db := TSQLiteDatabase.Create(dbPath + 'IEHistory.dat');{就是这句,加上就无法正常使用,整个DLL就失灵了}
try
sql := 'INSERT INTO ieUrl(id,rnd,url,v_time,c_time) VALUES (null,' + inttostr(iRnd) + ',"' + LeftStr(LastUrl,255) + '","' + FormatDateTime('yyyy-mm-dd hh:nn:ss',sTime) + '","' + FormatDateTime('yyyy-mm-dd hh:nn:ss',sTime) + '")';
if db.TableExists('ieUrl') then begin
db.ExecSQL(sql);
db.Commit;
end;
except
on E:Exception do
MessageBox(0,Pwidechar(E.Message),'错误提示', MB_OK);
end;
db.Destroy;
end;
end;
//////////以上省去部分实现代码/////////