是大虾就来看看吧!!!!时间很急,大家帮帮忙啊。(300分)

  • 主题发起人 主题发起人 花 儿
  • 开始时间 开始时间

花 儿

Unregistered / Unconfirmed
GUEST, unregistred user!
我要实现这样的一个功能----
当用户点击浏览器里的超衔接,如果是bmp、jpg等图像,那么剩下的部分就由
我的程序来处理,其实我的主要目的是要把这些图像保存起来存到数据库中去,
也就是说:比如用户的某个浏览器右键菜单多了个“保存到数据库”的菜单项
,一旦用户点击,就把目标存到数据库中。

我的疑点是
1、要不要做上下文菜单关联?要怎么做?但前提条件是用IE浏览器。
2、如果自己做个浏览器来实现这样的功能?会不会比上下文菜单简单些?还有没有更简
单的方法?

这个问题很急,大家帮忙解答,谢谢了。
 
Netants、FlashGet之类的软件不是就差不多吗?
右键菜单通过修改注册表实现,不是在程序中做这个菜单的。
 
1。不是上下文关联菜单
2。没必要自己做个浏览器的
(转贴)
要实现在IE右键菜单中添加菜单项的功能,要依次实现以下步骤:

1、在注册表HKEY_CURRENT_USER/Software/Microsoft/Internet

Explorer/MenuExt项下建立一个

新项,项的名称既出现在菜单中的标题,例如你想建立的菜单项标题为Add URL,则

新建项的名称为

HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/MenuExt/Add URL

2、将新建项的默认值设定为一个URL地址,当用户点击菜单项后,IE就会调用

URL指向的页面中的脚

本,在目标页面的脚本中通过访问external对象的menuArguments属性就可以访问IE

中的页面。该属性定

义了一个Window对象。该对象描述了浏览器中的一个打开的窗口。详细的帮助请参考

MSDN中关于

InternetExplore object的帮助,熟悉了Window对象才可以比较好的了解下面的脚

本。

对于如何实现自身的程序访问menuArguments的问题,我们可以仿效Netants的

做法,首先建立一个

OLE Automation对象,然后在脚本中调用该对象,并将页面信息传递对象处理。下面

通过Delphi建立对象

来说明:

打开Delphi,点击菜单: 文件|新建 ,选择窗口中的ActiveX标签,在列表中

选择ActiveX Library

图标后按确定键,这样就新建了一个Active Library工程。然后将工程文件保存为

IEContextMenu.dpr 。

再点击菜单: 文件|新建 ,选择窗口中的ActiveX标签,在列表中选择

Automation Object 图标后按

确定键,然后在 Automation Object Wizard 窗口中的CoClass Name栏中输入

IEMenu1后按确定键。

这时会弹出IEContextMenu.tlb 的Type Library窗口,左边是对象和属性等的列表

窗口,右边是相应的选

项窗口。在其中已经加入了IIEMenu1接口。

现在给接口添加一个AddURL方法。首先选择Type Library列表中的IIEMenu1

项,然后点击Type Library

窗口上面的 New Method 按钮添加一个方法,将该方法的Name属性改为AddURL。下

来再点击Parameters标签

转到参数设定页,添加两个参数:URL和Info,属性都设置为BSTR,设置好的Type

Library窗口如图所示:

(附加图片1-1.bmp)

关闭设置窗口回到Delphi,点击save all按钮保存文件,现在IEMenu对象建立

完毕了,在对象中我们将

只实现最简单的功能,既显示用户在页面中单击右键位置的对象URL,所以在Unit1的

TIEMenu1.AddURL子程

序中只添加一句: showmessage(URL);

同时在Unit1的Uses中加入Dialogs。选择菜单上的Build | Build

IEContextMenu 项编译生成

IEContextMenu.dll。

下面是注册对象,在资源管理器中将Windows/system目录下的Regsvr32.exe拷

贝到IEContextMenu.dll

所在目录中,然后将IEContextMenu.dll图标拖到Regsvr32.exe上放开,这时

Regsvr32.exe就会弹出对话框

提示对象注册成功。

打开UltraEdit(或者其它文本编辑器)将下面的脚本代码输入编辑器中:







将文件保存到c:/program files 下,文件名为 geturl.htm

从上面的脚本可以看到,首先访问external.menuArguments属性,获得用户单

击鼠标右键位置的对象,然

后根据对象的不同获得它的URL,然后建立IEContextMenu.IEMenu1对象并调用该对

象的AddURL方法。

接下来是为右键菜单建立注册项,打开UltraEdit(或者其它文本编辑器)将下面

的注册数据输入编辑器中

Windows Registry Editor Version 5.00



[HKEY_CURRENT_USER/Software/Microsoft/Internet Explorer/MenuExt/&Get

URL]

@="c://program files//geturl.htm"

"Contexts"=dword:00000022



将文件以reg为后缀保存,然后在Windows资源管理器中双击该文件将注册项添加

到注册表中,然后打开

IE,右键点击一个连接或者图片,在弹出菜单中会出现一个Get URL项,点击该项,

就会出现一个消息框显示

点击的连接或者图片的URL地址

下面再介绍一下上面注册项中Contexts项的作用,通过该项可以制定菜单项在右

键点击IE中的什么对象时

出现,它可以为以下值的“或”组合:

对象 值

缺省 0x1

图片 0x2

控件 0x4

表单域 0x8

选择文本 0x10

锚点 0x20

例如上面我们希望菜单项在用户点击图片或者超链接时出现,那么我们就将值设

置为dword:00000022,既在

点击图片 或者 锚点时出现菜单。一个锚点是页面中描述一个超链接的对象。如果不

设置Contexts项,则菜单项

会在点击任何对象时出现在右键菜单中。




 
好的。谢谢,问题是我要用户点击后出现一个下载对话框(可自制),图片下载完以后
,其它交给程序代码处理(处理部分为----保存到硬盘的文件夹里,然后Adotable
加入该纪录)怎么做?
 
处理部分如下保存到硬盘中
uses urlmon
function DownloadFile(Source, Dest: string): Boolean;
begin
try
Result:=UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
except
Result:=False;
end;
end;
 
请问 天真 ,如果知道连接的是个EXE程序,怎样可以不保存为文件,而直接下载执行?
以下是我的这个问题,来看一下吧,只有20分,嫌少再加。
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1070540
 
有没有人说的详细一点?
 
有没有人说的详细一点?
 
我来彻底解决这个问题,修改以下程序即可实现你要的功能

我们首先要建立一个ActiveX Library。将其保存为MailIEBand.Dpr;然后建立一个COM Object,将其保存为BandUnit.pas;然后建立一个Form,这个窗口将作为子窗口显示在IE工具栏中,将窗口的BorderStyle属性改为bsNone,添加一个TButton组件和一个TComboBox组件,将TButton的Caption属性改为获取全部,然后将窗口文件其保存为IEForm.pas。
在BandUnit中,需要建立一个实现上面提到的接口的TComObject对象。如下:
TGetMailBand = class(TComObject, IDeskBand, IObjectWithSite, IPersistStreamInit)

另外由于需要在COM服务器注册时添加一些注册表信息,所以还需要建立一个继承自TComObjectFactory类的对象,在对象的UpdateRegistry事件中编写代码添加附加的注册表信息。
下面的程序清单1-6到1-8是实现COM服务器的全部程序代码:

程序清单1-6 MailIEBand.dpr
library MailIEBand;

uses
ComServ,
BandUnit in 'BandUnit.pas',
IEForm in 'IEForm.pas' {Form1},
MailIEBand_TLB in 'MailIEBand_TLB.pas';

exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;

{$R *.TLB}

{$R *.RES}

begin
end.

程序清单1-7 BandUnit.pas

unit BandUnit;

interface

uses
Windows, Sysutils, Messages, Registry, Shellapi, ActiveX, Classes, ComObj,
Shlobj, Dialogs, Commctrl,ShDocVW,IEForm;

type
TGetMailBand = class(TComObject, IDeskBand, IObjectWithSite, IPersistStreamInit)
private
frmIE:TForm1;
m_pSite:IInputObjectSite;
m_hwndParent:HWND;
m_hWnd:HWND;
m_dwViewMode:Integer;
m_dwBandID:Integer;
protected

public
{Declare IDeskBand methods here}
function GetBandInfo(dwBandID, dwViewMode: DWORD; var pdbi: TDeskBandInfo):
HResult; stdcall;
function ShowDW(fShow: BOOL): HResult; stdcall;
function CloseDW(dwReserved: DWORD): HResult; stdcall;
function ResizeBorderDW(var prcBorder: TRect; punkToolbarSite: IUnknown;
fReserved: BOOL): HResult; stdcall;
function GetWindow(out wnd: HWnd): HResult; stdcall;
function ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;

{Declare IObjectWithSite methods here}
function SetSite(const pUnkSite: IUnknown ):HResult; stdcall;
function GetSite(const riid: TIID; out site: IUnknown):HResult;stdcall;

{Declare IPersistStream methods here}
function GetClassID(out classID: TCLSID): HResult; stdcall;
function IsDirty: HResult; stdcall;
function InitNew: HResult; stdcall;
function Load(const stm: IStream): HResult; stdcall;
function Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;
function GetSizeMax(out cbSize: Largeint): HResult; stdcall;
end;

const
Class_GetMailBand: TGUID = '{954F618B-0DEC-4D1A-9317-E0FC96F87865}';
//以下是系统接口的IID
IID_IUnknown: TGUID = (
D1:$00000000;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
IID_IOleObject: TGUID = (
D1:$00000112;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));
IID_IOleWindow: TGUID = (
D1:$00000114;D2:$0000;D3:$0000;D4:($C0,$00,$00,$00,$00,$00,$00,$46));

IID_IInputObjectSite : TGUID = (
D1:$f1db8392;D2:$7331;D3:$11d0;D4:($8C,$99,$00,$A0,$C9,$2D,$BF,$E8));
sSID_SInternetExplorer : TGUID = '{0002DF05-0000-0000-C000-000000000046}';
sIID_IWebBrowserApp : TGUID= '{0002DF05-0000-0000-C000-000000000046}';

//面板所允许的最小宽度和高度。
MIN_SIZE_X = 54;
MIN_SIZE_Y = 22;
EB_CLASS_NAME = 'GetMailAddress';
implementation

uses ComServ;


function TGetMailBand.GetWindow(out wnd: HWnd): HResult; stdcall;
begin
wnd:=m_hWnd;
Result:=S_OK;
end;

function TGetMailBand.ContextSensitiveHelp(fEnterMode: BOOL): HResult; stdcall;
begin
Result:=E_NOTIMPL;
end;

function TGetMailBand.ShowDW(fShow: BOOL): HResult; stdcall;
begin
if m_hWnd<>0 then
if fShow then
ShowWindow(m_hWnd,SW_SHOW)
else
ShowWindow(m_hWnd,SW_HIDE);
Result:=S_OK;
end;

function TGetMailBand.CloseDW(dwReserved: DWORD): HResult; stdcall;
begin
if frmIE<>nil then
frmIE.Destroy;
Result:= S_OK;
end;

function TGetMailBand.ResizeBorderDW(var prcBorder: TRect;
punkToolbarSite: IUnknown;fReserved: BOOL): HResult; stdcall;
begin
Result:=E_NOTIMPL;
end;

function TGetMailBand.SetSite(const pUnkSite: IUnknown):HResult;stdcall;
var
pOleWindow:IOleWindow;
pOLEcmd:IOleCommandTarget;
pSP:IServiceProvider;
rc:TRect;
begin
if Assigned(pUnkSite) then begin
m_hwndParent := 0;

m_pSite:=pUnkSite as IInputObjectSite;
pOleWindow := PunkSIte as IOleWindow;
//获得父窗口IE面板窗口的句柄
pOleWindow.GetWindow(m_hwndParent);

if(m_hwndParent=0)then begin
Result := E_FAIL;
exit;
end;

//获得父窗口区域
GetClientRect(m_hwndParent, rc);

if not Assigned(frmIE) then begin
//建立TIEForm窗口,父窗口为m_hwndParent
frmIE:=TForm1.CreateParented(m_hwndParent);

m_Hwnd:=frmIE.Handle;

SetWindowLong(frmIE.Handle, GWL_STYLE, GetWindowLong(frmIE.Handle,
GWL_STYLE) Or WS_CHILD);
//根据父窗口区域设置窗口位置
with frmIE do begin
Left :=rc.Left ;
Top:=rc.top;
Width:=rc.Right - rc.Left;
Height:=rc.Bottom - rc.Top;
end;
frmIE.Visible := True;

//获得与浏览器相关联的Webbrowser对象。
pOLEcmd:=pUnkSite as IOleCommandTarget;
pSP:=pOLEcmd as IServiceProvider;

if Assigned(pSP)then begin
pSP.QueryService(IWebbrowserApp, IWebbrowser2,frmIE.IEThis);
end;
end;
end;

Result := S_OK;
end;

function TGetMailBand.GetSite(const riid: TIID; out site: IUnknown):HResult;stdcall;
begin
if Assigned(m_pSite) then result:=m_pSite.QueryInterface(riid, site)
else
Result:= E_FAIL;
end;

function TGetMailBand.GetBandInfo(dwBandID, dwViewMode: DWORD; var pdbi: TDeskBandInfo):
HResult; stdcall;
begin
Result:=E_INVALIDARG;
if not Assigned(frmIE) then frmIE:=TForm1.CreateParented(m_hwndParent);
if(@pdbi<>nil)then begin
m_dwBandID := dwBandID;
m_dwViewMode := dwViewMode;

if(pdbi.dwMask and DBIM_MINSIZE)<>0 then begin
pdbi.ptMinSize.x := MIN_SIZE_X;
pdbi.ptMinSize.y := MIN_SIZE_Y;
end;

if(pdbi.dwMask and DBIM_MAXSIZE)<>0 then begin
pdbi.ptMaxSize.x := -1;
pdbi.ptMaxSize.y := -1;
end;

if(pdbi.dwMask and DBIM_INTEGRAL)<>0 then begin
pdbi.ptIntegral.x := 1;
pdbi.ptIntegral.y := 1;
end;

if(pdbi.dwMask and DBIM_ACTUAL)<>0 then begin
pdbi.ptActual.x := 0;
pdbi.ptActual.y := 0;
end;

if(pdbi.dwMask and DBIM_MODEFLAGS)<>0 then
pdbi.dwModeFlags := DBIMF_VARIABLEHEIGHT;

if(pdbi.dwMask and DBIM_BKCOLOR)<>0 then
pdbi.dwMask := pdbi.dwMask and (not DBIM_BKCOLOR);
end;
end;


function TGetMailBand.GetClassID(out classID: TCLSID): HResult; stdcall;
begin
classID:= Class_GetMailBand;
Result:=S_OK;
end;

function TGetMailBand.IsDirty: HResult; stdcall;
begin
Result:=S_FALSE;
end;

function TGetMailBand.InitNew: HResult;
begin
Result := E_NOTIMPL;
end;

function TGetMailBand.Load(const stm: IStream): HResult; stdcall;
begin
Result:=S_OK;
end;

function TGetMailBand.Save(const stm: IStream; fClearDirty: BOOL): HResult; stdcall;
begin
Result:=S_OK;
end;

function TGetMailBand.GetSizeMax(out cbSize: Largeint): HResult; stdcall;
begin
Result:=E_NOTIMPL;
end;


//TIEClassFac类实现COM组件的注册
type
TIEClassFac=class(TComObjectFactory) //
public
procedure UpdateRegistry(Register: Boolean); override;
end;

procedure TIEClassFac.UpdateRegistry(Register: Boolean);
var
ClassID: string;
a:Integer;
begin
inherited UpdateRegistry(Register);
if Register then begin
ClassID:=GUIDToString(Class_GetMailBand);
with TRegistry.Create do
try
//添加附加的注册表项
RootKey:=HKEY_LOCAL_MACHINE;
OpenKey('/SOFTWARE/Microsoft/Internet Explorer/Toolbar',False);
a:=0;
WriteBinaryData(GUIDToString(Class_GetMailBand),a,0);
OpenKey('/SOFTWARE/Microsoft/Windows/CurrentVersion/Shell Extensions/Approved',True);
WriteString (GUIDToString(Class_GetMailBand),EB_CLASS_NAME);
RootKey:=HKEY_CLASSES_ROOT;
OpenKey('/CLSID/'+GUIDToString(Class_GetMailBand),False);
WriteString('',EB_CLASS_NAME);
finally
Free;
end;
end
else begin
with TRegistry.Create do
try
RootKey:=HKEY_LOCAL_MACHINE;
OpenKey('/SOFTWARE/Microsoft/Internet Explorer/Toolbar',False);
DeleteValue(GUIDToString(Class_GetMailBand));
OpenKey('/Software/Microsoft/Windows/CurrentVersion/Shell Extensions/Approved',False);
DeleteValue(GUIDToString(Class_GetMailBand));
finally
Free;
end;
end;
end;

initialization
TIEClassFac.Create(ComServer, TGetMailBand, Class_GetMailBand,
'GetMailAddress', '', ciMultiInstance, tmApartment);
end.

程序清单1-8 IEForm.pas

unit IEForm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
SHDocVw,MSHTML, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
ComboBox1: TComboBox;
procedure FormResize(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
IEThis:IWebbrowser2;
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormResize(Sender: TObject);
begin
With Button1 do begin
Left := 0;
Top := 0;
Height:=Self.ClientHeight;
end;
With ComboBox1 do begin
Left := Button1.Width +3;
Top := 0;
Height:=Self.ClientHeight;
Width:=Self.ClientWidth - Left;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
doc:IHTMLDocument2;
all:IHTMLElementCollection;
len,i,flag:integer;
item:IHTMLElement;
vAttri:Variant;
begin
if Assigned(IEThis)then begin
ComboBox1.Clear;
//获得Webbrowser对象中的文档对象
doc:=IEThis.Document as IHTMLDocument2;
//获得文档中所有的HTML元素集合
all:=doc.Get_all;

len:=all.Get_length;

//访问HTML元素集合中的每一个元素
for i:=0 to len-1 do begin
item:=all.item(i,varempty) as IHTMLElement;
//如果该元素是一个链接
if item.Get_tagName = 'A'then begin
flag:=0;
vAttri:=item.getAttribute('protocol',flag); //获得链接属性
//如果是mailto链接则将链接的目标地址添加到ComboBox1
if vAttri = 'mailto:'then begin
vAttri:=item.getAttribute('href',flag);
ComboBox1.Items.Add(vAttri);
end;
end;
end;
end;
end;

end.

编译工程,关闭所有的IE窗口,然后点击Delphi菜单的Run | Register ActiveX Server 项注册服务器。然后打开IE,点击菜单 察看 | 工具栏 项,可以看到子菜单中多了一个GetMailAddress项,选中改项,工具栏就出现在IE工具栏中
 

Similar threads

后退
顶部