大家有没有这样的DELPHI代码？(200分)

编写浏览器不弹出警告的ActiveX控件

(来自 http://www.try2it.com)



--------------------------------------------------------------------------------
我们在编写ActiveX控件时，如果用在浏览器中，经常都会弹出现在运行的脚本不安全的提示，如果给客户使用，将会带来极大不便。

按照MSDN的介绍通常有两种一种是实现IObjectSafe接口，一种是通过修改注册表的方法。一般如果用ATL开发ActiveX控件，就用实现IObjectSafe接口的方法。如果用MFC开发，我觉得还是用修改注册表的方法比较方便。下面我们将第二种方法：

要包括两个文件
#include "comcat.h"
#include "Objsafe.h"

// 本控件的CLSID,注册表用
const GUID CDECL CLSID_SafeItem ={ 0x7AE7497B, 0xCAD8, 0x4E66,
{ 0xA5,0x8B,0xDD,0xE9,0xBC,0xAF,0x6B,0x61 } };
// 版本控制
const WORD _wVerMajor = 1;
// 次版本号
const WORD _wVerMinor = 0;


/////////////////////////////////////////////////////////////////////
// CICCardApp::InitInstance - DLL initialization

BOOL CICCardApp::InitInstance()
{
BOOL bInit = COleControlModule::InitInstance();

if (bInit)
{

}

return bInit;
}


//////////////////////////////////////////////////////////////////////
// CICCardApp::ExitInstance - DLL termination

int CICCardApp::ExitInstance()
{
return COleControlModule::ExitInstance();
}


//////////////////////////////////////////////////////////////////////

// 创建组件种类
HRESULT CreateComponentCategory(CATID catid, WCHAR* catDescription)
{
ICatRegister* pcr = NULL
HRESULT hr = S_OK

hr = CoCreateInstance(CLSID_StdComponentCategoriesMgr,
NULL, CLSCTX_INPROC_SERVER, IID_ICatRegister, (void**)&pcr);
if (FAILED(hr))
return hr;

// Make sure the HKCR/Component Categories/{..catid...}
// key is registered.
CATEGORYINFO catinfo;
catinfo.catid = catid;
catinfo.lcid = 0x0409
// english

// Make sure the provided description is not too long.
// Only copy the first 127 characters if it is.
int len = wcslen(catDescription);
if (len>127)
len = 127;
wcsncpy(catinfo.szDescription, catDescription, len);
// Make sure the description is null terminated.
catinfo.szDescription[len] = '/0';

hr = pcr->RegisterCategories(1, &catinfo);
pcr->Release();

return hr;
}

// 注册组件种类
HRESULT RegisterCLSIDInCategory(REFCLSID clsid, CATID catid)
{
// Register your component categories information.
ICatRegister* pcr = NULL
HRESULT hr = S_OK
hr = CoCreateInstance(CLSID_StdComponentCategoriesMgr,
NULL, CLSCTX_INPROC_SERVER, IID_ICatRegister, (void**)&pcr);
if (SUCCEEDED(hr))
{
// Register this category as being "implemented" by the class.
CATID rgcatid[1]
rgcatid[0] = catid;
hr = pcr->RegisterClassImplCategories(clsid, 1, rgcatid);
}
if (pcr != NULL)
pcr->Release();
return hr;
}
// 卸载组件种类
HRESULT UnRegisterCLSIDInCategory(REFCLSID clsid, CATID catid)
{
ICatRegister* pcr = NULL
HRESULT hr = S_OK

hr = CoCreateInstance(CLSID_StdComponentCategoriesMgr,
NULL, CLSCTX_INPROC_SERVER, IID_ICatRegister, (void**)&pcr);
if (SUCCEEDED(hr))
{
// Unregister this category as being "implemented" by the class.
CATID rgcatid[1]
rgcatid[0] = catid;
hr = pcr->UnRegisterClassImplCategories(clsid, 1, rgcatid);
}

if (pcr != NULL)
pcr->Release();

return hr;
}


// DllRegisterServer - Adds entries to the system registry
STDAPI DllRegisterServer(void)
{
HRESULT hr;

AFX_MANAGE_STATE(_afxModuleAddrThis);

if (!AfxOleRegisterTypeLib(AfxGetInstanceHandle(), _tlid))
return ResultFromScode(SELFREG_E_TYPELIB);

if (!COleObjectFactoryEx::UpdateRegistryAll(TRUE))
return ResultFromScode(SELFREG_E_CLASS);

// 标记控件初始化安全.
// 创建初始化安全组件种类
hr = CreateComponentCategory(CATID_SafeForInitializing,
L"Controls safely initializable from persistent data!");
if (FAILED(hr))
return hr;
// 注册初始化安全
hr = RegisterCLSIDInCategory(CLSID_SafeItem, CATID_SafeForInitializing);
if (FAILED(hr))
return hr;

// 标记控件脚本安全
// 创建脚本安全组件种类
hr = CreateComponentCategory(CATID_SafeForScripting, L"Controls safely scriptable!");
if (FAILED(hr))
return hr;
// 注册脚本安全组件种类
hr = RegisterCLSIDInCategory(CLSID_SafeItem, CATID_SafeForScripting);
if (FAILED(hr))
return hr;

return NOERROR;
}


//////////////////////////////////////////////////////////////////
// DllUnregisterServer - Removes entries from the system registry

STDAPI DllUnregisterServer(void)
{
HRESULT hr;

AFX_MANAGE_STATE(_afxModuleAddrThis);

if (!AfxOleUnregisterTypeLib(_tlid, _wVerMajor, _wVerMinor))
return ResultFromScode(SELFREG_E_TYPELIB);

if (!COleObjectFactoryEx::UpdateRegistryAll(FALSE))
return ResultFromScode(SELFREG_E_CLASS);

// 删除控件初始化安全入口.
hr=UnRegisterCLSIDInCategory(CLSID_SafeItem, CATID_SafeForInitializing);
if (FAILED(hr))
return hr;
// 删除控件脚本安全入口
hr=UnRegisterCLSIDInCategory(CLSID_SafeItem, CATID_SafeForScripting);
if (FAILED(hr))
return hr;

//////////////////////////
return NOERROR;
}

做数字证书。 可以在csdn搜索activeX看看相关文章。

自己做的数字证书只解决签名问题。不能解决脚本安全和初始化安全性问题（除非用MONEY去INTERNET注册）。

如何在VB中实现ActiveX控件的IobjectSafety接口


--------------------------------------------------------------------------------

中蓝网源 时间：2003-7-19 19:07:07

总述
本文叙述了如何在VB中实现控件的IobjectSafety接口，以标志该控件是脚本安全和初始化安全的。VB控件默认的处理方式是在注册表中注册组件类来标识其安全性，但实现IobjectSafety接口是更好的方法。本言语包括了实现过程中所需的所有代码。

请注意，控件只有确确实实是安全的，才能被标识为“安全的”。本文并未论及如何确保控件的安全性，这个问题请参阅Internet Client Software Development Kit (SDK)中的相关文档 "Safe Initialization and Scripting for ActiveX Controls"，它在Component Development 栏目中。



相关信息：
<此处略去了一段也许无关紧要的警告>

现在开始循序渐进地举例说明怎样创建一个简单的VB控件，以及怎样将它标识为脚本安全和初始化安全。
首先新建一个文件夹来存放在本例中所产生的文件。

从VB CD-ROM取得OLE 自动化类库的制作工具。将VB安装光盘中/Common/Tools/VB/Unsupprt/Typlib/目录下所有内容一并拷贝到前面新建的项目文件夹中。


把下列内容拷贝到“记事本”中，然后保存到上述文件夹，文件名为Objsafe.odl：


[
uuid(C67830E0-D11D-11cf-BD80-00AA00575603),
helpstring("VB IObjectSafety Interface"),
version(1.0)
]
library IObjectSafetyTLB
{
importlib("stdole2.tlb")

[
uuid(CB5BDC81-93C1-11cf-8F20-00805F2CD064),
helpstring("IObjectSafety Interface"),
odl
]
interface IObjectSafety:IUnknown {
[helpstring("GetInterfaceSafetyOptions")]
HRESULT GetInterfaceSafetyOptions(
[in] long riid,
[in] long *pdwSupportedOptions,
[in] long *pdwEnabledOptions)


[helpstring("SetInterfaceSafetyOptions")]
HRESULT SetInterfaceSafetyOptions(
[in] long riid,
[in] long dwOptionsSetMask,
[in] long dwEnabledOptions)

}
}
在命令行提示符下切换到项目文件夹，输入下列命令创建一个.tlb 文件：


MKTYPLIB objsafe.odl /tlb objsafe.tlb
在VB中新建一个ActiveX Control 项目。修改属性，把项目命名为IobjSafety，控件命名为DemoCtl。在控件上放置一个按钮，命名为cmdTest，在它的Click事件中加入一句代码 MsgBox "Test" 。


打开菜单“工程->引用”，点“浏览”，找到刚刚建立的Objsafe.tlb，把它加入到引用中。


增加一个新module名为basSafeCtl，并在其中加入下列代码：


Option Explicit

Public Const IID_IDispatch = "{00020400-0000-0000-C000-000000000046}"
Public Const IID_IPersistStorage = _
"{0000010A-0000-0000-C000-000000000046}"
Public Const IID_IPersistStream = _
"{00000109-0000-0000-C000-000000000046}"
Public Const IID_IPersistPropertyBag = _
"{37D84F60-42CB-11CE-8135-00AA004BB851}"

Public Const INTERFACESAFE_FOR_UNTRUSTED_CALLER = &amp;H1
Public Const INTERFACESAFE_FOR_UNTRUSTED_DATA = &amp;H2
Public Const E_NOINTERFACE = &amp;H80004002
Public Const E_FAIL = &amp;H80004005
Public Const MAX_GUIDLEN = 40

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDest As Any, pSource As Any, ByVal ByteLen As Long)
Public Declare Function StringFromGUID2 Lib "ole32.dll" (rguid As _
Any, ByVal lpstrClsId As Long, ByVal cbMax As Integer) As Long

Public Type udtGUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Public m_fSafeForScripting As Boolean
Public m_fSafeForInitializing As Boolean

Sub Main()
m_fSafeForScripting = True
m_fSafeForInitializing = True
End Sub
在工程属性中把启动对象改成Sub Main确保上述代码会被执行。m_fSafeForScripting 和m_fSafeForInitializing两件变量的值分别指定了脚本安全和初始化安全取值。


打开控件代码窗口，在声明部分加入如下代码(如果有Option Explicit语句，当然要保证代码放在其后)：


Implements IObjectSafety
把下面两个过程代码拷贝到控件代码中：


Private Sub IObjectSafety_GetInterfaceSafetyOptions(ByVal riid As _
Long, pdwSupportedOptions As Long, pdwEnabledOptions As Long)

Dim Rc As Long
Dim rClsId As udtGUID
Dim IID As String
Dim bIID() As Byte

pdwSupportedOptions = INTERFACESAFE_FOR_UNTRUSTED_CALLER Or _
INTERFACESAFE_FOR_UNTRUSTED_DATA

If (riid <> 0) Then
CopyMemory rClsId, ByVal riid, Len(rClsId)

bIID = String$(MAX_GUIDLEN, 0)
Rc = StringFromGUID2(rClsId, VarPtr(bIID(0)), MAX_GUIDLEN)
Rc = InStr(1, bIID, vbNullChar) - 1
IID = Left$(UCase(bIID), Rc)

Select Case IID
Case IID_IDispatch
pdwEnabledOptions = IIf(m_fSafeForScripting, _
INTERFACESAFE_FOR_UNTRUSTED_CALLER, 0)
Exit Sub
Case IID_IPersistStorage, IID_IPersistStream, _
IID_IPersistPropertyBag
pdwEnabledOptions = IIf(m_fSafeForInitializing, _
INTERFACESAFE_FOR_UNTRUSTED_DATA, 0)
Exit Sub
Case Else
Err.Raise E_NOINTERFACE
Exit Sub
End Select
End If
End Sub

Private Sub IObjectSafety_SetInterfaceSafetyOptions(ByVal riid As _
Long, ByVal dwOptionsSetMask As Long, ByVal dwEnabledOptions As Long)
Dim Rc As Long
Dim rClsId As udtGUID
Dim IID As String
Dim bIID() As Byte

If (riid <> 0) Then
CopyMemory rClsId, ByVal riid, Len(rClsId)

bIID = String$(MAX_GUIDLEN, 0)
Rc = StringFromGUID2(rClsId, VarPtr(bIID(0)), MAX_GUIDLEN)
Rc = InStr(1, bIID, vbNullChar) - 1
IID = Left$(UCase(bIID), Rc)

Select Case IID
Case IID_IDispatch
If ((dwEnabledOptions And dwOptionsSetMask) <> _
INTERFACESAFE_FOR_UNTRUSTED_CALLER) Then
Err.Raise E_FAIL
Exit Sub
Else
If Not m_fSafeForScripting Then
Err.Raise E_FAIL
End If
Exit Sub
End If

Case IID_IPersistStorage, IID_IPersistStream, _
IID_IPersistPropertyBag
If ((dwEnabledOptions And dwOptionsSetMask) <> _
INTERFACESAFE_FOR_UNTRUSTED_DATA) Then
Err.Raise E_FAIL
Exit Sub
Else
If Not m_fSafeForInitializing Then
Err.Raise E_FAIL
End If
Exit Sub
End If

Case Else
Err.Raise E_NOINTERFACE
Exit Sub
End Select
End If
End Sub
保存后，把工程编译成OCX文件。现在控件已经实现了IObjectSafety 接口。在.htm中加入这件控件试一试吧。

收藏

学到了点东西，谢谢！

没有，看来你只有从c++改写到delphi了

学到了点东西，谢谢楼主，收藏！

呵呵，简单，你写的 com 要申明实现
IObjectSafety 接口就行了，说明是脚本安全和初始化安全的

IObjectSafety = interface(IUnknown)
['{CB5BDC81-93C1-11cf-8F20-00805F2CD064}']
function GetInterfaceSafetyOptions(const IID: TGUID
out SupportedOptions, EnabledOptions: Integer): HResult
stdcall;
function SetInterfaceSafetyOptions(const IID: TGUID
OptionSetMask, EnabledOptions: integer ): HResult
stdcall;
end;

TMyOcx = class(TAutoObject, IMyOcx, IObjectSafety)
protected
function GetInterfaceSafetyOptions(const IID: TGUID
out SupportedOptions, EnabledOptions: Integer): HResult
stdcall;
function SetInterfaceSafetyOptions(const IID: TGUID
OptionSetMask, EnabledOptions: integer ): HResult
stdcall;
{ Protected declarations }
// other procedure
end;

function TMyOcx.GetInterfaceSafetyOptions(const IID: TGUID
out SupportedOptions, EnabledOptions: Integer): HResult
stdcall;
begin
Result := S_OK;
//SupportedOptions := INTERFACESAFE_FOR_UNTRUSTED_CALLER + INTERFACESAFE_FOR_UNTRUSTED_DATA;
//EnabledOptions := SupportedOptions;
end;

function TMyOcx.SetInterfaceSafetyOptions(const IID: TGUID
OptionSetMask, EnabledOptions: integer ): HResult
stdcall;
begin
Result := S_OK;
end;

关注呀，这个经典问题了。不知道大家谁成功了

to koyochen:
测试不行，还是提示不安全的ACTIVX。

学习

我正想要这个的谢了

收藏

http://www.csdn.net/Develop/Read_Article.asp?Id=18061
如何给ActiveX数字签名(Step by Step, Delphi) Cixy（转贴）

这就是安全性的问题了，把internet浏览器的那几个选项启动就不会出来了。

cddyjcxb,
我这段 code 还是能够用的，
可能还有不少参数，没有功夫动仔细研究

TMyOcx 要用你的 ocx 定义替换

接受答案了.