Tweet
COM made easy for VB.
Just compile the DLL and use example VB code to Late-Bind use in VB.
The DLL can be also used for Early binding, and the typical PB "Classic" procedures that we are all used to.
Added bonus: No need to build an installer package, nor have user run regsvr32 to register the dll
For those with PB8 (although 9 is REALLLLLYYYYyyyy worth upgrading) I have compiled the example to work for both 8 and 9 (although without 9 you can't compile COM but you can at least see how it works)
PB DLL - "DllRegisterServer.inc" (Eliminate running regsvr32, or installer)
PB DLL - "SerialPortFunctions.inc" (Functions to be added for true serial port control, but this is just for demo)
PB DLL - "PB9 Class Demo.bas"
VB EXE - Form1.bas
The attached zip file also contains the full project, and error handling routines.
Discussion can be done at Pb Dll in VB - Early/Late Binding, or PB "Classic"
Have fun
Just compile the DLL and use example VB code to Late-Bind use in VB.
The DLL can be also used for Early binding, and the typical PB "Classic" procedures that we are all used to.
Added bonus: No need to build an installer package, nor have user run regsvr32 to register the dll
For those with PB8 (although 9 is REALLLLLYYYYyyyy worth upgrading) I have compiled the example to work for both 8 and 9 (although without 9 you can't compile COM but you can at least see how it works)
PB DLL - "DllRegisterServer.inc" (Eliminate running regsvr32, or installer)
Code:
'*** If not already declared in your code, then declare this INC
#IF NOT %DEF(%DLLREGISTERSERVER)
%DLLREGISTERSERVER = 1
%UNKNOWN_VALUE = -1
DECLARE FUNCTION RegUnReg ALIAS "RegUnReg"(inFileSpec AS ASCIIZ * %MAX_PATH, Registering AS LONG) AS LONG
FUNCTION RegUnReg ALIAS "RegUnReg"(inFileSpec AS ASCIIZ * %MAX_PATH, Registering AS LONG) EXPORT AS LONG
ON ERROR RESUME NEXT
LOCAL lLib AS LONG ' Store handle of the control library
LOCAL lpDLLEntryPoint AS LONG ' Store the address of function called
LOCAL lpThreadID AS LONG ' Pointer that receives the thread identifier
LOCAL lpExitCode AS LONG ' Exit code of GetExitCodeThread
LOCAL mThread AS LONG
LOCAL mResult AS LONG
lLib = LoadLibrary(inFileSpec) ' Load the control DLL
IF lLib = 0 THEN
FUNCTION = %UNKNOWN_VALUE
EXIT FUNCTION
END IF
'*** Find the DLL entry point
IF Registering THEN
lpDLLEntryPoint = GetProcAddress(lLib, "DllRegisterServer")
ELSE
lpDLLEntryPoint = GetProcAddress(lLib, "DllUnregisterServer")
END IF
IF lpDLLEntryPoint = 0 THEN
FUNCTION = %UNKNOWN_VALUE
'*** Decrements the reference count of loaded DLL module before leaving
FreeLibrary lLib
EXIT FUNCTION
END IF
'*** Create a thread to execute within the virtual address space of the calling process
mThread = CreateThread(BYVAL 0, 0, BYVAL lpDLLEntryPoint, BYVAL 0, 0, lpThreadID)
IF mThread = 0 THEN
FUNCTION = %UNKNOWN_VALUE
'*** Decrements the reference count of loaded DLL module before leaving
FreeLibrary lLib
EXIT FUNCTION
END IF
'*** Use WaitForSingleObject to check the return state (i) when the specified object
'*** is in the signaled state or (ii) when the time-out interval elapses.
mResult = WaitForSingleObject(mThread, 10000)
IF mResult <> 0 THEN
FUNCTION = %UNKNOWN_VALUE
FreeLibrary lLib
'*** Terminate the thread to free up resources that are used by the thread
'*** NOTE: Calling ExitThread for an application's primary thread will cause
'*** the application to terminate
lpExitCode = GetExitCodeThread(mThread, lpExitCode)
ExitThread lpExitCode
END IF
'*** Don't call the dangerous TerminateThread() VB doesnt like it. After the last handle
'*** to the object is closed, the object is removed from the memory.
CloseHandle mThread
FreeLibrary lLib
END FUNCTION
#ENDIF
Code:
'*** SerialPortFunctions.inc
'*** Written by: Cliff Nichols - 09-21-2008
'*** Modified by: Cliff Nichols - 09-21-2008
'*** Compiler: 8.04/9.0
'*** Should work on: 7/8/9
'*** Tested on: XP-Pro SP3, Vista-Ultimate
'*** Should work on: 95/98/ME/NT/2K/XP/Vista
'*** Purpose - Ability to add COM to other languages, and still keep PB Classic
'*** Usage:
'*** To be built upon for serial port routines
'--------------------------------------------------------------------------------
'*** UDT to be used in both PB Classic, and COM ability
TYPE SerialPortInfo
ClassInitiated AS LONG 'Class Initiated
HwndPortNumber AS LONG 'Hwnd to the port being used
PortNumber AS LONG 'Port Number
PortBaudRate AS LONG 'BaudRate
PortDataBits AS LONG 'Data Bits
PortStopBits AS LONG 'Stop Bits
PortParity AS LONG 'Parity
PortParityChar AS LONG 'Parity Character
PortParityReplace AS LONG 'Character to replace parity character
PortTxBuffer AS LONG 'Size of Transmit Buffer
PortRxBuffer AS LONG 'Size of Recieve Buffer
PortDiscardBytesWhenRead AS LONG 'Discard Bytes once they are read
END TYPE
'*** In the case that the compiler is not CLASS capable (IE: compiler version is less than 9)
'*** Place a conditional compile so all "Non-Com" code still compiles correctly
#IF (%PB_REVISION) > = &H900 '<-- If Compiler version is 9 or higher then its able to handle classes
'*** Select a GUID to keep minor changes constant (or at least through development)
'*** You can create your own, but if not sure how or what then do the following:
'*** (Thank you to To Kev Peel for answering this one at [url="http://www.powerbasic.com/support/pbforums/showthread.php?t=38522"]PB CrossOver Question[/url]
'*** [quote] Right click in IDE > Insert GUID. That GUID is a permanent, unique value for you. [/quote]
$ClsSerialPortGUID = GUID$("{C459B004-8508-4528-AFC6-50F0C82DD5B1}")
$iSerialPortGUID = GUID$("{3252C775-F6D3-4125-8CC4-7C3D89A1F156}")
CLASS ClsSerialPort $ClsSerialPortGUID AS COM '<--- Class is internal to itself to not confuse the user
INSTANCE ClsSerialPortInfo AS SerialPortInfo '<--- Kinda like globals but local to each instance of the class
CLASS METHOD ClassInitialize() 'Default Initialization
ClsSerialPortInfo.ClassInitiated = %TRUE 'Flag for if initiated
ClsSerialPortInfo.HwndPortNumber = 0 'No Hwnd till opened
ClsSerialPortInfo.PortNumber = 1 'Default to most common port
ClsSerialPortInfo.PortBaudRate = 9600 'Default to most common baud rate
ClsSerialPortInfo.PortDataBits = 8 'Default to most common data bits
ClsSerialPortInfo.PortStopBits = 2 'Default to most common stop bits (0 = 1 stop bits, 1 = 1.5 stop bits, 2 = 2 stop bits)
ClsSerialPortInfo.PortParity = %FALSE 'TRUE/FALSE Enable parity checking. (This mode must be enabled for the other Parity options to be selected.)
ClsSerialPortInfo.PortParityReplace = %TRUE 'TRUE/FALSE Enable character replacement on parity error. (PARITY must be enabled.)
END METHOD
CLASS METHOD ClassTerminate() 'Default Termination
ClsSerialPortInfo.ClassInitiated = %FALSE 'Flag for if initiated
ClsSerialPortInfo.HwndPortNumber = 0 'No Hwnd till opened
ClsSerialPortInfo.PortNumber = 0 'Default to most common port
ClsSerialPortInfo.PortBaudRate = 9600 'Default to most common baud rate
ClsSerialPortInfo.PortDataBits = 8 'Default to most common data bits
ClsSerialPortInfo.PortStopBits = 2 'Default to most common stop bits (0 = 1 stop bits, 1 = 1.5 stop bits, 2 = 2 stop bits)
ClsSerialPortInfo.PortParity = %FALSE 'TRUE/FALSE Enable parity checking. (This mode must be enabled for the other Parity options to be selected.)
ClsSerialPortInfo.PortParityReplace = %TRUE 'TRUE/FALSE Enable character replacement on parity error. (PARITY must be enabled.)
END METHOD
INTERFACE iSerialPort $iSerialPortGUID
' INHERIT IUNKNOWN '<--- Still researching differences of unknown vs dispatch vs the others (but for DLL the interface has to be dispatched)
INHERIT IDISPATCH '<--- Still researching differences of unknown vs dispatch vs the others (but for DLL the interface has to be dispatched)
METHOD Initialize()
ME.ClassInitialize
END METHOD
METHOD Terminate()
ME.ClassTerminate
END METHOD
'*** Property Get MUST come before Property Set
'*** From the docs:
'*** (Property Get / Property Set) must be paired. That is, the PROPERTY SET must immediately follow the PROPERTY GET. It's important to note that all PROPERTY parameters must be declared as BYVAL.
PROPERTY GET Number()AS LONG 'Property Get
PROPERTY = ClsSerialPortInfo.PortNumber
END PROPERTY
PROPERTY SET Number(BYVAL PortNumber AS LONG) 'Property Set
ClsSerialPortInfo.PortNumber = PortNumber
END PROPERTY
METHOD PortOpen ALIAS "PortOpen"() AS LONG 'Bogus Method just testing
METHOD = ClsSerialPortInfo.PortNumber
END METHOD
END INTERFACE
END CLASS
#ENDIF
'*** In the case that the compiler is not CLASS capable (IE: compiler version is less than 9)
'*** Place a conditional compile so all "Non-Com" code still compiles correctly
#IF (%PB_REVISION) > = &H900 '<-- If Compiler version is 9 or higher then its able to handle classes
FUNCTION GetClassNameId ALIAS "GetClassNameId"(ClassNameId AS STRING)EXPORT AS LONG
LOCAL ProgramName AS STRING
ClassNameId = PROGID$($ClsSerialPortGUID)
FUNCTION = %FALSE
END FUNCTION
#ENDIF
'*** PB CLASSIC
'*** Should work no matter the compiler
FUNCTION PortOpen ALIAS "PortOpen"() EXPORT AS LONG '<--- Amazingly enough a real function causes no conflict with a Method of the same name???
FUNCTION = 5
END FUNCTION
Code:
#DEBUG ERROR OFF 'Allow all errors to occur, even fatal ones
'#COMPILE EXE "PB9_Class_Object_DLL_Demo" 'If compiling as EXE
#COMPILE DLL "PB9 Class Object DLL Demo" 'If compiling as DLL
#DIM ALL 'Force a Dim on EVERYTHING
'*******************************************************************************************************
'*** In the case of TLBs....I never got it, but starting to understand thanks to PB Documentation
'*** Here is how I see it at the moment. If PB9 (or greater)
'*** 1.) Comment out the #RESOURCE to create a Type Library
'*** 2.) Put the Type Library into your *.RC file
'*** Format should look like:
'*** #include "resource.h"
'*** 1 typelib "PB9ClassObjectQuestionsDemo.tlb" '<--- Not sure what the meaning is, but hey all examples point this till I can find out
'*** 3.) Compile your resource file to include the TLB
'*** 4.) Uncomment the #RESOURCE and recompile the EXE or DLL to include the Type Library
'*******************************************************************************************************
#RESOURCE "PB9 Class Object DLL Demo.pbr" 'Include TLB in resource
'*** In the case that the compiler is not CLASS capable (IE: compiler version is less than 9)
'*** Place a conditional compile so all "Non-Com" code still compiles correctly
$ComName = "SerialPort" 'Com Name
#IF (%PB_REVISION) > = &H900 '<--- If Compiler version is 9 or higher then its able to handle classes
#COM NAME "SerialPort" '<--- Give the Com a name '<--- Not sure why using $ComName causes an error for "String constant expected"
'*** Select a GUID to keep minor changes constant (or at least through development)
'*** You can create your own, but if not sure how or what then do the following:
'*** (Thank you to To Kev Peel for answering this one at [url="http://www.powerbasic.com/support/pbforums/showthread.php?t=38522"]PB CrossOver Question[/url]
'*** [quote] Right click in IDE > Insert GUID. That GUID is a permanent, unique value for you. [/quote]
$DllGUID = GUID$("{ABFB1E29-D3EB-4CA1-8909-ABC06CC4F32D}")
#COM GUID $DllGUID '<--- Select a GUID to keep minor changes constant (or at least through development)
'*** Create the Type Library
'*** There is a command line tool to do this ("PBTYPE.EXE")...but I have not had the chance to research this yet
#COM TLIB ON 'Create a TLIB '<---Later add to *.rc so other languages can find it '<---Still Unknown how they do it, but seems typical they all have it this way
#ENDIF
%USEMACROS = 1 'Use Macros
#INCLUDE "Win32API.inc" 'Include Windows API
'#include "ErrorHandling.inc" 'Error Handling
#INCLUDE "DllRegisterServer.inc" 'My begginning example to not have to use RegSvr32 to register the COM '<--- Just works for the moment...bullet proof later
#INCLUDE "SerialPortFunctions.inc" 'My begginning example of Real-World use of COM
'*** Declares
DECLARE FUNCTION PBMAIN () AS LONG
DECLARE FUNCTION LIBMAIN (BYVAL hInstance AS LONG, BYVAL fwdReason AS LONG, BYVAL lpvReserved AS LONG) AS LONG
DECLARE FUNCTION Demo ALIAS "Demo"() AS LONG
'*** If Compiled as EXE then PBMAIN called
'*** Start Main Program ***
FUNCTION PBMAIN () AS LONG
Demo
END FUNCTION
'*** If Compiled as DLL then LibMain is Called
'---------------------------------------------------------------------------------------------------------
' Main DLL entry point called by Windows...
'---------------------------------------------------------------------------------------------------------
FUNCTION LIBMAIN (BYVAL hInstance AS LONG, BYVAL fwdReason AS LONG, BYVAL lpvReserved AS LONG) AS LONG
SELECT CASE fwdReason
CASE %DLL_PROCESS_ATTACH
'Indicates that the DLL is being loaded by another process (a DLL
'or EXE is loading the DLL). DLLs can use this opportunity to
'initialize any instance or global data, such as arrays.
FUNCTION = 1 'success!
'FUNCTION = 0 'failure! This will prevent the EXE from running.
CASE %DLL_PROCESS_DETACH
'Indicates that the DLL is being unloaded or detached from the
'calling application. DLLs can take this opportunity to clean
'up all resources for all threads attached and known to the DLL.
FUNCTION = 1 'success!
'FUNCTION = 0 'failure!
' Kill the dialog and let PBMAIN() continue
CASE %DLL_THREAD_ATTACH
'Indicates that the DLL is being loaded by a new thread in the
'calling application. DLLs can use this opportunity to
'initialize any thread local storage (TLS).
FUNCTION = 1 'success!
'FUNCTION = 0 'failure!
CASE %DLL_THREAD_DETACH
'Indicates that the thread is exiting cleanly. If the DLL has
'allocated any thread local storage, it should be released.
FUNCTION = 1 'success!
END SELECT
END FUNCTION
'*** My lil Testing Function of mixing COM with Procedural PB code
FUNCTION Demo ALIAS "Demo"()EXPORT AS LONG
'*** In the case that the compiler is not CLASS capable (IE: compiler version is less than 9)
'*** Place a conditional compile so all "Non-Com" code still compiles correctly
#IF (%PB_REVISION) > = &H900 '<-- If Compiler version is 9 or higher then its able to handle classes
LOCAL SerialPort AS iSerialPort 'Declare a variable as the local Class Interface
LOCAL SerialPort2 AS iSerialPort 'Declare a variable as the local Class Interface
'*** MsgBox Demo from within the DLL (if compiled that way) or from the EXE
LOCAL Msg AS STRING
SerialPort = CLASS "ClsSerialPort"
SerialPort2 = CLASS "ClsSerialPort"
SerialPort.Number = 1
SerialPort2.Number = 10
Msg = Msg + "Compiled under PB9 for a COM interface"
Msg = Msg + $CR + "The following are found from within PB itself, and not VB"
Msg = Msg + $CR + "Object 1 Set Property = " + STR$(SerialPort.Number) + $CR + "Object 1 Get Property = " + STR$(SerialPort.PortOpen)
Msg = Msg + $CR + "Object 2 Set Property = " + STR$(SerialPort2.Number) + $CR + "Object 2 Get Property = " + STR$(SerialPort2.PortOpen)
Msg = Msg + $CR + "Classic PB Function = " + STR$(PortOpen)
MSGBOX Msg
Msg = ""
#ENDIF
'*** For both Non-Com and COM capable tests
Msg = Msg + "Compiled under version: " + LEFT$(HEX$(%PB_REVISION),1) + "." + MID$(HEX$(%PB_REVISION),2) '<--- Format the revision to something readable
MSGBOX Msg
END FUNCTION
Code:
Private Declare Function Demo Lib "PB9 Class Object DLL Demo.dll" () As Long
Private Declare Function RegUnReg Lib "PB9 Class Object DLL Demo.dll" (ByVal inFileSpec As String, Registering As Long) As String
Private Declare Function GetClassNameId Lib "PB9 Class Object DLL Demo.dll" (ClassObjectId As String) As Long
Public Ref As Object
Private Sub Command1_Click()
Dim MyClassName As String
Dim MyClass As Object
Dim MyClass2 As Object
ChDir App.Path
RegUnReg CurDir + "\PB9 Class Object DLL Demo.dll", 1
GetClassNameId MyClassName
Set MyClass = CreateObject(MyClassName)
Set MyClass2 = CreateObject(MyClassName)
MyClass.Number = 1
MyClass2.Number = 4
MsgBox "VB Class 1 Port Number = " + Str(MyClass.Number) + vbCr + "VB Class 2 Port Number = " + Str(MyClass2.Number)
Demo
RegUnReg CurDir + "\PB9 Class Object DLL Demo.dll", 0
End Sub
Discussion can be done at Pb Dll in VB - Early/Late Binding, or PB "Classic"
Have fun