////////////////////////////////////////////////////////////////////////////////
// CM2RegisterTools.pas
// --------------------
// This unit contains COM+/PlugIn install routines for CM2
//
// Last Edit: Feburary 1st, 2005
// Certified: NA
//
// This unit is coded in : Delphi 7
//
// Unit is copyright (c) 2003 - 2005, The CoolMon Project
////////////////////////////////////////////////////////////////////////////////
{$D+}
unit CM2RegisterTools;

interface

Uses
 Windows, Registry, SysUtils, ComObj, Classes, CM2PlugInTypes, CM2GenInterface,
 CM2VisInterface, CM2AutoUpdateInterface, CM2CMLxInterface, dotNETInterface, forms;

Const
 RegisterToolsVersion = 0200;

Type
 TDLLRegisterServer = Function: HResult; Stdcall;
 TDLLUnRegisterServer = Function: HResult; Stdcall;
 TDllCanUnloadNow = function: HResult; stdcall;
 TRegisterAs = (raGeneral, raVisual, raCMLx, raUnknown);
 EInUse = Class(Exception);

 TRegisterTools = Class(TObject)
 private
  Function RegisterServer(DLL: String; Var ComType: String): Boolean;
  Function UnRegisterServer(DLL: String): Boolean;
  Function CanUnloadNow(DLL: String): Boolean;
  Function InstallAsGeneral(GUID: TGUID; Filename: String; COMType: String): boolean;
  Function InstallAsVisual(GUID: TGUID; Filename: String; COMType: String): Boolean;
  Function InstallAsCMLEx(GUID: TGUID; Filename: String; COMType: String): boolean;
  Function DetermineRA(GUID: TGUID; VAR SupportsAU: Boolean): TRegisterAs;
  Function SupportsAU(GUID: TGUID; Var UpdateFile: String): Boolean;
  function WriteToRegistry(GUID: TGUID; Location: String; Name: String;
    Filename: string; ComType: String; RequiredCoreVersion, Version: Word): Boolean;
{  Function IsGen(GUID: TGUID): Boolean;
  Function IsVis(GUID: TGUID): Boolean;
  Function IsCMLx(GUID: TGUID): Boolean;
  Function IsAU(GUID: TGUID): Boolean; }
 public
  Function InstallPlugIn(Filename: String; Var RegisterAs: TRegisterAs): Boolean;
  Function UninstallPlugIn(Filename: String): Boolean; overload;
  Function UninstallPlugIn(GUID: TGUID): boolean; overload;
  Function GetGUID(DLLFilename: String; VAR GUID: TGUID): Boolean;
 End;

implementation

uses
  Dialogs; //, dll_dyn_intf;

Function PathToOk(APath: String): String;
Begin
 If APath = '' Then begin
  Result := APath;
  Exit;
 End;
 If APath[length(APath)] <> '\' Then APath := APath + '\';
 Result := APath;
End;

{ TRegisterTools }

Function TRegisterTools.RegisterServer(DLL: String; Var ComType: String): Boolean;
Var
 Handle: THandle;
 DLLRegisterServer: TDLLRegisterServer;
Begin
 Result := False;
 Handle := Loadlibrary(Pchar(DLL));
 If Handle = 0 Then exit;
 @DLLRegisterServer := GetProcAddress(handle, PChar('DllRegisterServer'));
 If @DLLRegisterServer = nil then begin
  FreeLibrary(handle);
  // It's probably a .NETCOM
{  If dotNET_RegisterPlugin(ExtractFilepath(Application.ExeName), Pchar(DLL)) <> S_OK then begin
   MessageDlg('Unknown DLL type or .NETCom support not installed', mtError, [mbOK], 0);
   Result := false;
   exit;
  end;
  Result := True;
  COMType := '.NETCOM';}
  Result := False;
  exit;
 end;
 Case DLLRegisterServer of
  S_OK: Result := True;
  E_FAIL: Result := False;
 End;
 COMType := 'win32COM';
 FreeLibrary(Handle);
End;

Function TRegisterTools.UnRegisterServer(DLL: String): Boolean;
Var
 Handle: THandle;
 DLLUnRegisterServer: TDLLUnRegisterServer;
Begin
 Result := False;
 Handle := Loadlibrary(Pchar(DLL));
 If Handle = 0 Then exit;
 @DLLUnRegisterServer := GetProcAddress(handle, PChar('DllUnregisterServer'));
 If @DLLUnRegisterServer = nil then begin
  FreeLibrary(handle);
  exit;
 end;
 Case DLLUnRegisterServer of
  S_OK: Result := True;
  E_FAIL: Result := False;
 End;
 FreeLibrary(Handle);
End;

Function TRegisterTools.CanUnloadNow(DLL: String): Boolean;
Var
 Handle: THandle;
 DllCanUnloadNow: TDllCanUnloadNow;
Begin
 Result := False;
 Handle := Loadlibrary(Pchar(DLL));
 If Handle = 0 Then exit;
 @DllCanUnloadNow := GetProcAddress(handle, PChar('DllCanUnloadNow'));
 If @DllCanUnloadNow = nil then begin
  FreeLibrary(handle);
  exit;
 end;
 Case DllCanUnloadNow of
  S_OK: Result := True;
  E_FAIL: Result := False;
 End;
 FreeLibrary(Handle);
End;

function TRegisterTools.InstallPlugIn(Filename: String; Var RegisterAs: TRegisterAs): Boolean;
Var
 GUID: TGUID;
 CT: String;
 AUSupport: Boolean;
begin
 Result := False;
 If not fileexists(filename) then exit;
 Result := RegisterServer(Filename, CT);
 If not result then begin
  MessageDlg('Installing the COM object failed', mtError, [mbOK], 0);
  exit;
 end;
 If Not GetGUID(Filename, GUID) then begin
  UnRegisterServer(Filename);
  Result := FAlse;
  exit;
 End;
 If Result Then begin
  RegisterAs := DetermineRA(GUID, AUSupport);
  Case RegisterAs of
   raGeneral: Result := InstallAsGeneral(GUID, Filename, CT);
   raVisual: Result := InstallAsVisual(GUID, Filename, CT);
   raCMLx: Result := InstallAsCMLEx(GUID, Filename, CT);
   else Result := False;
  End;
 End;
end;

Function TRegisterTools.UninstallPlugIn(Filename: String): Boolean;
Var
 Reg: TRegistry;
 GUID: TGUID;
begin
 Result := False;
 If Not CanUnloadNow(filename) then exit;
 If not GetGUID(Filename, GUID) then exit;
 Result := UnRegisterServer(Filename);
 Reg := TRegistry.Create;
 If REg.OpenKey(CertifiedGENPlugInsLocation, True) Then begin
  If REg.KeyExists(GUIDToString(GUID)) then Reg.DeleteKey(GUIDToString(GUID));
 End;
 If Reg.OpenKey(CertifiedVISPlugInsLocation, True) Then begin
  If Reg.KeyExists(GUIDToString(GUID)) Then Reg.DeleteKey(GUIDToString(GUID));
 End;
 If Reg.OpenKey(CertifiedCMLXPlugInsLocation, true) then begin
  If Reg.KeyExists(GUIDToString(GUID)) Then Reg.DeleteKey(GUIDToString(GUID));
 end;
 Reg.Free;
end;

function TRegisterTools.GetGUID(DLLFilename: String; VAR GUID: TGUID): Boolean;
Var
 Str: TStrings;
 Reg: TRegistry;
 S, LS: String;
 I: Integer;
begin
 Result := False;
 LS := ExtractShortPathName(DLLFilename);
 Reg := TREgistry.Create;
 Reg.RootKey := HKEY_CLASSES_ROOT;
 If not Reg.OpenKey('CLSID', False) then begin
  exit;
 End;
 Str := TStringList.Create;
 Reg.GetKeyNames(Str);
 For I := 0 to Str.count - 1 do begin
  If Reg.OpenKey('\CLSID\' + Str[I] + '\InProcServer32', False) Then begin
   S := ExtractShortPathName(Reg.ReadString(''));
   If uppercase(LS) = uppercase(S) Then begin
    GUID := StringToGuid(Str[I]);
    Result := True;
    Str.Free;
    Reg.Free;
    exit;
   End;
  End;
 End;
 Reg.Free;
 Str.Free;
end;

function TRegisterTools.UninstallPlugIn(GUID: TGUID): boolean;
Var
 Reg: TRegistry;
 Filename: String;
begin
 Result := False;
 Reg := TRegistry.Create;
 Reg.RootKey := HKEY_CLASSES_ROOT;
 if not Reg.OpenKey('\CLSID\' + GUIDToString(GUID) + '\InProcServer32', false) then begin
  reg.free;
  exit;
 end;
 Filename := Reg.ReadString('');
 If Not SElf.CanUnloadNow(filename) then begin
  Raise EInUse.Create('Cannot uninstall plugin - The plugin is in use');
  reg.free;
  exit;
 end;
 If not SElf.GetGUID(Filename, GUID) then begin
  reg.free;
  exit;
 end;
 Result := SElf.UnRegisterServer(Filename);
 Reg.RootKey := HKEY_CURRENT_USER;
 If Reg.OpenKey(CertifiedGENPluginsLocation, false) then begin
  If Reg.KeyExists(GUIDToString(GUID)) then begin
   Reg.DeleteKey(GUIDToString(GUID));
  End
 end;
 If Reg.OpenKey(CertifiedVISPluginsLocation, false) then begin
  If Reg.KeyExists(GUIDToString(GUID)) then begin
   Reg.DeleteKey(GUIDToString(GUID));
  End
 end;
 If Reg.OpenKey(CertifiedCMLXPluginsLocation, false) then begin
  If Reg.KeyExists(GUIDToString(GUID)) then begin
   Reg.DeleteKey(GUIDToString(GUID));
  End
 end;
 FreeAndNil(Reg);
end;

function TRegisterTools.DetermineRA(GUID: TGUID; VAR SupportsAU: Boolean): TRegisterAs;
Var
 GP: ICM2GenPlug;
 VP: ICM2VisPlug;
 VP2: ICM2VisPlug2;
 VP3: ICM2VisPlug3;
 VP4: ICM2VisPlug4;
 CP: ICM2CMLxPlug;
 CP2: ICM2CMLxPlug2;
begin
 Result := raUnknown;
 Try
  GP := CreateCOMObject (GUID) as ICM2GenPlug;
  Result := raGeneral;
 except
  on EIntfCastError do begin
   Try
    VP4 := CreateCOMObject (GUID) as ICM2VisPlug4;
    Result := raVisual;
   except
    On EIntfCastError do begin
     Try
      VP3 := CreateCOMObject (GUID) as ICM2VisPlug3;
      Result := raVisual;
     except
      On EIntfCastError do begin
       Try
        VP2 := CreateCOMObject (GUID) as ICM2VisPlug2;
        Result := raVisual;
       except
        On EIntfCastError do begin
         Try
          VP := CreateCOMObject (GUID) as ICM2VisPlug;
          Result := raVisual;
         except
          On EIntfCastError do begin
           Try
            CP2 := CreateCOMObject (GUID) as ICM2CMLxPlug2;
            Result := raCMLx;
           except
            On EIntfCastError do begin
             Try
              CP := CreateCOMObject (GUID) as ICM2CMLxPlug;
              Result := raCMLx;
             except
              On EIntfCastError do begin

              end;
             end;
            end;
           end;
          end;
         end;
        end;
       end;
      end;
     end;
    end;
   End;
  end;
 end;
end;

function TRegisterTools.InstallAsCMLEx(GUID: TGUID;
  Filename: String; COMType: String): boolean;
var
 PlugCMLx: ICM2CMLxPlug;
 PlugCMLx2: ICM2CMLxPlug2;
 Name: PChar;
 Version, RCV: Word;
 Location: String;
 InterfaceType: Byte;
begin
 Result := True;
 Try
  PlugCMLx2 := CreateCOMObject (GUID) as ICM2CMLxPlug2;
  InterfaceType := 2;
 except
  On EIntfCastError do begin
   PlugCMLx := CreateCOMObject (GUID) as ICM2CMLxPlug;
   InterfaceType := 1;
  end;
 end;
 Case InterfaceType of
  1: Begin
      If PlugCMLx.Name(Name) = E_FAIL Then Name := '';
      If PlugCMLx.RequiredCoreVersion(RCV) = E_FAIL Then RCV := 0;
      If PlugCMLx.Version(Version) = E_FAIL Then Version := 0;
     end;
  2: Begin
      If PlugCMLx2.Name(Name) = E_FAIL Then Name := '';
      If PlugCMLx2.RequiredCoreVersion(RCV) = E_FAIL Then RCV := 0;
      If PlugCMLx2.Version(Version) = E_FAIL Then Version := 0;
     end;
 end;
 Location := CertifiedCMLxPlugInsLocation;
 WriteToRegistry(GUID, Location, Name, Filename, ComType, RCV, Version);
end;

function TRegisterTools.InstallAsGeneral(GUID: TGUID;
  Filename: String; COMType: String): boolean;
Var
 PlugGen: ICM2GENPLUG;
 Name: PChar;
 Version, RCV: Word;
 Location: String;
begin
 Result := true;
 PlugGen := CreateCOMObject (GUID) as ICM2GenPlug;
 If PlugGen.Name(Name) = E_FAIL Then Name := '';
 If PlugGen.RequiredCoreVersion(RCV) = E_FAIL Then RCV := 0;
 If PlugGen.Version(Version) = E_FAIL Then Version := 0;
 Location := CertifiedGENPlugInsLocation;
 WriteToRegistry(GUID, Location, Name, Filename, ComType, RCV, Version);
end;

function TRegisterTools.InstallAsVisual(GUID: TGUID;
  Filename: String; COMType: String): Boolean;
Var
 PlugVis: ICM2VISPLUG;
 PlugVis2: ICM2VisPlug2;
 PlugVis3: ICM2VisPlug3;
 PlugVis4: ICM2VisPlug4;
 Name: PChar;
 Version, RCV: Word;
 Location: String;
 InterfaceType: Byte;
begin
 InterfaceType := 0;
 Result := True;
 Try
  PlugVis := CreateCOMObject (GUID) as ICM2VisPlug;
  InterfaceType := 1;
 Except
  on EIntfCastError do begin
   Try
    PlugVis2 := CreateCOMObject (GUID) as ICM2VisPlug2;
    InterfaceType := 2;
   except
    On EIntfCastError do begin
     try
      PlugVis3 := CreateCOMObject (GUID) as ICM2VisPlug3;
      InterfaceType := 3;
     except
      On EIntfCastError do begin
       try
        PlugVis4 := CreateComObject (GUID) as ICM2VisPlug4;
        InterfaceType := 4;
       except
        Result := false;
       end;
      end;
     end;
    end;
   end;
  end;
 end;
 If Result then begin
  Case InterfaceType of
   1: begin
       If PlugVis.Name(Name) = E_FAIL Then Name := '';
       If PlugVis.RequiredCoreVersion(RCV) = E_FAIL Then RCV := 0;
       If PlugVis.Version(Version) = E_FAIL Then Version := 0;
      End;
   2: Begin
       If PlugVis2.Name(Name) = E_FAIL Then Name := '';
       If PlugVis2.RequiredCoreVersion(RCV) = E_FAIL Then RCV := 0;
       If PlugVis2.Version(Version) = E_FAIL Then Version := 0;
      end;
   3: Begin
       If PlugVis3.Name(Name) = E_FAIL Then Name := '';
       If PlugVis3.RequiredCoreVersion(RCV) = E_FAIL Then RCV := 0;
       If PlugVis3.Version(Version) = E_FAIL Then Version := 0;
      End;
   4: Begin
       If PlugVis4.Name(Name) = E_FAIL Then Name := '';
       If PlugVis4.RequiredCoreVersion(RCV) = E_FAIL Then RCV := 0;
       If PlugVis4.Version(Version) = E_FAIL Then Version := 0;
      End;
  end;
  Location := CertifiedVISPlugInsLocation;
  WriteToRegistry(GUID, Location, Name, Filename, ComType, RCV, Version);
 end;
end;

function TRegisterTools.WriteToRegistry(GUID: TGUID; Location: String;
  Name: String; Filename: string; ComType: String; RequiredCoreVersion,
  Version: Word): Boolean;
Var
 Reg: TRegistry;
 updFile: String;
begin
 Result := True;
 try
  Reg := TRegistry.Create;
  Reg.OpenKey(Location, True);
  Reg.OpenKey(PathToOK(Location) + GUIDToString(GUID), True);
  Reg.WriteString('', Name);
  Reg.WriteInteger('RequiredCoreVersion', RequiredCoreVersion);
  Reg.WriteInteger('Version', Version);
  Reg.WriteString('Filename', Filename);
  Reg.WriteString('COMType', ComType);
  If SupportsAU(GUID, updFile) then
   Reg.WriteString('updatefile', updFile);
  FreeAndNil(Reg);
 except
  Result := false;
 end;
end;

function TRegisterTools.SupportsAU(GUID: TGUID;
  var UpdateFile: String): Boolean;
var
 PlugAutoUpdate: ICM2AutoUpdate;
 pc: pChar;
begin
 Result := true;
 Try
  PlugAutoUpdate := CreateCOMObject(GUID) as ICM2AUTOUPDATE;
  If PlugAutoUpdate.UpdateFileURL(pc) = E_FAIL Then UpdateFile := ''
   else UpdateFile := pc;
 except
  On EIntfCastError do begin
   Result := False;
  End;
 End;

end;
{
function TRegisterTools.IsCMLx(GUID: TGUID): Boolean;
Var
 CP: ICM2CMLxPlug;
begin
 Result := true;
 Try
  CP := CreateCOMObject (GUID) as ICM2CMLxPlug;
 Except
  On EIntfCastError do begin
   Result := false;
  end;
 end;
end;

function TRegisterTools.IsGen(GUID: TGUID): Boolean;
Var
 GP: ICM2GenPlug;
begin
 Result := true;
 Try
  GP := CreateCOMobject (GUID) as ICM2GenPlug;
 except
  On EIntfCastError do begin
   Result := false;
  end;
 end;
end;

function TRegisterTools.IsVis(GUID: TGUID): Boolean;
Var
 VP: ICM2VisPlug;
 VP2: ICM2VisPlug2;
 VP3: ICM2VisPlug3;
begin
 Result := True;
 Try
  VP3 := CreateCOMObject (GUID) as ICM2VisPlug3;
 except
  On EIntfCastError do begin
   Try
    VP2 := CreateCOMObject (GUID) as ICM2VisPlug2;
   except
    On EIntfCastError do begin
     Try
      VP := CreateCOMObject (GUID) as ICM2VisPlug;
     Except
      On EIntfCastError do begin
       Result := false;
      end;
     End;
    end;
   End;
  end;
 End;
end;

function TRegisterTools.IsAU(GUID: TGUID): Boolean;
Var
 AU: ICM2AutoUpdate;
begin
 Result := true;
 Try
  AU := CreateCOMObject (GUID) as ICM2AutoUpdate;
 except
  On EIntfCastError do begin
   Result := False;
  end;
 end;
end;
  }
end.
