API-Funktion zum Registrieren eines COM-Servers gesucht

[toms]

Falls es mal jemand braucht:

Delphi-Quellcode:

unit ComReg;
////////////////////////////////////////////////////////////////////////////////
//
// Unit : COMREG
// Date : 12.15.2004
// Author : rllibby
//
// Description : Unit that provides an easy means for loading then
// (un)registering a com activex library.
//
////////////////////////////////////////////////////////////////////////////////
interface

////////////////////////////////////////////////////////////////////////////////
// Include Units
////////////////////////////////////////////////////////////////////////////////
uses
  Windows,
  SysUtils;

////////////////////////////////////////////////////////////////////////////////
// Library function declarations
////////////////////////////////////////////////////////////////////////////////
type
  TDllRegister = function: HResult; stdcall;
  TDllUnregister = function: HResult; stdcall;

////////////////////////////////////////////////////////////////////////////////
// Structure data types
////////////////////////////////////////////////////////////////////////////////
type
  TRegFunctions = packed record
     lpRegister: TDllRegister;
     lpUnregister: TDllRegister;
  end;

////////////////////////////////////////////////////////////////////////////////
// Class for handling of library registration
////////////////////////////////////////////////////////////////////////////////
type
  TRegActionType = (raRegister, raUnregister);
  TRegActionTypes = Set of TRegActionType;
  TComRegistration = class(TObject)
  private
     // Private declarations
     FLibHandle: THandle;
     FFunctions: TRegFunctions;
  protected
     // Protected declarations
     function GetLoaded: Boolean;
     function GetIsComLibrary: Boolean;
     function GetAvailableActions: TRegActionTypes;
  public
     // Public declarations
     constructor Create;
     destructor Destroy; override;
     function Load(LibraryName: String): Integer;
     function Perform(Action: TRegActionType): HResult;
     procedure Unload;
     property AvailableActions: TRegActionTypes read GetAvailableActions;
     property Handle: THandle read FLibHandle;
     property IsLoaded: Boolean read GetLoaded;
     property IsComLibrary: Boolean read GetIsComLibrary;
  end;

implementation

function TComRegistration.GetLoaded: Boolean;
begin

  // Do we have a library loaded?
  result:=(FLibHandle > 0);

end;

function TComRegistration.GetAvailableActions: TRegActionTypes;
begin

  // Set default result set
  result:=[];

  // Check loaded state
  if GetLoaded then
  begin
     // Check function table
     if Assigned(@FFunctions.lpRegister) then Include(result, raRegister);
     if Assigned(@FFunctions.lpUnregister) then Include(result, raUnregister);
  end;

end;

function TComRegistration.GetIsComLibrary: Boolean;
begin

  // Is this an ActiveX library
  result:=GetLoaded and (Assigned(@FFunctions.lpRegister) and Assigned(@FFunctions.lpUnregister));

end;

function TComRegistration.Load(LibraryName: String): Integer;
begin

  // Unload first
  Unload;

  // Attempt to load the libary
  FLibHandle:=LoadLibrary(PChar(LibraryName));

  // Get result status
  if (FLibHandle = 0) then
     result:=GetLastError
  else
     result:=ERROR_SUCCESS;

  // If we loaded the library, then try to get the function addresses
  if (FLibHandle > 0) then
  begin
     // Try to get the function addresses
     @FFunctions.lpRegister:=GetProcAddress(FLibHandle, 'DllRegisterServer');
     @FFunctions.lpUnregister:=GetProcAddress(FLibHandle, 'DllUnregisterServer');
  end;

end;

function TComRegistration.Perform(Action: TRegActionType): HResult;
begin

  // Check loaded state
  if not(GetLoaded) then
     // Failure
     result:=ERROR_MOD_NOT_FOUND
  else
  begin
     // Check the functions
     if (Action = raRegister) then
     begin
        // Check function
        if Assigned(@FFunctions.lpRegister) then
           // Call the function
           result:=FFunctions.lpRegister
        else
           // No function
           result:=ERROR_PROC_NOT_FOUND;
     end
     else
     begin
        // Check function
        if Assigned(@FFunctions.lpUnregister) then
           // Call the function
           result:=FFunctions.lpUnregister
        else
           // No function
           result:=ERROR_PROC_NOT_FOUND;
     end;
  end;

end;

procedure TComRegistration.Unload;
begin

  // Clear the function table
  ZeroMemory(@FFunctions, SizeOf(TRegFunctions));

  // Unload any loaded library
  if (FLibHandle > 0) then
  begin
     try
        FreeLibrary(FLibHandle);
     finally
        FLibHandle:=0;
     end;
  end;

end;

constructor TComRegistration.Create;
begin

  // Perform inherited
  inherited;

  // Set starting defaults
  FLibHandle:=0;
  ZeroMemory(@FFunctions, SizeOf(TRegFunctions));

end;

destructor TComRegistration.Destroy;
begin

  // Make sure everything is unloaded
  Unload;

  // Perform inherited
  inherited Destroy;

end;

end.