高难度问题。关于COM的类厂，关于VC的代码如何在DELPHI中实现（因贴只太长，问题的一部分在回复中）

Question

现在有一段代码可以让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; 
    } 

Answer 1

////////////////////////////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[i] := 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[I])),
        '', FVerbs[I] + ',0,2');
  end else
  begin
    for I := 0 to FVerbs.Count - 1 do
      DeleteRegKey(ClassKey + '\Verb\' + IntToStr(Integer(FVerbs.Objects[I])));
    DeleteRegKey(ClassKey + '\Verb');
    DeleteRegKey(ClassKey + '\Control');
    DeleteRegKey(ClassKey + '\ToolboxBitmap32');
    DeleteRegKey(ClassKey + '\MiscStatus\1');
    DeleteRegKey(ClassKey + '\MiscStatus');
    inherited UpdateRegistry(Register);
  end;
end;
但我应该如何修改它呢？我当然不能直接在TActiveXControlFactory的源码中改，这样就会所有的控件都会改掉了，我只要象VC中一样只改特定的控件。