AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) API-Funktion zum Registrieren eines COM-Servers gesucht
Thema durchsuchen
Ansicht
Themen-Optionen

API-Funktion zum Registrieren eines COM-Servers gesucht

Ein Thema von Luckie · begonnen am 26. Okt 2007 · letzter Beitrag vom 19. Mär 2008
 
Benutzerbild von toms
toms
(CodeLib-Manager)

Registriert seit: 10. Jun 2002
4.648 Beiträge
 
Delphi XE Professional
 
#5

Re: API-Funktion zum Registrieren eines COM-Servers gesucht

  Alt 19. Mär 2008, 22:28
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.
Thomas
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 09:15 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz