高难度问题。关于COM的类厂,关于VC的代码如何在DELPHI中实现(200分)

G

g_feng

Unregistered / Unconfirmed
GUEST, unregistred user!
现在有一段代码可以让MFC中做出的控件,消除IE的安全提示的问题。我打算把它移到DELPHI中,最后剩下一个问题解决不了,有谁能搞定?
请看如下是VC代码和Delphi的对照:
///////////////////////////////VC
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

}

////////////////////////VC
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

}


////////////////////////////DELPHI
function CreateComponentCategory(catid :TGUID;var catDescription:widestring):HRESULT;
var pcr:ICatRegister;
hr :HRESULT;
catinfo:TCATEGORYINFO;
len,i:word;
begin
pcr := nil;
hr := S_OK

hr := CoCreateInstance(CLSID_StdComponentCategoryMgr,
NULL, CLSCTX_INPROC_SERVER, IID_ICatRegister, pcr);
if (FAILED(hr)) then
begin
result := hr;
exit;
end;
// Make sure the HKCR/Component Categories/{..catid...}
// key is registered

catinfo.catid := catid;
catinfo.lcid := $0409
// english

// Make sure the provided description is not too long.
// Only copy the first 127 characters if it is
len := length(catDescription);
if (len>127) then
len := 127;

for i:= 0 to len-1 do
begin
catinfo.szDescription := catDescription[i+1];
end;
// wcsncpy(catinfo.szDescription, catDescription, len);
// Make sure the description is null terminated
catinfo.szDescription[len] := #0;

hr := pcr.RegisterCategories(1, @catinfo);
pcr._Release();

result:= hr;
end;

function RegisterCLSIDInCategory(clsid:TGUID
catid:TGUID):HRESULT;
var pcr:ICatRegister;
hr :HRESULT;
// rgcatid:Array [0..1] of TGUID;
rgcatid:pGUID;
begin
// Register your component categories information.
pcr := nil;
hr := S_OK
hr := CoCreateInstance(CLSID_StdComponentCategoryMgr,
NULL, CLSCTX_INPROC_SERVER, IID_ICatRegister, pcr);
GetMem(rgcatid,sizeof(TGUID));
if (SUCCEEDED(hr)) then
begin
// Register this category as being "implemented" by
// the class.
rgcatid^ := catid;
hr := pcr.RegisterClassImplCategories(clsid, 1,Pointer(rgcatid));
end;
if (pcr <> NULL) then
pcr._Release();
result := hr;
end;

function UnRegisterCLSIDInCategory(clsid:TGUID
catid:TGUID):HRESULT;
var pcr:ICatRegister;
hr :HRESULT;
// rgcatid:Array [0..1] of TGUID;
rgcatid:pGUID;
begin
// Register your component categories information.
pcr := nil;
hr := S_OK
hr := CoCreateInstance(CLSID_StdComponentCategoryMgr,
NULL, CLSCTX_INPROC_SERVER, IID_ICatRegister, pcr);
GetMem(rgcatid,sizeof(TGUID));
if (SUCCEEDED(hr)) then
begin
rgcatid^ := catid;
hr := pcr.UnRegisterClassImplCategories(clsid, 1,Pointer(rgcatid));
end;
if (pcr <> NULL) then
pcr._Release();
result := hr;
end;

最后剩下一个问题是在MFC类中可以在类厂类中修改如下代码:
BOOL CClientCtrl::CClientCtrlFactory::UpdateRegistry(BOOL bRegister)
{
// TODO: Verify that your control follows apartment-model threading rules.
// Refer to MFC TechNote 64 for more information.
// If your control does not conform to the apartment-model rules, then
// you must modify the code below, changing the 6th parameter from
// afxRegInsertable | afxRegApartmentThreading to afxRegInsertable.

if (bRegister)
{
HRESULT hr = S_OK


// register as safe for scripting
hr = CreateComponentCategory(CATID_SafeForScripting,
L"Controls that are safely scriptable")


if (FAILED(hr))
return FALSE


hr = RegisterCLSIDInCategory(m_clsid, CATID_SafeForScripting)


if (FAILED(hr))
return FALSE


// register as safe for initializing
hr = CreateComponentCategory(CATID_SafeForInitializing,
L"Controls safely initializable from persistent data")


if (FAILED(hr))
return FALSE


hr = RegisterCLSIDInCategory(m_clsid, CATID_SafeForInitializing)


if (FAILED(hr))
return FALSE


/*
次部分是类向导产生的代码,原样代替换就行了
*/
return AfxOleRegisterControlClass(
AfxGetInstanceHandle(),
m_clsid,
m_lpszProgID,
IDS_CLIENT, //控件名
IDB_CLIENT, //控件名
afxRegInsertable | afxRegApartmentThreading,
_dwClientOleMisc, //控件名
_tlid,
_wVerMajor,
_wVerMinor)

/*
次部分是类向导产生的代码,原样代替换就行了^
*/

}
else
{
HRESULT hr = S_OK


hr = UnRegisterCLSIDInCategory(m_clsid, CATID_SafeForScripting)


if (FAILED(hr))
return FALSE


hr = UnRegisterCLSIDInCategory(m_clsid, CATID_SafeForInitializing)


if (FAILED(hr))
return FALSE


return AfxOleUnregisterClass(m_clsid, m_lpszProgID)

}
}


我发现在DELPHI中也有如下代码:
procedure TActiveXControlFactory.UpdateRegistry(Register: Boolean);
var
ClassKey: string;
I: Integer;
begin
ClassKey := 'CLSID/' + GUIDToString(ClassID);
if Register then
begin
inherited UpdateRegistry(Register);
CreateRegKey(ClassKey + '/MiscStatus', '', '0');
CreateRegKey(ClassKey + '/MiscStatus/1', '', IntToStr(FMiscStatus));
CreateRegKey(ClassKey + '/ToolboxBitmap32', '',
ComServer.ServerFileName + ',' + IntToStr(FToolboxBitmapID));
CreateRegKey(ClassKey + '/Control', '', '');
CreateRegKey(ClassKey + '/Verb', '', '');
for I := 0 to FVerbs.Count - 1 do
CreateRegKey(ClassKey + '/Verb/' + IntToStr(Integer(FVerbs.Objects)),
'', FVerbs + ',0,2');
end else
begin
for I := 0 to FVerbs.Count - 1 do
DeleteRegKey(ClassKey + '/Verb/' + IntToStr(Integer(FVerbs.Objects)));
DeleteRegKey(ClassKey + '/Verb');
DeleteRegKey(ClassKey + '/Control');
DeleteRegKey(ClassKey + '/ToolboxBitmap32');
DeleteRegKey(ClassKey + '/MiscStatus/1');
DeleteRegKey(ClassKey + '/MiscStatus');
inherited UpdateRegistry(Register);
end;
end;
但我应该如何修改它呢?我当然不能直接在TActiveXControlFactory的源码中改,这样就会所有的控件都会改掉了,我只要象VC中一样只改特定的控件。
 
高手呢????
 
顶部