Here I will start a tutorial about how to write COM servers with PureBasic. The COM Server will implement one new test class (derived from a test interface) which will be accessible for the COM clients. First of all you need to know Interfaces/OOP and the sense of COM. Maybe you should even know about how to write COM clients. The most important thing: nearly all interfaces you are using with COM are derived from IUnknown or IDispatch and if you want a type library (not necessary) you must ensure, that every interface method returns an HRESULT, which is equal to a PureBasic long.
By default I am using the 64bit compiler to show that PureBasic is even able to produce 64bit COM modules.
I am not responsible for any damage caused by changes you made in your system with the software presented here. Try to boot in safe mode if your windows doesn't boot anymore like before.
Important Base Knowledge
Whenever a COM client application requests a new class instance by calling CoCreateInstance the function DllGetClassObject will be called inside the server dll. This function creates a class factory object which will be used to create the instance of the requested class.
So the calls are like:
Code: Select all
CoCreateInstance (Client)
│
│
v
DllGetClassObject
│
│
v
ClassFactory\CreateInstance
│
│
v
RequestedClass\QueryInterfaceSo DllGetClassObject will be the most important function we will need to export in our DLL. Another important function is DllCanUnloadNow, which returns #S_OK (0) if all objects of classes inside this DLL are deleted and #S_FALSE (1) if not. This is everything which is necessary for writing a COM server, but there are two additional functions, which we can export to register and unregister the DLL inside the operating system:
DllRegisterServer gets called when someone executes "regsvr32.exe MyCOM.dll" and it should set up the registry entries for using this COM DLL.
DllUnregisterServer gets called when someone executes "regsvr32.exe /u MyCOM.dll" and it should undo the registry changes made by DllRegisterServer.
If you execute "regsvr32.exe /?" you will notice that it offers an alternative to those two functions:
This is not necessary. Not even the two above are necessary, you can do the registry entries manually or via an external program (usually the installer does it)./i - Call DllInstall passing it an optional [cmdline]; when used with /u calls dll uninstall
Requirements
GUID is the short form of Global Unique Identifier. They are already declared by PureBasic through the structure "GUID". Usually COM users are having a macro like this to define new GUIDs inside the code:
Code: Select all
Macro DEFINE_GUID(Name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
Global Name.GUID
Name\Data1 = l
Name\Data2 = w1
Name\Data3 = w2
Name\Data4[0] = b1
Name\Data4[1] = b2
Name\Data4[2] = b3
Name\Data4[3] = b4
Name\Data4[4] = b5
Name\Data4[5] = b6
Name\Data4[6] = b7
Name\Data4[7] = b8
EndMacroCode: Select all
; {329AA340-3E15-469a-86E7-17CE6DACC2E4}
DEFINE_GUID(CLSID_MyTestClass, $329aa340, $3e15, $469a, $86, $e7, $17, $ce, $6d, $ac, $c2, $e4)
; the interface (iid) guid:
; {375749F8-D6CC-4631-B14A-00224F717391}
DEFINE_GUID(IID_MyTestClass, $375749f8, $d6cc, $4631, $b1, $4a, $0, $22, $4f, $71, $73, $91)Code: Select all
Macro PRINT_GUID(guid)
RSet(Hex(guid\Data1, #PB_Long), 8, "0") + "-" + RSet(Hex(guid\Data2, #PB_Word), 4, "0") + "-" + RSet(Hex(guid\Data3, #PB_Word), 4, "0") + "-" + RSet(Hex(guid\Data4[0], #PB_Byte), 2, "0") + RSet(Hex(guid\Data4[1], #PB_Byte), 2, "0") + "-" + RSet(Hex(guid\Data4[2], #PB_Byte), 2, "0") + RSet(Hex(guid\Data4[3], #PB_Byte), 2, "0") + RSet(Hex(guid\Data4[4], #PB_Byte), 2, "0") + RSet(Hex(guid\Data4[5], #PB_Byte), 2, "0") + RSet(Hex(guid\Data4[6], #PB_Byte), 2, "0") + RSet(Hex(guid\Data4[7], #PB_Byte), 2, "0")
EndMacroCode: Select all
Global DllRefCount.lIUnknown is the interface, which every single COM class is derived from. It consists of a reference counter for the current object and a method called QueryInterface, where sub interfaces of the same object can be requested. You may want to implement more than one interface in one class.
The IUnknown interface has this IID:
Code: Select all
DEFINE_GUID(IID_IUnknown, $00000000, $0000, $0000, $C0, $00, $00, $00, $00, $00, $00, $46)Code: Select all
Interface MyUnknown
QueryInterface.l(*riid.IID, *ppv.Integer)
AddRef.l()
Release.l()
EndInterface
Structure SMyUnknown
*VFTable.i
ReferenceCount.l
EndStructure
Procedure.l MyUnknown_AddRef(*this.SMyUnknown)
*this\ReferenceCount + 1
ProcedureReturn *this\ReferenceCount
EndProcedure
Procedure.l MyUnknown_Release(*this.SMyUnknown)
*this\ReferenceCount - 1
If *this\ReferenceCount <= 0
; the reference counter is lower or equal zero, so delete this object:
FreeMemory(*this\VFTable)
FreeMemory(*this)
; decrement the dll reference counter (usually you should use InterlockedDecrement, but polink doesn't know it):
DllRefCount - 1
ProcedureReturn 0
Else
ProcedureReturn *this\ReferenceCount
EndIf
EndProcedure
Procedure.l MyUnknown_QueryInterface(*this.SMyUnknown, *riid.IID, *ppv.Integer)
*ppv\i = #Null
; We can still return the IUnknown interface, but nobody would ever request that in here:
If CompareMemory(*riid, @IID_IUnknown, SizeOf(IID))
*ppv\i = *this
; a new reference for this object will be returned
MyUnknown_AddRef(*this)
ProcedureReturn #S_OK
EndIf
ProcedureReturn #E_FAIL
EndProcedureOur TestClass
Before we can start creating instances of our TestClass, we need the TestClass itself. It will save one number, which is initialized randomly at the beginning. You can get and set this number through methods defined in the TestClass. It also inherits the methods from the IUnknown interface.
Code: Select all
Interface MyTestClass Extends MyUnknown
GetNumber.l(*Number.Integer)
SetNumber.l(Number.i)
EndInterface
Structure SMyTestClass Extends SMyUnknown
Number.i
EndStructure
Procedure.l MyTestClass_QueryInterface(*this.MyTestClass, *riid.IID, *ppv.Integer)
*ppv\i = #Null
; inherits IUnknown, so we can return this
; inherits IMyTestClass (which is equal to MyTestClass), so we can also return this
If CompareMemory(*riid, @IID_IUnknown, SizeOf(IID)) Or CompareMemory(*riid, @IID_MyTestClass, SizeOf(IID))
*ppv\i = *this
; increment the ref. counter
*this\AddRef()
ProcedureReturn #S_OK
EndIf
ProcedureReturn #E_FAIL
EndProcedure
; will return the number of the object (initialized as random, see constructor)
Procedure.l MyTestClass_GetNumber(*this.SMyTestClass, *Number.Integer)
*Number\i = *this\Number
ProcedureReturn #S_OK
EndProcedure
; will set the number of the object
Procedure.l MyTestClass_SetNumber(*this.SMyTestClass, Number.i)
*this\Number = Number ; set the number and return #S_OK
ProcedureReturn #S_OK
EndProcedure
; the constructor
Procedure.i MyTestClass_Constructor()
Protected *this.SMyTestClass
; allocate the object's memory
*this = AllocateMemory(SizeOf(SMyTestClass))
If *this
; copy the vftable from the datasection
*this\VFTable = AllocateMemory(?MyTestClassVFTEnd - ?MyTestClassVFTStart)
CopyMemory(?MyTestClassVFTStart, *this\VFTable, ?MyTestClassVFTEnd - ?MyTestClassVFTStart)
*this\Number = Random(10) ; initialize the object's number attribute
; increment the dll ref. counter
DllRefCount + 1
EndIf
ProcedureReturn *this
DataSection
MyTestClassVFTStart:
Data.i @MyTestClass_QueryInterface() ; overridden
Data.i @MyUnknown_AddRef() ; from MyUnknown
Data.i @MyUnknown_Release() ; from MyUnknown
Data.i @MyTestClass_GetNumber() ; from MyTestClass
Data.i @MyTestClass_SetNumber() ; from MyTestClass
MyTestClassVFTEnd:
EndDataSection
EndProcedureThe IClassFactory interface inherits the IUnknown interface and has two additional methods:
- CreateInstance.l(*pUnkOuter.IUnknown, *riid.IID, *ppv.Integer) is creating the instances of the TestClass
- LockServer.l(fLock.l) is ensuring threadsafety, but we won't use it and we will just return #E_UNEXPECTED
Code: Select all
Interface MyClassFactory Extends MyUnknown
CreateInstance.l(*pUnkOuter.IUnknown, *riid.IID, *ppv.Integer)
LockServer.l(fLock.l)
EndInterface
Structure SMyClassFactory Extends SMyUnknown
EndStructure
Procedure.l MyClassFactory_QueryInterface(*this.MyClassFactory, *riid.IID, *ppv.Integer)
*ppv\i = #Null
; inherits IUnknown, so we can return this
; inherits IClassFactory, so we can also return this
If CompareMemory(*riid, @IID_IUnknown, SizeOf(IID)) Or CompareMemory(*riid, @IID_IClassFactory, SizeOf(IID))
*ppv\i = *this
; a new reference for this object will be returned
*this\AddRef()
ProcedureReturn #S_OK
EndIf
ProcedureReturn #E_FAIL
EndProcedure
Procedure.l MyClassFactory_CreateInstance(*this.MyClassFactory, *pUnkOuter.IUnknown, *riid.IID, *ppv.Integer)
Protected *object.MyTestClass
; The Unk in UnkOuter means Unknown. When classes inherit from multiple interfaces,
; they would have different relative locations of the IUnknown interface inside the vftable.
; But this would be a mess with reference counting, so you could also return a separate pointer for IUnknown.
If *pUnkOuter <> #Null
ProcedureReturn #CLASS_E_NOAGGREGATION
EndIf
; The *ppv must be valid
If *ppv = #Null
ProcedureReturn #E_POINTER
EndIf
; Create the TestClass object
*object = MyTestClass_Constructor()
If *object = #Null
ProcedureReturn #E_OUTOFMEMORY
EndIf
; increment it's ref. counter
*object\AddRef()
; and return the requested interface inside this object.
ProcedureReturn *object\QueryInterface(*riid, *ppv)
EndProcedure
Procedure.l MyClassFactory_LockServer(*this.MyClassFactory, fLock.l)
ProcedureReturn #E_UNEXPECTED ; not used.
EndProcedure
; the constructor
Procedure.i MyClassFactory_Constructor()
Protected *this.SMyClassFactory
; allocate the object's memory
*this = AllocateMemory(SizeOf(SMyClassFactory))
If *this
; copy the vftable from the datasection
*this\VFTable = AllocateMemory(?MyClassFactoryVFTEnd - ?MyClassFactoryVFTStart)
CopyMemory(?MyClassFactoryVFTStart, *this\VFTable, ?MyClassFactoryVFTEnd - ?MyClassFactoryVFTStart)
; increment the dll reference counter
DllRefCount + 1
EndIf
; return the object
ProcedureReturn *this
DataSection
MyClassFactoryVFTStart:
Data.i @MyClassFactory_QueryInterface() ; overridden
Data.i @MyUnknown_AddRef() ; from MyUnknown
Data.i @MyUnknown_Release() ; from MyUnknown
Data.i @MyClassFactory_CreateInstance() ; ClassFactory method
Data.i @MyClassFactory_LockServer() ; ClassFactory method
MyClassFactoryVFTEnd:
EndDataSection
EndProcedureDllGetClassObject and DllCanUnloadNow
Its not very much I could explain about that, which wasn't said at the beginning. I've written the explanation as comments into this source code:
Code: Select all
; the class factory creator
ProcedureDLL.l DllGetClassObject(*rclsid.CLSID, *riid.IID, *ppv.Integer)
Protected *object.MyClassFactory
; the wished class is not CLSID_MyTestClass, so return #CLASS_E_CLASSNOTAVAILABLE
If Not CompareMemory(*rclsid, @CLSID_MyTestClass, SizeOf(CLSID))
ProcedureReturn #CLASS_E_CLASSNOTAVAILABLE
EndIf
; the wished interface must be IClassFactory
If CompareMemory(*riid, @IID_IClassFactory, SizeOf(CLSID))
; create the class factory
*object = MyClassFactory_Constructor()
; increment the reference counter
*object\AddRef()
; return the object's pointer
*ppv\i = *object
ProcedureReturn #S_OK
EndIf
ProcedureReturn #CLASS_E_CLASSNOTAVAILABLE
EndProcedure
ProcedureDLL.l DllCanUnloadNow()
; only if this statement is true, the dll should be ready for unloading
If DllRefCount <= 0
ProcedureReturn #S_OK
EndIf
ProcedureReturn #S_FALSE
EndProcedureFor registering the DLL as a COM DLL we just need to create three registry entries:
Code: Select all
HKLM\SOFTWARE\Classes\CLSID\{CLSID_MyTestClass}\(Default) = "MyTestClass"
HKLM\SOFTWARE\Classes\CLSID\{CLSID_MyTestClass}\InprocServer32\(Default) = path and filename to your DLL
HKLM\SOFTWARE\Classes\CLSID\{CLSID_MyTestClass}\InprocServer32\ThreadingModel = "Apartment"Code: Select all
Procedure UnregisterNative(*CLSID.GUID)
; simply delete the HKLM\SOFTWARE\Classes\CLSID\{CLSID} key
Reg_DeleteKeyWithAllSub(#HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\CLSID\" + "{" + PRINT_GUID(*CLSID) + "}")
EndProcedure
Procedure RegisterNative(*CLSID.GUID, Name.s, File.s)
UnregisterNative(*CLSID)
Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\CLSID\" + "{" + PRINT_GUID(*CLSID) + "}", "", Name, #REG_SZ)
Reg_CreateKeyValue(#HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\CLSID\" + "{" + PRINT_GUID(*CLSID) + "}" + "\InprocServer32", "", File, #REG_SZ)
Reg_SetValue(#HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\CLSID\" + "{" + PRINT_GUID(*CLSID) + "}" + "\InprocServer32", "ThreadingModel", "Apartment", #REG_SZ)
EndProcedure
; You may want to register a 32bit DLL through a 64bit program on a 64bit machine.
; Therefore you have to exchange "SOFTWARE" with "SOFTWARE\Wow6432Node"
Macro Register(CLSID, Name, File = ProgramFilename())
RegisterNative(CLSID, Name, File)
EndMacro
Macro Unregister(CLSID)
UnregisterNative(CLSID)
EndMacro
; Those two functions are only necessary for registering through regsvr32.exe:
ProcedureDLL.l DllRegisterServer()
Register(@CLSID_MyTestClass, "MyTestClass", ProgramFilename())
ProcedureReturn #S_OK
EndProcedure
ProcedureDLL.l DllUnregisterServer()
Unregister(@CLSID_MyTestClass)
ProcedureReturn #S_OK
EndProcedureHowever there is another change you need to make if you want to install the COM server system wide: "HKCR\CLSID" is used instead. RegOverridePredefKey/ may be helpful for those redirecting actions.
Simple Client
After registering your DLL you can try it with this simple client:
Code: Select all
; ************************************************************************************************************
; * Author: Daniel Brall *
; * WWW : http://www.bradan.eu/ *
; * Desc. : A simple COM client *
; ************************************************************************************************************
CoInitialize_(0)
; you need the interface definition:
Interface MyUnknown
QueryInterface.l(*riid.IID, *ppv.Integer)
AddRef.l()
Release.l()
EndInterface
Interface MyTestClass Extends MyUnknown
GetNumber.l(*Number.Integer)
SetNumber.l(Number.i)
EndInterface
; and the GUIDs
Macro DEFINE_GUID(Name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
Global Name.GUID
Name\Data1 = l
Name\Data2 = w1
Name\Data3 = w2
Name\Data4[0] = b1
Name\Data4[1] = b2
Name\Data4[2] = b3
Name\Data4[3] = b4
Name\Data4[4] = b5
Name\Data4[5] = b6
Name\Data4[6] = b7
Name\Data4[7] = b8
EndMacro
; should be the same as in Constants.pbi:
DEFINE_GUID(CLSID_MyTestClass, $329aa340, $3e15, $469a, $86, $e7, $17, $ce, $6d, $ac, $c2, $e4)
DEFINE_GUID(IID_MyTestClass, $375749f8, $d6cc, $4631, $b1, $4a, $0, $22, $4f, $71, $73, $91)
Define *MyTestClassObject.MyTestClass = #Null
Define Result.l
Define Number.i
Result = CoCreateInstance_(@CLSID_MyTestClass, #Null, 1, @IID_MyTestClass, @*MyTestClassObject)
If Result = #S_OK And *MyTestClassObject <> #Null
If *MyTestClassObject\GetNumber(@Number) = #S_OK
Debug Number
Else
Debug "Error: GetNumber failed"
EndIf
If *MyTestClassObject\SetNumber(-1) = #S_OK
Debug "OK: SetNumber returned S_OK"
Else
Debug "Error: SetNumber failed."
EndIf
If *MyTestClassObject\GetNumber(@Number) = #S_OK
Debug Number
Else
Debug "Error: GetNumber failed"
EndIf
*MyTestClassObject\Release()
Else
Debug "Error: 0x" + Hex(Result, #PB_Long)
EndIf
CoUninitialize_()This section isn't necessary at all, but some people might want to create a type libraries. Type libraries are describing the exported classes and interfaces, so anyone who wants to use the COM server can use the type library to tell the linker what offsets are needed etc. Its like a language independent header file. You'll need the Windows SDK (I use 7.1) and Microsoft Visual Studio (I use Express 2010) for the following steps.
To describe the previously shown TestClass we must have an IDL file, which is nothing else than the readable TLB file. It looks like this and the name of the syntax is Object Description Language:
Code: Select all
import "oaidl.idl";
import "ocidl.idl";
// interface declaration
[
uuid(375749F8-D6CC-4631-B14A-00224F717391),
helpstring("Is able to save a signed integer (native bit size)")
] interface IMyTestClass : IUnknown {
// the names are unimportant, but as we specify propget/propput
// the GetNumber SetNumber doesn't need to have the Get/Set prefix.
#if defined _WIN64 || defined __amd64__
[propget,helpstring("Returns the number.")] HRESULT Number([out,retval] long long*);
[propput,helpstring("Sets the number.")] HRESULT Number([in] long long);
#else
[propget,helpstring("Returns the number.")] HRESULT Number([out,retval] int*);
[propput,helpstring("Sets the number.")] HRESULT Number([in] int);
#endif
};
// library declaration
[
// the type library id:
// we will need this inside our code
uuid(B981CAEC-BACE-4fd2-B553-615A0F832D0F),
helpstring("Contains MyTestClass"),
version(1.0) // major.minor - we will need this inside our code
] library MyTestClassLib
{
// class declaration
[
uuid(329AA340-3E15-469a-86E7-17CE6DACC2E4),
helpstring("MyTestClass itself: it will save a signed integer (native bit size)")
] coclass MyTestClass
{
[default] interface IMyTestClass;
};
};For a better explanation on this language, see Type Libraries and the Object Description Language.
For compiling this IDL file into a TLB file I use this code:
Code: Select all
Define Path.s
Define PathBackup.s
Define CD.s = GetCurrentDirectory()
If Right(CD, 1) <> "\"
CD + "\"
EndIf
Define IDLFile.s = CD + "MyTestClass.idl"
Define TLBFile.s = CD + "MyTestClass.tlb"
#TARGET_ENVIRONMENT = "x64" ; win32, x64 or ia64
; 64 bit:
Define MSVCBin.s = "C:\Program Files (x86)\Microsoft Visual Studio 10.0\VC\bin\amd64" ; contains cl.exe
; 32 bit:
; Define MSVCBin.s = "C:\Program Files (x86)\Microsoft Visual Studio 10.0\VC\bin" ; contains cl.exe
Define MSVSCommon7IDE.s = "C:\Program Files (x86)\Microsoft Visual Studio 10.0\Common7\IDE"
Define MSPSDKWinServer2003Bin.s = "C:\Program Files\Microsoft SDKs\Windows\v7.1\Bin" ; contains midl.exe
Define MSPSDKWinServer2003Inc.s = "C:\Program Files\Microsoft SDKs\Windows\v7.1\Include" ; contains ocidl.acf
OpenConsole()
Path = GetEnvironmentVariable("PATH")
PathBackup = Path
Path = Path + ";" + MSVSCommon7IDE
Path = Path + ";" + MSPSDKWinServer2003Bin
Path = ReplaceString(Path, ";;", ";")
SetEnvironmentVariable("PATH", Path)
SetCurrentDirectory(MSVCBin)
RunProgram("midl.exe", #DQUOTE$ + IDLFile + #DQUOTE$ + " /tlb " + #DQUOTE$ + TLBFile + #DQUOTE$ + " /robust /" + #TARGET_ENVIRONMENT + " /I " + #DQUOTE$ + MSPSDKWinServer2003Inc + #DQUOTE$, GetCurrentDirectory(), #PB_Program_Wait)
SetEnvironmentVariable("PATH", PathBackup)
PrintN("")
PrintN("")
PrintN(LSet("", 16, ">") + " Finished! " + RSet("", 16, "<"))
PrintN("")
Input()The correct output when compiling the IDL to TLB should be similar to this:
This generated type library (the "MyTestClass.tlb" file) has to be registered. I made a little program describing how you can register/unregister the typelib, but usually you should put this inside DllRegisterServer and DllUnregisterServer. If you pass /u to the program it will unregister MyTestClass.tlb, otherwise it will register it:Microsoft (R) 32b/64b MIDL Compiler Version 7.00.0555
Copyright (c) Microsoft Corporation. All rights reserved.
64 bit Processing C:\[...]\MyTestClass.idl
MyTestClass.idl
64 bit Processing C:\Program Files\Microsoft SDKs\Windows\v7.1\Include\oaidl.idl
oaidl.idl
64 bit Processing C:\Program Files\Microsoft SDKs\Windows\v7.1\Include\objidl.idl
objidl.idl
64 bit Processing C:\Program Files\Microsoft SDKs\Windows\v7.1\Include\unknwn.idl
unknwn.idl
64 bit Processing C:\Program Files\Microsoft SDKs\Windows\v7.1\Include\wtypes.idl
wtypes.idl
64 bit Processing C:\Program Files\Microsoft SDKs\Windows\v7.1\Include\basetsd.h
basetsd.h
64 bit Processing C:\Program Files\Microsoft SDKs\Windows\v7.1\Include\guiddef.h
guiddef.h
64 bit Processing C:\Program Files\Microsoft SDKs\Windows\v7.1\Include\ocidl.idl
ocidl.idl
64 bit Processing C:\Program Files\Microsoft SDKs\Windows\v7.1\Include\oleidl.idl
oleidl.idl
64 bit Processing C:\Program Files\Microsoft SDKs\Windows\v7.1\Include\servprov.idl
servprov.idl
64 bit Processing C:\Program Files\Microsoft SDKs\Windows\v7.1\Include\urlmon.idl
urlmon.idl
64 bit Processing C:\Program Files\Microsoft SDKs\Windows\v7.1\Include\msxml.idl
msxml.idl
64 bit Processing C:\Program Files\Microsoft SDKs\Windows\v7.1\Include\oaidl.acf
oaidl.acf
64 bit Processing C:\Program Files\Microsoft SDKs\Windows\v7.1\Include\ocidl.acf
ocidl.acf
>>>>>>>>>>>>>>>> Finished! <<<<<<<<<<<<<<<<
Code: Select all
OpenConsole()
Macro DEFINE_GUID(Name, l, w1, w2, b1, b2, b3, b4, b5, b6, b7, b8)
Global Name.GUID
Name\Data1 = l
Name\Data2 = w1
Name\Data3 = w2
Name\Data4[0] = b1
Name\Data4[1] = b2
Name\Data4[2] = b3
Name\Data4[3] = b4
Name\Data4[4] = b5
Name\Data4[5] = b6
Name\Data4[6] = b7
Name\Data4[7] = b8
EndMacro
Enumeration ; SYSKIND
#SYS_WIN16
#SYS_WIN32
#SYS_MAC
#SYS_WIN64
EndEnumeration
Define TLBFile.s
; {B981CAEC-BACE-4fd2-B553-615A0F832D0F}
DEFINE_GUID(LIBID_MyTestClass, $b981caec, $bace, $4fd2, $b5, $53, $61, $5a, $f, $83, $2d, $f);
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
#OUR_SYSKIND = #SYS_WIN64
TLBFile = "MyTestClass.tlb"
CompilerElse
#OUR_SYSKIND = #SYS_WIN32
TLBFile = "MyTestClass32.tlb"
CompilerEndIf
Procedure.i RegisterTypeLib(Filename.s)
Protected *TypeLib.ITypeLib = #Null
Protected *FilenameUnicode = AllocateMemory(StringByteLength(Filename + " ", #PB_Unicode))
Protected Result.i = #False
If *FilenameUnicode <> #Null
PokeS(*FilenameUnicode, Filename, -1, #PB_Unicode)
If LoadTypeLib_(*FilenameUnicode, @*TypeLib) = #S_OK
; we've loaded the tlb file, so register it now:
If RegisterTypeLib_(*TypeLib, *FilenameUnicode, #Null) = #S_OK
PrintN("Typelib successfully registered.")
Result = #True
Else
PrintN("RegisterTypeLib failed.")
EndIf
*TypeLib\Release()
Else
PrintN("LoadTypeLib failed.")
EndIf
FreeMemory(*FilenameUnicode)
Else
PrintN("Not enough memory")
EndIf
ProcedureReturn Result
EndProcedure
Procedure UnRegisterTypeLib(*LibID.GUID, Major.w, Minor.w)
If UnRegisterTypeLib_(*LibID, Major, Minor, #LANG_NEUTRAL, #OUR_SYSKIND) = #S_OK
PrintN("Typelib sucessfully unregistered.")
ProcedureReturn #True
EndIf
PrintN("UnRegisterTypeLib failed.")
ProcedureReturn #False
EndProcedure
; we don't want HKCR registration, we want HKLM\SOFTWARE\Classes instead, so redirect any changes.
Prototype _RegOverridePredefKey(hKey.i, hKeyNew.i)
Global RegOverridePredefKey_._RegOverridePredefKey
Global Advapi32DLL.i
Advapi32DLL = OpenLibrary(#PB_Any, "Advapi32.dll")
If Advapi32DLL
RegOverridePredefKey_ = GetFunction(Advapi32DLL, "RegOverridePredefKey")
EndIf
Define KeyHandle.i
RegOpenKey_(#HKEY_CURRENT_USER, @"SOFTWARE\Classes", @KeyHandle)
RegOverridePredefKey_(#HKEY_CLASSES_ROOT, KeyHandle)
If ProgramParameter() = "/u"
; for unregistering:
UnRegisterTypeLib(@LIBID_MyTestClass, 1, 0)
Else
Define ProgramPath.s = GetPathPart(ProgramFilename())
If Right(ProgramPath, 1) <> "\"
ProgramPath + "\"
EndIf
; now register the typelib
RegisterTypeLib(ProgramPath + TLBFile)
EndIf
; end with redirecting the registry changes:
RegOverridePredefKey_(#HKEY_CLASSES_ROOT, #Null)
RegCloseKey_(KeyHandle)
If Advapi32DLL
CloseLibrary(Advapi32DLL)
EndIfAfter registering the DLL(s) and the TypeLib(s) you can use it in any of Microsoft's programming languages which are supporting typelib importing. Here is an example written in C++:
Code: Select all
#include <stdio.h>
#include <comdef.h>
#include <Windows.h>
// be careful: you need to call the native 64bit compiler (not the cross compiler), otherwise it will choose the 32bit registry entries.
// this will import the typelib with the specified uuid
#import "libid:B981CAEC-BACE-4fd2-B553-615A0F832D0F" named_guids no_namespace
int main(int argc, char* argv[])
{
CoInitialize(0);
IMyTestClass* test;
if(CoCreateInstance(CLSID_MyTestClass, NULL, 1, IID_IMyTestClass, (LPVOID*) &test) == S_OK)
{
printf("OK\n");
printf("Number: %d\n", test->Number);
test->Number = -1;
printf("Number: %d\n", test->Number);
} else {
printf("ERROR\n");
}
CoUninitialize();
system("PAUSE");
return 0;
}Functions: CoCreateInstance, DllGetClassObject, DllCanUnloadNow, DllRegisterServer, DllUnregisterServer, RegOverridePredefKey
IClassFactory interface
Type Libraries and the Object Description Language
Type Library Attribute Descriptions
Understanding COM Apartments
