ie.pas

这是一个IE拦截程序

unit IE;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StrUtils,StdCtrls,DDEman,shellapi,ComObj,ExtCtrls,inifiles,
  Grids, DB, ADODB, DBGrids, Menus, jpeg;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    GroupBox1: TGroupBox;
    ListBox1: TListBox;
    GroupBox2: TGroupBox;
    ListBox2: TListBox;
    DBGrid1: TDBGrid;
    Edit1: TEdit;
    Button2: TButton;
    Button1: TButton;
    Timer1: TTimer;
    DataSource1: TDataSource;
    ADOConnection1: TADOConnection;
    ADOTable1: TADOTable;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    ADOQuery1: TADOQuery;
    Timer2: TTimer;
    ADOQuery2: TADOQuery;
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    private
    id: Integer;
    procedure WMHotKey(var Msg : TWMHotKey); message WM_HOTKEY;
      { Private declarations }
    public
    { Public declarations }

  end;
var
  Form1: TForm1;
  DDE:TDdeClientConv;
  implementation
function RegisterServiceProcess(dwProcessId:LongInt;const dwType:LongInt):DWORD;
         stdcall;far;external'KERNEL32.dll' name 'RegisterServiceProcess';
{$R *.dfm}
procedure TForm1.WMHotKey (var Msg : TWMHotKey);
begin
if msg.HotKey = id then
form1.Visible :=true;
end;
Function GetURL(H:hwnd;lparam:longint):boolean;stdcall;
var str,url:array [0..254] of char;
  begin
    getclassname(h,@str,255);
    if strpas(@str)='ComboBoxEx32' then
      begin
      SendMessage(h,WM_GETTEXT,255,LongInt(@url));
      form1.ListBox1.Items.Add(strpas(@url)); //URL就是那个字符串了。
      end;
      result:=true;
  end;

function callbackproc(H:HWnd;lparam:longint):Boolean;stdcall;
var str:array [1..255] of char;
  begin
  getclassname(h,@str,255);
  if (strpas(@str)='IEFrame') then
      begin
        Enumchildwindows(h,@GetURL,0);
      end;
      result:=true;
  end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i:integer;
begin
listBox1.Clear;
//查当前的IE
Enumwindows(@callbackproc,0);
//查数据库记录
for i:=0 to listbox1.Count-1 do
begin
adoquery1.SQL.Clear;
adoquery1.SQL.Add('select * from Url where URl=:s');
adoquery1.Parameters.ParamByName('s').Value:=listbox1.Items.Strings[i];
adoquery1.Open;
if not adoquery1.IsEmpty then
begin
if dde.SetLink('Iexplore','www_Exit') then
  begin
  dde.OpenLink;
  dde.RequestData('WWW_Exit');
  dde.CloseLink;
  end
  end;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
with adoquery2 do
begin
sql.Clear;
SQL.Add('select * from Url where URl=:b');
Parameters.ParamByName('b').Value:=edit1.Text;
open;
end;
if adoquery2.IsEmpty then
begin
adotable1.Append;
adotable1.FieldByName('URl').AsString:=edit1.text;
adotable1.Post;
edit1.Text:='';
end
else
begin
application.MessageBox('库中已有此记录','请重新输入',MB_OK);
edit1.Text:='';
end;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
if not adotable1.Eof then adotable1.Delete;
end;

procedure TForm1.N4Click(Sender: TObject);
begin
while not adotable1.Eof do
adotable1.Delete;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
UnRegisterHotKey(handle,id);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
form1.Hide;
end;

procedure TForm1.FormActivate(Sender: TObject);
Const
{ALT、CTRL和R键的虚拟键值}
MOD_ALT = 1;
MOD_CONTROL = 2;
VK_R = 82;
begin
if  not adoconnection1.Connected then adoconnection1.Connected:=true;
if  not adotable1.Active   then adotable1.Active:=true;
//程序隐藏任务栏
DDE:=TDdeClientConv.Create(self);
showwindow(application.Handle,SW_Hide);
setwindowlong(application.Handle,GWL_EXSTYLE,
              WS_EX_TOOLWINDOW or not WS_EX_APPWINDOW);
showwindow(application.Handle,SW_SHOW);
//
RegisterHotKey(form1.handle,id,0,VK_R);
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
form1.Hide;
timer2.Enabled:=false;
end;

end.