Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Pb Dll in VB - Early/Late Binding, or PB "Classic"

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Pb Dll in VB - Early/Late Binding, or PB "Classic"

    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)
    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
    PB DLL - "SerialPortFunctions.inc" (Functions to be added for true serial port control, but this is just for demo)
    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 PB CrossOver Question
    '*** 
    Right click in IDE > Insert GUID. That GUID is a permanent, unique value for you.
    $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
    PB DLL - "PB9 Class Demo.bas"
    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 PB CrossOver Question
    '*** 
    Right click in IDE > Insert GUID. That GUID is a permanent, unique value for you.
    $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
    VB EXE - Form1.bas
    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
    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
    Attached Files
    Engineer's Motto: If it aint broke take it apart and fix it

    "If at 1st you don't succeed... call it version 1.0"

    "Half of Programming is coding"....."The other 90% is DEBUGGING"

    "Document my code????" .... "WHYYY??? do you think they call it CODE? "
Working...
X