Registry-free COM loader (Redemption.dll full sample)

Share your advanced PureBasic knowledge/code with the community.
Post Reply
franchsesko
User
User
Posts: 13
Joined: Sat Jun 02, 2018 4:45 pm

Registry-free COM loader (Redemption.dll full sample)

Post by franchsesko »

Hi,

If you use 3rd party ActiveX (ie COM) DLLs, or your own, and you want to distribute them without having to register them on the target system (no regsvr32), you can use this technique.
The idea is to write an intermediate DLL that'll create the ActiveX objects for you and return you a reference on the instance or one of its interfaces.
As explained a bit more here http://www.dimastr.com/redemption/secur ... tionloader

So the trick is to instantiate the object from the DLL and get it back in VB via an exported function like this (for redemption):

VB:

Code: Select all

  Option Explicit

  Private Declare Function SetDLLLocation32Bit Lib "RedemptionLoader.dll" (ByVal plFilename As Long) As Integer
  Private Declare Function new_RDOSession Lib "RedemptionLoader.dll" () As RDOSession
  Private Declare Function new_SafeMailItem Lib "RedemptionLoader.dll" () As SafeMailItem
  Private Declare Function new_SafeContactItem Lib "RedemptionLoader.dll" () As SafeContactItem
  Private Declare Function new_SafeAppointmentItem Lib "RedemptionLoader.dll" () As SafeAppointmentItem
  Private Declare Function new_SafeTaskItem Lib "RedemptionLoader.dll" () As SafeTaskItem
  Private Declare Function new_SafeJournalItem Lib "RedemptionLoader.dll" () As SafeJournalItem
  Private Declare Function new_SafeMeetingItem Lib "RedemptionLoader.dll" () As SafeMeetingItem
  Private Declare Function new_SafePostItem Lib "RedemptionLoader.dll" () As SafePostItem
  Private Declare Function new_SafeReportItem Lib "RedemptionLoader.dll" () As SafeReportItem
  Private Declare Function new_SafeMAPIFolder Lib "RedemptionLoader.dll" () As MAPIFolder
  Private Declare Function new_SafeCurrentUser Lib "RedemptionLoader.dll" () As SafeCurrentUser
  Private Declare Function new_SafeDistList Lib "RedemptionLoader.dll" () As SafeDistList
  Private Declare Function new_AddressLists Lib "RedemptionLoader.dll" () As AddressLists
  Private Declare Function new_MAPITable Lib "RedemptionLoader.dll" () As MAPITable
  Private Declare Function new_MAPIUtils Lib "RedemptionLoader.dll" () As MAPIUtils
  Private Declare Function new_SafeInspector Lib "RedemptionLoader.dll" () As SafeInspector
  Private Declare Function new_SafeExplorer Lib "RedemptionLoader.dll" () As SafeExplorer

  Sub Main()
    Dim oSess As Redemption.RDOSession
    Dim oMail As Redemption.SafeMailItem
    
    'The purebasic loader dll (RedemptionLoader.dll) is with the EXE
    ChDir App.Path
    SetDLLLocation32Bit StrPtr("c:\<your path>\Redemption.dll")
    
    Set oSess = new_RDOSession()  'That's it, instead of Set oSess = New RDOSession
    oSess.LogonHostedExchangeMailbox "john.doe@example.com", "john.doe@example.com", "nomoresecrets"
    
    Dim oUtils As Redemption.MAPIUtils
    
    Set oUtils = new_MAPIUtils()
    
    '... use the objects as usual
  End Sub
Notes:
  • On the developer machine you still have to register the mother DLL (Redemption.dll) for this to work in VB.

    This is a port of the sample C++ loader that ships with Redemption (I asked for permission to publish my port).

    In languages like C++, you can probably apply the technique directly without needing an intermediate DLL.

    No licence attached on this code (public domain, no warranties).
C++ to Purebasic translation

In C++

Code: Select all

Redemption::ISafeMailItem* RedemptionLoader::new_SafeMailItem()
 {
	 return __NewRedemptionObject<Redemption::ISafeMailItem>(__uuidof(Redemption::SafeMailItem));
 }
In PureBasic

Code: Select all

ProcedureDLL.i new_SafeMailItem()
  ProcedureReturn __NewRedemptionObject(?CLSID_SafeMailItem, ?IID_ISafeMailItem)
EndProcedure
Basically, I had to go and get the COM class and interface UUIDs with oleview.exe and slightly change the __NewRedemptionObject function.
Note: The same technique can be used to wrap any other ActiveX class library.

How to use it in VB
I did some (quite light) testing with this code, in VB (create a module, put the DLL declare's above) :

Code: Select all

Option Explicit

' Insert the previous "declare"s here

Sub Main()
  Dim oSess As Redemption.RDOSession
  Dim oMail As Redemption.SafeMailItem
  
  'The purebasic loader dll (RedemptionLoader.dll) is with the EXE
  ChDir App.Path
  SetDLLLocation32Bit StrPtr("c:\<your path>\Redemption.dll")
  
  Set oSess = new_RDOSession()  'That's it, instead of Set oSess = New RDOSession
  oSess.LogonHostedExchangeMailbox "john.doe@example.com", "john.doe@example.com", "nomoresecrets"
  
  Dim oUtils As Redemption.MAPIUtils
  
  Set oUtils = new_MAPIUtils()
  
  Stop  '... use the objects as usual, debug via Debug/immediate Window
  
End Sub
And the PB source to generate the wrapper/loader DLL.

Code: Select all

EnableExplicit

Macro SUCCEEDED(HRESULT)
  HRESULT & $80000000 = 0
EndMacro

Macro FAILED(HRESULT)
  HRESULT & $80000000
EndMacro

Global CSInitialized.l
Global CS.CRITICAL_SECTION
Global.i DLLHandle
Global.s DLLLocation32Bit, DLLLocation64Bit

Prototype.w DllGetClassObjectFunc(*REFCLSID.CLSID, *REFIID.IID, *p)

Procedure CheckInitialize()
  If CSInitialized=0
    CSInitialized = 1
    InitializeCriticalSection_(@CS)
    EnterCriticalSection_(@CS)
    DLLHandle = 0
    LeaveCriticalSection_(@CS)
  EndIf
EndProcedure
  
; -----------------------------------------------------------------------------
;
; DLL Attach / Detach
;
; -----------------------------------------------------------------------------

ProcedureDLL AttachProcess(Instance)
  CheckInitialize()
EndProcedure
 
ProcedureDLL DetachProcess(Instance)
  EnterCriticalSection_(@CS)
  OnErrorGoto(?DetachErr)
  If DLLHandle
    FreeLibrary_(DLLHandle)
  EndIf
DetachErr:
  LeaveCriticalSection_(@CS)
  DeleteCriticalSection_(@CS)
EndProcedure

; -----------------------------------------------------------------------------
;
; Wrap COM object creation
;
; -----------------------------------------------------------------------------

Procedure.i Rinstr(psText.s, psFindWhat.s)
  Protected.i iPos, iFind
  iPos = FindString(psText, psFindWhat)
  While iPos > 0
    iFind = iPos
    iPos = FindString(psText, psFindWhat, iPos+1)
  Wend
  ProcedureReturn iFind
EndProcedure

Procedure.i NewRedemptionObject(*pCLSID.GUID)
  Protected *result.IUnknown
  Protected.i res ;HRESULT
  Protected.s sPath, sDLLName
  Protected.i iLen, iPos
  Protected *pGetClassObject.DllGetClassObjectFunc
  Protected *pIIFactory.IClassFactory
  Protected sFuncName.s
  
  CheckInitialize()
  EnterCriticalSection_(@CS)
  If DLLHandle = 0
    If (Len(DLLLocation32Bit)=0) Or (Len(DLLLocation64Bit)=0)
      sPath = Space(#MAX_PATH)
      iLen = GetModuleFileName_(0, @sPath, #MAX_PATH)
      If iLen>0
        iPos = Rinstr(sPath, "\")
        If iPos > 0
          sPath = Left(sPath, iPos)
        Else
          sPath = ""
        EndIf
        If Len(DLLLocation32Bit)=0
          DLLLocation32Bit = sPath + "redemption.dll"
        EndIf
        If Len(DLLLocation64Bit)=0
          DLLLocation64Bit = sPath + "redemption64.dll"
        EndIf
      EndIf
    EndIf
    
    CompilerIf #PB_Processor_x86
      sDLLName = DLLLocation32Bit
    CompilerElse
      sDLLName = DLLLocation64Bit
    CompilerEndIf
    
    DLLHandle = LoadLibrary_(sDLLName)
  EndIf
  
  If DLLHandle
    sFuncName = Space(1024)
    WideCharToMultiByte_(#CP_ACP, 0, @"DllGetClassObject", -1, @sFuncName, 1024, #Null, #Null)
    *pGetClassObject = GetProcAddress_(DLLHandle, sFuncName)
    If *pGetClassObject
      res = *pGetClassObject(*pCLSID, ?IID_IClassFactory, @*pIIFactory)
      If SUCCEEDED(res)
        res = *pIIFactory\CreateInstance(#Null, ?IID_IUnknown, @*result)
      EndIf
    EndIf
  EndIf
  
  LeaveCriticalSection_(@CS)
  ProcedureReturn *result  
EndProcedure

Procedure.i __NewRedemptionObject(*pCLSID.GUID, *pIID.iid)
  Protected *pUnk.IUnknown
  Protected *res = #Null
  *pUnk = NewRedemptionObject(*pCLSID)
  If *pUnk
    *pUnk\QueryInterface(*pIID, @*res)
  EndIf
  ProcedureReturn *res
EndProcedure

; -----------------------------------------------------------------------------
;
; DLL API
;
; -----------------------------------------------------------------------------

ProcedureDLL.w SetDLLLocation32Bit(psPath.s)
  CheckInitialize()
  EnterCriticalSection_(@CS)
  DLLLocation32Bit = psPath
  LeaveCriticalSection_(@CS)
EndProcedure

ProcedureDLL.w SetDLLLocation64Bit(psPath.s)
  CheckInitialize()
  EnterCriticalSection_(@CS)
  DLLLocation64Bit = psPath
  LeaveCriticalSection_(@CS)
EndProcedure

ProcedureDLL.i new_RDOSession()
  ProcedureReturn __NewRedemptionObject(?CLSID_RDOSession, ?IID_IRDOSession)
EndProcedure

ProcedureDLL.i new_SafeMailItem()
  ProcedureReturn __NewRedemptionObject(?CLSID_SafeMailItem, ?IID_ISafeMailItem)
EndProcedure

ProcedureDLL.i new_SafeContactItem()
  ProcedureReturn __NewRedemptionObject(?CLSID_SafeContactItem, ?IID_ISafeContactItem)
EndProcedure

ProcedureDLL.i new_SafeAppointmentItem()
  ProcedureReturn __NewRedemptionObject(?CLSID_SafeAppointmentItem, ?IID_ISafeAppointmentItem)
EndProcedure

ProcedureDLL.i new_SafeTaskItem()
  ProcedureReturn __NewRedemptionObject(?CLSID_SafeTaskItem, ?IID_ISafeTaskItem)
EndProcedure

ProcedureDLL.i new_SafeJournalItem()
  ProcedureReturn __NewRedemptionObject(?CLSID_SafeJournalItem, ?IID_ISafeJournalItem)
EndProcedure

ProcedureDLL.i new_SafeMeetingItem()
  ProcedureReturn __NewRedemptionObject(?CLSID_SafeMeetingItem, ?IID_ISafeMeetingItem)
EndProcedure

ProcedureDLL.i new_SafePostItem()
  ProcedureReturn __NewRedemptionObject(?CLSID_SafePostItem, ?IID_ISafePostItem)
EndProcedure

ProcedureDLL.i new_SafeReportItem()
  ProcedureReturn __NewRedemptionObject(?CLSID_SafeReportItem, ?IID_ISafeReportItem)
EndProcedure

ProcedureDLL.i new_SafeMAPIFolder()
  ProcedureReturn __NewRedemptionObject(?CLSID_MAPIFolder, ?IID_ISafeMAPIFolder)
EndProcedure

ProcedureDLL.i new_SafeCurrentUser()
  ProcedureReturn __NewRedemptionObject(?CLSID_SafeCurrentUser, ?IID_ISafeCurrentUser)
EndProcedure

ProcedureDLL.i new_SafeDistList()
  ProcedureReturn __NewRedemptionObject(?CLSID_SafeDistList, ?IID_ISafeDistList)
EndProcedure

ProcedureDLL.i new_AddressLists()
  ProcedureReturn __NewRedemptionObject(?CLSID_AddressLists, ?IID_IAddressLists)
EndProcedure

ProcedureDLL.i new_MAPITable()
  ProcedureReturn __NewRedemptionObject(?CLSID_MAPITable, ?IID_IMAPITable)
EndProcedure

ProcedureDLL.i new_MAPIUtils()
  ProcedureReturn __NewRedemptionObject(?CLSID_MAPIUtils, ?IID_IMAPIUtils)
EndProcedure

ProcedureDLL.i new_SafeInspector()
  ProcedureReturn __NewRedemptionObject(?CLSID_SafeInspector, ?IID_ISafeInspector)
EndProcedure

ProcedureDLL.i new_SafeExplorer()
  ProcedureReturn __NewRedemptionObject(?CLSID_SafeExplorer, ?IID_ISafeExplorer)
EndProcedure

; -----------------------------------------------------------------------------
;
; Data sections
;
; -----------------------------------------------------------------------------

DataSection
  
  IID_IUnknown: ; {00000000-0000-0000-C000-000000000046}
  Data.l $00000000
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46
  
  IID_IDispatch: ; {00020400-0000-0000-C000-000000000046}
  Data.l $00020400
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46
  
  IID_IDispatchEx: ; {A6EF9860-C720-11D0-9337-00A0C90DCAA9}
  Data.l $A6EF9860
  Data.w $C720, $11D0
  Data.b $93, $37, $00, $A0, $C9, $0D, $CA, $A9
  
  IID_IClassFactory: ; {00000001-0000-0000-C000-000000000046}
  Data.l $00000001
  Data.w $0000,$0000
  Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  
  IID_IClassFactoryEx: ; {342D1EA0-AE25-11D1-89C5-006008C3FBFC}
  Data.l $342D1EA0
  Data.w $AE25,$11D1
  Data.b $89,$C5,$00,$60,$08,$C3,$FB,$FC
  
  ;Redemption CLSIDs and IIDs
  
  CLSID_RDOSession: ;uuid(29AB7A12-B531-450E-8F7A-EA94C2F3C05F)
  Data.l $29AB7A12
  Data.w $B531,$450E
  Data.b $8F,$7A,$EA,$94,$C2,$F3,$C0,$5F
  
  CLSID_SafeMailItem: ;uuid(741BEEFD-AEC0-4AFF-84AF-4F61D15F5526),
  Data.l $741BEEFD
  Data.w $AEC0,$4AFF
  Data.b $84,$AF,$4F,$61,$D1,$5F,$55,$26
  
  CLSID_SafeContactItem: ;uuid(4FD5C4D3-6C15-4EA0-9EB9-EEE8FC74A91B)
  Data.l $4FD5C4D3
  Data.w $6C15, $4EA0
  Data.b $9E,$B9,$EE,$E8,$FC,$74,$A9,$1B
  
  CLSID_SafeAppointmentItem: ;uuid(620D55B0-F2FB-464E-A278-B4308DB1DB2B)
  Data.l $620D55B0
  Data.w $F2FB,$464E
  Data.b $A2,$78,$B4,$30,$8D,$B1,$DB,$2B
  
  CLSID_SafeTaskItem: ;uuid(7A41359E-0407-470F-B3F7-7C6A0F7C449A)
  Data.l $7A41359E
  Data.w $0407,$470F
  Data.b $B3,$F7,$7C,$6A,$0F,$7C,$44,$9A
  
  CLSID_SafeJournalItem: ;uuid(C5AA36A1-8BD1-47E0-90F8-47E7239C6EA1)
  Data.l $C5AA36A1
  Data.w $8BD1,$47E0
  Data.b $90,$F8,$47,$E7,$23,$9C,$6E,$A1
  
  CLSID_SafeMeetingItem: ;uuid(FA2CBAFB-F7B1-4F41-9B7A-73329A6C1CB7)
  Data.l $FA2CBAFB
  Data.w $F7B1,$4F41
  Data.b $9B,$7A,$73,$32,$9A,$6C,$1C,$B7
  
  CLSID_SafePostItem: ;uuid(11E2BC0C-5D4F-4E0C-B438-501FFE05A382)
  Data.l $11E2BC0C
  Data.w $5D4F,$4E0C
  Data.b $B4,$38,$50,$1F,$FE,$05,$A3,$82
  
  CLSID_SafeReportItem: ;uuid(D46BA7B2-899F-4F60-85C7-4DF5713F6F18)
  Data.l $D46BA7B2
  Data.w $899F,$4F60
  Data.b $85,$C7,$4D,$F5,$71,$3F,$6F,$18
  
  CLSID_MAPIFolder: ;uuid(03C4C5F4-1893-444C-B8D8-002F0034DA92)
  Data.l $03C4C5F4
  Data.w $1893,$444C
  Data.b $B8,$D8,$00,$2F,$00,$34,$DA,$92
  
  CLSID_SafeCurrentUser: ;uuid(7ED1E9B1-CB57-4FA0-84E8-FAE653FE8E6B)
  Data.l $7ED1E9B1
  Data.w $CB57,$4FA0
  Data.b $84,$E8,$FA,$E6,$53,$FE,$8E,$6B
  
  CLSID_SafeDistList: ;uuid(7C4A630A-DE98-4E3E-8093-E8F5E159BB72)
  Data.l $7C4A630A
  Data.w $DE98,$4E3E
  Data.b $80,$93,$E8,$F5,$E1,$59,$BB,$72
  
  CLSID_AddressLists: ;uuid(37587889-FC28-4507-B6D3-8557305F7511)
  Data.l $37587889
  Data.w $FC28,$4507
  Data.b $B6,$D3,$85,$57,$30,$5F,$75,$11
  
  CLSID_MAPITable: ;uuid(A6931B16-90FA-4D69-A49F-3ABFA2C04060)
  Data.l $A6931B16
  Data.w $90FA,$4D69
  Data.b $A4,$9F,$3A,$BF,$A2,$C0,$40,$60
  
  CLSID_MAPIUtils: ;uuid(4A5E947E-C407-4DCC-A0B5-5658E457153B)
  Data.l $4A5E947E
  Data.w $C407,$4DCC
  Data.b $A0,$B5,$56,$58,$E4,$57,$15,$3B
  
  CLSID_SafeInspector: ;uuid(ED323630-B4FD-4628-BC6A-D4CC44AE3F00)
  Data.l $ED323630
  Data.w $B4FD,$4628
  Data.b $BC,$6A,$D4,$CC,$44,$AE,$3F,$00
  
  CLSID_SafeExplorer: ;uuid(C3B05695-AE2C-4FD5-A191-2E4C782C03E0)
  Data.l $C3B05695
  Data.w $AE2C,$4FD5
  Data.b $A1,$91,$2E,$4C,$78,$2C,$03,$E0
  
  ; Interface IDs
  IID_IRDOSession: ;uuid(E54C5168-AA8C-405F-9C14-A4037302BD9D),
  Data.l $E54C5168
  Data.w $AA8C,$405F
  Data.b $9C,$14,$A4,$03,$73,$02,$BD,$9D
  
  IID_ISafeMailItem: ;uuid(0A95BE2D-1543-46BE-AD6D-18653034BF87),
  Data.l $0A95BE2D
  Data.w $1543,$46BE
  Data.b $AD,$6D,$18,$65,$30,$34,$BF,$87
  
  IID_ISafeContactItem: ;uuid(3120A5E4-552D-4EDF-8C48-70C5D5FF22D2),
  Data.l $3120A5E4
  Data.w $552D,$4EDF
  Data.b $8C,$48,$70,$C5,$D5,$FF,$22,$D2
  
  IID_ISafeAppointmentItem: ;uuid(35EFAD55-134A-47BF-912A-44A9D9FD556F),
  Data.l $35EFAD55
  Data.w $134A,$47BF
  Data.b $91,$2A,$44,$A9,$D9,$FD,$55,$6F
  
  IID_ISafeTaskItem: ;uuid(F961CE9D-AE2B-4CFB-887C-3A055FF685C9),
  Data.l $F961CE9D
  Data.w $AE2B,$4CFB
  Data.b $88,$7C,$3A,$05,$5F,$F6,$85,$C9
  
  IID_ISafeJournalItem: ;uuid(E3EC74BB-5522-462D-A00F-2728C53FCA04),
  Data.l $E3EC74BB
  Data.w $5522,$462D
  Data.b $A0,$0F,$27,$28,$C5,$3F,$CA,$04
  
  IID_ISafeMeetingItem: ;uuid(F7919641-3978-4668-8388-7310329C800E),
  Data.l $F7919641
  Data.w $3978,$4668
  Data.b $83,$88,$73,$10,$32,$9C,$80,$0E
  
  IID_ISafePostItem: ;uuid(6A5D680A-8F9F-4752-A056-2C0273F60B4E),
  Data.l $6A5D680A
  Data.w $8F9F,$4752
  Data.b $A0,$56,$2C,$02,$73,$F6,$0B,$4E
  
  IID_ISafeReportItem: ;uuid(03C3860D-86B7-4F36-924C-3B1AD93B4C79),
  Data.l $03C3860D
  Data.w $86B7,$4F36
  Data.b $92,$4C,$3B,$1A,$D9,$3B,$4C,$79
  
  IID_ISafeMAPIFolder: ;uuid(31CE2164-4D5C-4508-BCA7-B10E11D08E6B),
  Data.l $31CE2164
  Data.w $4D5C,$4508
  Data.b $BC,$A7,$B1,$0E,$11,$D0,$8E,$6B
  
  IID_ISafeCurrentUser: ;uuid(D7E6FB7C-A22F-4A9D-A89D-653D1AA37324),
  Data.l $D7E6FB7C
  Data.w $A22F,$4A9D
  Data.b $A8,$9D,$65,$3D,$1A,$A3,$73,$24
  
  IID_ISafeDistList: ;uuid(EBB4EBA9-D546-4C85-A05A-167BF875FB83),
  Data.l $EBB4EBA9
  Data.w $D546,$4C85
  Data.b $A0,$5A,$16,$7B,$F8,$75,$FB,$83
  
  IID_IAddressLists: ;uuid(86797248-1A4E-41D0-A0C3-2175A36B3D0E),
  Data.l $86797248
  Data.w $1A4E,$41D0
  Data.b $A0,$C3,$21,$75,$A3,$6B,$3D,$0E
  
  IID_IMAPITable: ;uuid(6CCD925E-E833-4BE3-A62E-D3C8838C5D6D),
  Data.l $6CCD925E
  Data.w $E833,$4BE3
  Data.b $A6,$2E,$D3,$C8,$83,$8C,$5D,$6D
  
  IID_IMAPIUtils: ;uuid(D45B0772-5801-4E61-9CBA-84120557A4D7),
  Data.l $D45B0772
  Data.w $5801,$4E61
  Data.b $9C,$BA,$84,$12,$05,$57,$A4,$D7
  
  IID_ISafeInspector: ;uuid(6E4C6020-2932-4DDD-BDA8-998AE4CDF50D),
  Data.l $6E4C6020
  Data.w $2932,$4DDD
  Data.b $BD,$A8,$99,$8A,$E4,$CD,$F5,$0D
  
  IID_ISafeExplorer: ;uuid(D6B8D3F2-18AE-453D-86FA-05DFD01DB618),
  Data.l $D6B8D3F2
  Data.w $18AE,$453D
  Data.b $86,$FA,$05,$DF,$D0,$1D,$B6,$18

EndDataSection
HTH.
Top
franchsesko
User
User
Posts: 13
Joined: Sat Jun 02, 2018 4:45 pm

Re: Registry-free COM loader (Redemption.dll full sample)

Post by franchsesko »

I should have mentioned that this work in classic VB (VB5/6) but alas not VBA (Office).

For Redemption, here's also the source for a second DLL that wraps ProfMan.dll (compile that one to ProfManLoader.DLL, the previous one to RedemptionLoader.dll, to match the VB declares):

Code: Select all

EnableExplicit

Macro SUCCEEDED(HRESULT)
  HRESULT & $80000000 = 0
EndMacro

Macro FAILED(HRESULT)
  HRESULT & $80000000
EndMacro

Global CSInitialized.l
Global CS.CRITICAL_SECTION
Global.i DLLHandle
Global.s DLLLocation32Bit, DLLLocation64Bit

Prototype.w DllGetClassObjectFunc(*REFCLSID.CLSID, *REFIID.IID, *p)

Procedure CheckInitialize()
  If CSInitialized=0
    CSInitialized = 1
    InitializeCriticalSection_(@CS)
    EnterCriticalSection_(@CS)
    DLLHandle = 0
    LeaveCriticalSection_(@CS)
  EndIf
EndProcedure
  
; -----------------------------------------------------------------------------
;
; DLL Attach / Detach
;
; -----------------------------------------------------------------------------

ProcedureDLL AttachProcess(Instance)
  CheckInitialize()
EndProcedure
 
ProcedureDLL DetachProcess(Instance)
  EnterCriticalSection_(@CS)
  OnErrorGoto(?DetachErr)
  If DLLHandle
    FreeLibrary_(DLLHandle)
  EndIf
DetachErr:
  LeaveCriticalSection_(@CS)
  DeleteCriticalSection_(@CS)
EndProcedure

; -----------------------------------------------------------------------------
;
; Wrap COM object creation
;
; -----------------------------------------------------------------------------

Procedure.i Rinstr(psText.s, psFindWhat.s)
  Protected.i iPos, iFind
  iPos = FindString(psText, psFindWhat)
  While iPos > 0
    iFind = iPos
    iPos = FindString(psText, psFindWhat, iPos+1)
  Wend
  ProcedureReturn iFind
EndProcedure

Procedure.i NewProfmanObject(*pCLSID.GUID)
  Protected *result.IUnknown
  Protected.i res ;HRESULT
  Protected.s sPath, sDLLName
  Protected.i iLen, iPos
  Protected *pGetClassObject.DllGetClassObjectFunc
  Protected *pIIFactory.IClassFactory
  Protected sFuncName.s
  
  CheckInitialize()
  EnterCriticalSection_(@CS)
  If DLLHandle = 0
    If (Len(DLLLocation32Bit)=0) Or (Len(DLLLocation64Bit)=0)
      sPath = Space(#MAX_PATH)
      iLen = GetModuleFileName_(0, @sPath, #MAX_PATH)
      If iLen>0
        iPos = Rinstr(sPath, "\")
        If iPos > 0
          sPath = Left(sPath, iPos)
        Else
          sPath = ""
        EndIf
        If Len(DLLLocation32Bit)=0
          DLLLocation32Bit = sPath + "ProfMan.dll"
        EndIf
        If Len(DLLLocation64Bit)=0
          DLLLocation64Bit = sPath + "ProfMan64.dll"
        EndIf
      EndIf
    EndIf
    
    CompilerIf #PB_Processor_x86
      sDLLName = DLLLocation32Bit
    CompilerElse
      sDLLName = DLLLocation64Bit
    CompilerEndIf
    
    DLLHandle = LoadLibrary_(sDLLName)
  EndIf
  
  If DLLHandle
    sFuncName = Space(1024)
    WideCharToMultiByte_(#CP_ACP, 0, @"DllGetClassObject", -1, @sFuncName, 1024, #Null, #Null)
    *pGetClassObject = GetProcAddress_(DLLHandle, sFuncName)
    If *pGetClassObject
      res = *pGetClassObject(*pCLSID, ?IID_IClassFactory, @*pIIFactory)
      If SUCCEEDED(res)
        res = *pIIFactory\CreateInstance(#Null, ?IID_IUnknown, @*result)
      EndIf
    EndIf
  EndIf
  
  LeaveCriticalSection_(@CS)
  ProcedureReturn *result  
EndProcedure

Procedure.i __NewProfmanObject(*pCLSID.GUID, *pIID.iid)
  Protected *pUnk.IUnknown
  Protected *res = #Null
  *pUnk = NewProfmanObject(*pCLSID)
  If *pUnk
    *pUnk\QueryInterface(*pIID, @*res)
  EndIf
  ProcedureReturn *res
EndProcedure

; -----------------------------------------------------------------------------
;
; DLL API
;
; -----------------------------------------------------------------------------

ProcedureDLL.w SetDLLLocation32Bit(psPath.s)
  CheckInitialize()
  EnterCriticalSection_(@CS)
  DLLLocation32Bit = psPath
  LeaveCriticalSection_(@CS)
EndProcedure

ProcedureDLL.w SetDLLLocation64Bit(psPath.s)
  CheckInitialize()
  EnterCriticalSection_(@CS)
  DLLLocation64Bit = psPath
  LeaveCriticalSection_(@CS)
EndProcedure

ProcedureDLL.i new_Profiles()
  ProcedureReturn __NewProfmanObject(?CLSID_Profiles, ?IID_Profiles)
EndProcedure

ProcedureDLL.i new_PropertyBag()
  ProcedureReturn __NewProfmanObject(?CLSID_PropertyBag, ?IID_PropertyBag)
EndProcedure


; -----------------------------------------------------------------------------
;
; Data sections
;
; -----------------------------------------------------------------------------

DataSection
  
  IID_IUnknown: ; {00000000-0000-0000-C000-000000000046}
  Data.l $00000000
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46
  
  IID_IDispatch: ; {00020400-0000-0000-C000-000000000046}
  Data.l $00020400
  Data.w $0000, $0000
  Data.b $C0, $00, $00, $00, $00, $00, $00, $46
  
  IID_IDispatchEx: ; {A6EF9860-C720-11D0-9337-00A0C90DCAA9}
  Data.l $A6EF9860
  Data.w $C720, $11D0
  Data.b $93, $37, $00, $A0, $C9, $0D, $CA, $A9
  
  IID_IClassFactory: ; {00000001-0000-0000-C000-000000000046}
  Data.l $00000001
  Data.w $0000,$0000
  Data.b $C0,$00,$00,$00,$00,$00,$00,$46
  
  IID_IClassFactoryEx: ; {342D1EA0-AE25-11D1-89C5-006008C3FBFC}
  Data.l $342D1EA0
  Data.w $AE25,$11D1
  Data.b $89,$C5,$00,$60,$08,$C3,$FB,$FC
  
  ;Redemption ProfMan CLSIDs
  CLSID_Profiles: ;uuid(EBC7A7B5-C614-47B3-A579-27A2C2C98A13)
  Data.l $EBC7A7B5
  Data.w $C614,$47B3
  Data.b $A5,$79,$27,$A2,$C2,$C9,$8A,$13
  
  CLSID_PropertyBag: ;uuid(FC583D50-A2F5-4656-8B1D-360488B183D3)
  Data.l $FC583D50
  Data.w $A2F5,$4656
  Data.b $8B,$1D,$36,$04,$88,$B1,$83,$D3
  
  IID_Profiles: ;uuid(488637EC-1275-4D75-BE16-40630DFD4D76)
  Data.l $488637EC
  Data.w $1275, $4D75
  Data.b $BE,$16,$40,$63,$0D,$FD,$4D,$76
  
  IID_PropertyBag: ;uuid(47000673-7DB2-44C9-8AC1-65266117D280),
  Data.l $47000673
  Data.w $7DB2, $44C9
  Data.b $8A,$C1,$65,$26,$61,$17,$D2,$80
EndDataSection
And to use it in VB:

Code: Select all

Option Explicit

Private Declare Function SetDLLLocation32Bit Lib "ProfManLoader.dll" (ByVal plFilename As Long) As Integer
Private Declare Function new_Profiles Lib "ProfManLoader.dll" () As Profiles
Private Declare Function new_PropertyBag Lib "ProfManLoader.dll" () As PropertyBag

Sub Main()
  ChDir App.Path
  SetDLLLocation32Bit StrPtr("c:\<your path>\ProfMan.dll")
  
  Dim Profiles, Profile, i, Services, J
  
  Set Profiles = new_Profiles()
  For i = 1 To Profiles.Count
    Set Profile = Profiles.Item(i)
    Set Services = Profile.Services
    Debug.Print "------ " & Profile.Name & " ------"
    For J = 1 To Services.Count
      Debug.Print Services.Item(J).ServiceName
    Next
  Next
  
  'Set Profiles = Nothing
  
End Sub
Cheers.
Top
User avatar
mk-soft
Always Here
Always Here
Posts: 5395
Joined: Fri May 12, 2006 6:51 pm
Location: Germany

Re: Registry-free COM loader (Redemption.dll full sample)

Post by mk-soft »

Every COM-DLL has this interface.*
But I never had the idea to call it directly without registration. :wink:

* See my module OOP-BaseClassDispatch
My Projects ThreadToGUI / OOP-BaseClass / EventDesigner V3
PB v3.30 / v5.75 - OS Mac Mini OSX 10.xx - VM Window Pro / Linux Ubuntu
Downloads on my Webspace / OneDrive
Top
User avatar
CELTIC88
Enthusiast
Enthusiast
Posts: 154
Joined: Thu Sep 17, 2015 3:39 pm

Re: Registry-free COM loader (Redemption.dll full sample)

Post by CELTIC88 »

I need it thanks :)
interested in Cybersecurity..
Top
User avatar
Lunasole
Addict
Addict
Posts: 1091
Joined: Mon Oct 26, 2015 2:55 am
Location: UA
Contact:
Contact Lunasole

Re: Registry-free COM loader (Redemption.dll full sample)

Post by Lunasole »

Need to check this stuff next time with COM ^^
mohsen wrote: Finally, I found an easy way to use ActiveX without having to register. :D
The use of Enigma Virtual Box (This is free). Now, I using the ActiveX controls with (COMatePLUS) like Ribbonbar, PropertyGrid and more in pb,easily and without having to register.
Yes, Enigma is really cool in some cases as alternative of using installer
"W̷i̷s̷h̷i̷n̷g o̷n a s̷t̷a̷r"
Top
franchsesko
User
User
Posts: 13
Joined: Sat Jun 02, 2018 4:45 pm

Re: Registry-free COM loader (Redemption.dll full sample)

Post by franchsesko »

Hi Guys, back here after a while, thanks for your replies, awesome work and code on the COM/ActiveX topic in these forums ( :wink: @mk-soft).
Happy that you found your way with Enigma @mohsen.
The technique I followed here for "registry free" COM/ActiveX object libraries (dlls).
This means you don't need to touch the registry at all on the target machine (but must still register the components you use on your dev machine).
So, building those "facade" dlls allows you to distribute your (or third party) COM/ActiveX dlls as easily as copying files (as long as the COM/ActiveX libraries you wrap, don't themselves need other COM/ActiveX libraries to be registered).
That might not be applicable for ActiveX controls although, unless you're hosting them and can control how you instantiate them (that might not be possible depending on the development platform you use, but not possible from VB/A).
HTH
Top
Post Reply

Return to “Tricks 'n' Tips”