cmadmctl.pas

这是不可多得的源代码

{*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{                                                       }
{  Copyright (c) 2000,2001 Borland Software Corporation }
{                                                       }
{*******************************************************}

unit CmAdmCtl;

interface

uses Windows, ActiveX, Classes, Graphics, OleServer, OleCtrls, StdVCL, COMAdmin;

type
  CoCOMAdminCatalog = class
    class function Create: ICOMAdminCatalog;
  end;

  TCOMAdminCatalogCollection = class;

  TCOMAdminCatalog = class(TOleServer)
  private
    FIntf:        ICOMAdminCatalog;
    function      GetDefaultInterface: ICOMAdminCatalog;
  protected
    procedure InitServerData; override;
  public
    { TOleServer }
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure Connect; override;
    procedure ConnectTo(svrIntf: ICOMAdminCatalog);
    procedure Disconnect; override;
    {ICOMAdminCatalog }
    function  GetCollection(const bstrCollName: WideString): 
                            TCOMAdminCatalogCollection;
    function  ICOMAdminCatalog_Connect(const bstrConnectString: WideString): 
                                       TCOMAdminCatalogCollection;
    function  Get_MajorVersion: Integer;
    function  Get_MinorVersion: Integer;
    function  GetCollectionByQuery(const bstrCollName: WideString; 
                                   var aQuery: PSafeArray): 
                                   TCOMAdminCatalogCollection;
    procedure ImportComponent(const bstrApplIdOrName: WideString;
                              const bstrCLSIDOrProgId: WideString);
    procedure InstallComponent(const bstrApplIdOrName: WideString; 
                               const bstrDLL: WideString; 
                               const bstrTLB: WideString; 
                               const bstrPSDLL: WideString);
    procedure ShutdownApplication(const bstrApplIdOrName: WideString);
    procedure ExportApplication(const bstrApplIdOrName: WideString;
                                const bstrApplicationFile: WideString; 
                                lOptions: Integer);
    procedure InstallApplication(const bstrApplicationFile: WideString;
                                 const bstrDestinationDirectory: WideString; 
                                 lOptions: Integer;const bstrUserId: WideString;
                                 const bstrPassword: WideString; 
                                 const bstrRSN: WideString);
    procedure StopRouter;
    procedure RefreshRouter;
    procedure StartRouter;
    procedure InstallMultipleComponents(const bstrApplIdOrName: WideString;
                                        var varFileNames: PSafeArray; 
                                        var varCLSIDS: PSafeArray);
    procedure GetMultipleComponentsInfo(const bstrApplIdOrName: WideString;
                                        var varFileNames: PSafeArray; 
                                        out varCLSIDS: PSafeArray;
                                        out varClassNames: PSafeArray;
                                        out varFileFlags: PSafeArray;
                                        out varComponentFlags: PSafeArray);
    procedure RefreshComponents;
    procedure BackupREGDB(const bstrBackupFilePath: WideString);
    procedure RestoreREGDB(const bstrBackupFilePath: WideString);
    procedure QueryApplicationFile(const bstrApplicationFile: WideString;
                                   out bstrApplicationName: WideString;
                                   out bstrApplicationDescription: WideString;
                                   out bHasUsers: WordBool; 
                                   out bIsProxy: WordBool;
                                   out varFileNames: PSafeArray);
    procedure StartApplication(const bstrApplIdOrName: WideString);
    function  ServiceCheck(lService: Integer): Integer;
    procedure InstallMultipleEventClasses(const bstrApplIdOrName: WideString;
                                          var varFileNames: PSafeArray; 
                                          var varCLSIDS: PSafeArray);
    procedure InstallEventClass(const bstrApplIdOrName: WideString; 
                                const bstrDLL: WideString;
                                const bstrTLB: WideString; 
                                const bstrPSDLL: WideString);
    procedure GetEventClassesForIID(const bstrIID: WideString; 
                                    out varCLSIDS: PSafeArray;
                                    out varProgIDs: PSafeArray; 
                                    out varDescriptions: PSafeArray);
    { properties }
    property  DefaultInterface: ICOMAdminCatalog read GetDefaultInterface;
    property MajorVersion: Integer read Get_MajorVersion;
    property MinorVersion: Integer read Get_MinorVersion;
  end;

  CoCOMAdminCatalogObject = class
    class function Create: ICatalogObject;
  end;

  TCOMAdminCatalogObject = class(TOleServer)
  private
    FIntf:        ICatalogObject;
    function      GetDefaultInterface: ICatalogObject;
  protected
    procedure InitServerData; override;
  public
    { TOleServer }
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure Connect; override;
    procedure ConnectTo(svrIntf: ICatalogObject);
    procedure Disconnect; override;
    { ICatalogObject }
    function  Get_Value(const bstrPropName: WideString): OleVariant;
    procedure Set_Value(const bstrPropName: WideString; retval: OleVariant);
    function  Get_Key: OleVariant;
    function  Get_Name: OleVariant;
    function  IsPropertyReadOnly(const bstrPropName: WideString): WordBool;
    function  Get_Valid: WordBool;
    function  IsPropertyWriteOnly(const bstrPropName: WideString): WordBool;
    property Value[const bstrPropName: WideString]: OleVariant read Get_Value 
                                                               write Set_Value;
    property  DefaultInterface: ICatalogObject read GetDefaultInterface;
    property Key: OleVariant read Get_Key;
    property Name: OleVariant read Get_Name;
    property Valid: WordBool read Get_Valid;
  end;

  CoCOMAdminCatalogCollection = class
    class function Create: ICatalogCollection;
  end;

  TCOMAdminCatalogCollection = class(TOleServer)
  private
    FIntf:        ICatalogCollection;
    function      GetDefaultInterface: ICatalogCollection;
  protected
    procedure InitServerData; override;
  public
    { TOleServer }
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure Connect; override;
    procedure ConnectTo(svrIntf: ICatalogCollection);
    procedure Disconnect; override;
    { ICatalogCollection }
    function  Get_Item(lIndex: Integer): TCOMAdminCatalogObject; 
    function  Get_Count: Integer;
    procedure Remove(lIndex: Integer);
    function  Add: TCOMAdminCatalogObject;
    procedure Populate;
    function  SaveChanges: Integer;
    function  GetCollection(const bstrCollName: WideString;
                            varObjectKey: OleVariant): 
                            TCOMAdminCatalogCollection;
    function  Get_Name: OleVariant;
    function  Get_AddEnabled: WordBool;
    function  Get_RemoveEnabled: WordBool;
    function  GetUtilInterface: IDispatch;
    function  Get_DataStoreMajorVersion: Integer;
    function  Get_DataStoreMinorVersion: Integer;
    procedure PopulateByKey(aKeys: PSafeArray);
    procedure PopulateByQuery(const bstrQueryString: WideString; 
                             lQueryType: Integer);
    { properties }
    property DefaultInterface: ICatalogCollection read GetDefaultInterface;
    property Count: Integer read Get_Count;
    property Name: OleVariant read Get_Name;
    property AddEnabled: WordBool read Get_AddEnabled;
    property RemoveEnabled: WordBool read Get_RemoveEnabled;
    property DataStoreMajorVersion: Integer read Get_DataStoreMajorVersion;
    property DataStoreMinorVersion: Integer read Get_DataStoreMinorVersion;
  end;

implementation

uses ComObj;

class function CoCOMAdminCatalog.Create: ICOMAdminCatalog;
begin
  Result := CreateComObject(CLASS_COMAdminCatalog) as ICOMAdminCatalog;
end;

procedure TCOMAdminCatalog.InitServerData;
const
  CServerData: TServerData = (
    ClassID:   '{F618C514-DFB8-11D1-A2CF-00805FC79235}';
    IntfIID:   '{DD662187-DFC2-11D1-A2CF-00805FC79235}';
    EventIID:  '';
    LicenseKey: nil;
    Version: 500);
begin
  ServerData := @CServerData;
end;

procedure TCOMAdminCatalog.Connect;
var
  punk: IUnknown;
begin
  if FIntf = nil then
  begin
    punk := GetServer;
    Fintf:= punk as ICOMAdminCatalog;
  end;
end;

procedure TCOMAdminCatalog.ConnectTo(svrIntf: ICOMAdminCatalog);
begin
  Disconnect;
  FIntf := svrIntf;
end;

procedure TCOMAdminCatalog.DisConnect;
begin
  if Fintf <> nil then
  begin
    FIntf := nil;
  end;
end;

function TCOMAdminCatalog.GetDefaultInterface: ICOMAdminCatalog;
begin
  if FIntf = nil then
    Connect;
  Result := FIntf;
end;

constructor TCOMAdminCatalog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
end;

destructor TCOMAdminCatalog.Destroy;
begin
  inherited Destroy;
end;

function  TCOMAdminCatalog.Get_MajorVersion: Integer;
begin
  Result := DefaultInterface.Get_MajorVersion;
end;

function  TCOMAdminCatalog.Get_MinorVersion: Integer;
begin
  Result := DefaultInterface.Get_MinorVersion;
end;

function TCOMAdminCatalog.GetCollection(const bstrCollName: WideString): 
                                        TCOMAdminCatalogCollection;
begin
  Result := TCOMAdminCatalogCollection.Create(Self);
  Result.ConnectTo(DefaultInterface.GetCollection(bstrCollName) as 
                   ICatalogCollection);
end;

function  TCOMAdminCatalog.ICOMAdminCatalog_Connect(
               const bstrConnectString: WideString): TCOMAdminCatalogCollection;
begin
  Result := TCOMAdminCatalogCollection.Create(Self);
  Result.ConnectTo(DefaultInterface.Connect(bstrConnectString) as ICatalogCollection);
end;

function  TCOMAdminCatalog.GetCollectionByQuery(const bstrCollName: WideString; 
                                                var aQuery: PSafeArray): 
                                                TCOMAdminCatalogCollection;
begin
  Result := TCOMAdminCatalogCollection.Create(Self);
  Result.ConnectTo(DefaultInterface.GetCollectionByQuery(bstrCollName, aQuery) as ICatalogCollection);
end;

procedure TCOMAdminCatalog.ImportComponent(const bstrApplIdOrName: WideString; 
                                           const bstrCLSIDOrProgId: WideString);
begin
  DefaultInterface.ImportComponent(bstrApplIdOrName, bstrCLSIDOrProgId);
end;

procedure TCOMAdminCatalog.InstallComponent(const bstrApplIdOrName: WideString; 
                                            const bstrDLL: WideString; const bstrTLB: WideString; 
                                            const bstrPSDLL: WideString);
begin
  DefaultInterface.InstallComponent(bstrApplIdOrName, bstrDLL, bstrTLB, bstrPSDLL);
end;

procedure TCOMAdminCatalog.ShutdownApplication(const bstrApplIdOrName: WideString);
begin
  DefaultInterface.ShutdownApplication(bstrApplIdOrName);
end;

procedure TCOMAdminCatalog.ExportApplication(const bstrApplIdOrName: WideString; 
                                             const bstrApplicationFile: WideString; 
                                             lOptions: Integer);
begin
  DefaultInterface.ExportApplication(bstrApplIdOrName, bstrApplicationFile, lOptions);
end;

procedure TCOMAdminCatalog.InstallApplication(const bstrApplicationFile: WideString; 
                                              const bstrDestinationDirectory: WideString; 
                                              lOptions: Integer; const bstrUserId: WideString; 
                                              const bstrPassword: WideString; 
                                              const bstrRSN: WideString);
begin
  DefaultInterface.InstallApplication(bstrApplicationFile, bstrDestinationDirectory, lOptions, 
                                      bstrUserId, bstrPassword, bstrRSN);
end;

procedure TCOMAdminCatalog.StopRouter;
begin
  DefaultInterface.StopRouter;
end;

procedure TCOMAdminCatalog.RefreshRouter;
begin
  DefaultInterface.RefreshRouter;
end;