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.