DLL über API registrieren

[Astat]

Zitat von Alois:

Ich möchte das nun über mein Programm erledigen d.h. beim Programmstart die DLL registrieren und beim Programmende die DLL un-registrieren.

Hallo Alois, anbei mein "Allesregistrierer".

Als eigenständiges Programm desshalb, weil bei Ladefehler in der Externen Library, sonst auch das
Eigene Programm abstürzen würde. Ich verwende das Teil um aus einer Menge von Dateien, automatisch
diejenigen zu registrieren, die die Exportfunktion DllRegister Server zur Verfügung stellen.
Regsvr32, machen VC5 + VC8 DLL's, bei denen Depenencies nicht aufgelöst werden können, Probleme
(Absturz AV's VC Runtimemeldungen des Systems, usw.
Desshalb dieses Programm.

Verwendung:
laregsvr.exe c:\dlltoregister.dll DllRegisterServer

lg. Astat

Delphi-Quellcode:

program laregsvr;

  {$APPTYPE CONSOLE}

uses
  windows,
  ActiveX,
  SysUtils;

const
  EXIT_ENTRY_NOT_FOUND      = 4000;
  EXIT_FUNCTION_CALL_ERROR  = 6000;
  EXIT_LOAD_LYBRARY_FAILED  = 8000;
  EXIT_UNEXPECTED_EXCEPTION = 10000;

var
  _hDll: THandle = 0;

type
  TRegProc = function: HRESULT; stdcall;

function SecureSafeLoadLibrary(const Filename: String; ErrorMode: UINT): HMODULE;
var
  SaveErrorMode: UINT;
  SaveFPUControlWord: Word;
begin
  SaveErrorMode := SetErrorMode(ErrorMode);
  try
    asm FNSTCW SaveFPUControlWord end;
    try
      Result := LoadLibrary(PChar(Filename));
    finally
      asm
        FNCLEX
        FLDCW SaveFPUControlWord
      end;
    end;
  finally
    SetErrorMode(SaveErrorMode);
  end;
end;

procedure Finnalize(AExitCode: integer; ALibHandle: THandle; const AMsg: string);
begin
  if ALibHandle <> 0 then begin
    FreeLibrary(_hDll);
    _hDll := 0;
  end;
  CharToOEM(PChar(AMsg), PChar(AMsg));
  Writeln(AMsg);
  if AExitCode > 0 then
    Halt(AExitCode);
end;


procedure RegisterAxLib(const FileName: string; RegAction: string);
var
  RegProc: TRegProc;
  ret: integer;
begin
  try
    _hDll := SecureSafeLoadLibrary(FileName, SEM_FAILCRITICALERRORS or
      SEM_NOGPFAULTERRORBOX or SEM_NOALIGNMENTFAULTEXCEPT or
      SEM_NOOPENFILEERRORBOX);

    if _hDll <> 0 then begin
      RegProc := GetProcAddress(_hDll, PChar(RegAction));
      if @RegProc = nil then begin
        Finnalize(EXIT_ENTRY_NOT_FOUND, _hDll, 'ERROR: Entrypoint ' +
          RegAction + ' ] not found.' + #13#10 + '    ' +
              SysErrorMessage(GetLastError) + #13#10);
      end else begin
        ret := RegProc;
        if ret <> 0 then begin
          Finnalize(EXIT_FUNCTION_CALL_ERROR, _hDll, 'ERROR Call to [ ' +
            FileName + ' ] Failed ' + #13#10 + '    ' + 'Retcode: ' +
              IntToStr(ret) + #13#10 + SysErrorMessage(GetLastError) + #13#10);
        end;
      end;
    end else begin
      Finnalize(EXIT_LOAD_LYBRARY_FAILED, _hDll, 'ERROR LoadLibrary: ' +
        #13#10 + '    ' + SysErrorMessage(GetLastError) + #13#10);
    end;
  except
    on e:exception do begin
      Finnalize(EXIT_UNEXPECTED_EXCEPTION, _hDll, 'EXCEPTION: RegisterAxLib: ' +
        #13#10 + '    ' + SysErrorMessage(GetLastError) + #13#10 +
          e.message + #13#10);
    end;
  end;
end;

begin
  Coinitialize(nil);

  writeln('Set Current Directory: ' + #13#10 + '    ' +
      ExtractFilePath(ParamStr(1)));

  if not SetCurrentDirectory(PChar(ExtractFilePath(ParamStr(1)))) then begin
    writeln('ERROR: Set Current Directory: ' + #13#10 + '    ' +
        ExtractFilePath(ParamStr(1)));
  end;

  writeln('RegisterAxLib: ' + #13#10 + '    ' +
      ParamStr(1) + ' ' + ParamStr(2));

  RegisterAxLib(Trim(ParamStr(1)), Trim(ParamStr(2)));

  writeln('SUCCESS: RegisterAxLib: ' + #13#10 + '    ' +
      ParamStr(1) + ' ' + ParamStr(2) + #13#10);

  CoUninitialize;    
end.