
unit SafeFactory;
interface
uses ComObj, ActiveX, AXCtrls;

const
CATID_SafeForScripting: TGUID =
'{7DD95801-9882-11CF-9FA9-00AA006C42C4}';
CATID_SafeForInitializing: TGUID =
'{7DD95802-9882-11CF-9FA9-00AA006C42C4}';

type
TSafeActiveFormFactory = class( TActiveFormFactory )
  procedure UpdateRegistry( Register: Boolean ); override;
end;

TSafeActiveXControlFactory = class( TActiveXControlFactory )
  procedure UpdateRegistry( Register: Boolean ); override;
end;

implementation

procedure AddSafetyKeys( const ClassID: TGUID );
var
ClassKey: string;
begin  
ClassKey := 'CLSID\' + GUIDToString( ClassID );
CreateRegKey( ClassKey + '\Implemented Categories','','');
CreateRegKey( ClassKey + '\Implemented Categories\'+GUIDToString(
CATID_SafeForScripting ),'','');
CreateRegKey( ClassKey + '\Implemented Categories\'+GUIDToString(
CATID_SafeForInitializing ),'','');
end;

procedure RemoveSafetyKeys( const ClassID: TGUID );
var
ClassKey: string;
begin      
ClassKey := 'CLSID\' + GUIDToString( ClassID );
DeleteRegKey( ClassKey + '\Implemented Categories\'+GUIDToString(
CATID_SafeForInitializing ));
DeleteRegKey( ClassKey + '\Implemented Categories\'+GUIDToString(
CATID_SafeForScripting ));
DeleteRegKey( ClassKey + '\Implemented Categories');
end;

{TSafeActiveFormFactory}
procedure TSafeActiveFormFactory.UpdateRegistry( Register: Boolean ); begin
if Register then
begin
  AddSafetyKeys( ClassID );
  inherited UpdateRegistry( Register );
end
else
begin
  RemoveSafetyKeys( ClassID );
  inherited UpdateRegistry( Register );
end;
end;

{TSafeActiveXControlFactory}
procedure TSafeActiveXControlFactory.UpdateRegistry( Register: Boolean );
begin
if Register then
begin
  AddSafetyKeys( ClassID );
  inherited UpdateRegistry( Register );
end
else
begin
  RemoveSafetyKeys( ClassID );
  inherited UpdateRegistry( Register );
end;
end;

end.

