Author Topic: PowerBasic COM DLL - working sample with calls from VisualBasic Script  (Read 4162 times)

0 Members and 1 Guest are viewing this topic.

Offline Petr Schreiber

  • Full Member
  • ***
  • Posts: 183
  • User-Rate: +14/-4
Hi all,

I finally managed to make PB COM DLLs to run today. I do not claim the following is the best way to do it, I am open to suggestions :)

Step #1 - Write DLL code

Below is sample code, the important things are:
  • Enabling TLB generation with #COM TLIB ON
  • Adding placeholder for future resource file
  • Defining GUIDs ( context menu in PB/IDE helps you when you are out of fantasy )
  • Publishing CLASS "AS COM"
  • I guess it is polite co create ALIASes for methods, just like in case of normal DLL functions
  • Return values as VARIANT

Code: [Select]
' -- Target file name
#COMPILE DLL "MyComServer.dll"
#RESOURCE "MyComServer.pbr"

' -- Generate TLB
#COM TLIB ON

' -- Description
#COM DOC "This is COM server"
#COM NAME "MyComServer", 1.0

' -- Esoteric description via GUID :D
#COM GUID         GUID$("{D3A8963C-1751-4CDA-8A18-5657D1CAF627}")
$GUID_CLASSTEST = GUID$("{A92D26CD-EFCC-473D-9D7B-7818A79C673E}")
$GUID_INTERTEST = GUID$("{D1724ED9-4CE1-4CE0-8DCC-6311F136CF90}")
                      
CLASS ClassTest $GUID_CLASSTEST AS COM
  ' -- Instance variables
  INSTANCE hiddenValue AS LONG
    
  INTERFACE IMath $GUID_INTERTEST
    ' -- Inheriting IDISPATCH means big compatibility, but also the lowest performance
    INHERIT IDISPATCH
    
    ' -- Parameters can use PB types, PB is so kind to convert VARIANTs to LONG automagically, ...
    METHOD SetValue ALIAS "SetValue" ( value AS LONG )
      hiddenValue = value
    END METHOD
    
    ' -- We should return variant, as we never know who is calling :)
    METHOD GetValue ALIAS "GetValue" ( ) AS VARIANT
      METHOD = hiddenValue
    END METHOD

  END INTERFACE
END CLASS

'-------------------------------------------------------------------------------
' -- DLL entry point, not sure if needed
'-------------------------------------------------------------------------------
%DLL_PROCESS_DETACH = 0
%DLL_PROCESS_ATTACH = 1
%DLL_THREAD_ATTACH  = 2
%DLL_THREAD_DETACH  = 3
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!

    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!

        'FUNCTION = 0   'failure!

    END SELECT

END FUNCTION

Step #2 - Resource file

Create resource file from PB template

Code: [Select]
#include "resource.h"

// * Version info.
//
//

VS_VERSION_INFO VERSIONINFO
FILEVERSION 1, 0, 0, 0
PRODUCTVERSION 1, 0, 0, 0
FILEOS VOS_WINDOWS32
FILETYPE VFT_APP
BEGIN
  BLOCK "StringFileInfo"
  BEGIN
    BLOCK "040904B0"
    BEGIN
      VALUE "CompanyName",      "My Company, Inc.\000"
      VALUE "FileDescription",  "My Com Server\000"
      VALUE "FileVersion",      "01.00.0000\000"
      VALUE "InternalName",     "MyComServer\000"
      VALUE "OriginalFilename", "MyComServer.dll\000"
      VALUE "LegalCopyright",   "Copyright \251 2009 My Company, Inc.\000"
      VALUE "ProductName",      "My Com Server\000"
      VALUE "ProductVersion",   "01.00.0000\000"
      VALUE "Comments",         "Created in PB9\000"
    END
  END
  BLOCK "VarFileInfo"
  BEGIN
    VALUE "Translation", 0x409, 0x4B0
  END
END

Step #3 - Compile RC, Compile DLL

TLB file is also produced during the compilation, so open again your RC file and add line with link to TLB:

Code: [Select]
#include "resource.h"
1  typelib C:\UTIL\PBWIN90\MYWORK\COMSERVERTEMPLATE\MYCOMSERVER.TLB

// * Version info.
//
//

VS_VERSION_INFO VERSIONINFO
FILEVERSION 1, 0, 0, 0
PRODUCTVERSION 1, 0, 0, 0
FILEOS VOS_WINDOWS32
FILETYPE VFT_APP
BEGIN
  BLOCK "StringFileInfo"
  BEGIN
    BLOCK "040904B0"
    BEGIN
      VALUE "CompanyName",      "My Company, Inc.\000"
      VALUE "FileDescription",  "My Com Server\000"
      VALUE "FileVersion",      "01.00.0000\000"
      VALUE "InternalName",     "MyComServer\000"
      VALUE "OriginalFilename", "MyComServer.dll\000"
      VALUE "LegalCopyright",   "Copyright \251 2009 My Company, Inc.\000"
      VALUE "ProductName",      "My Com Server\000"
      VALUE "ProductVersion",   "01.00.0000\000"
      VALUE "Comments",         "Created in PB9\000"
    END
  END
  BLOCK "VarFileInfo"
  BEGIN
    VALUE "Translation", 0x409, 0x4B0
  END
END

Step #4 - Compile RC, Compile DLL again

Step #5 - Register DLL

Use something like:

Code: [Select]
regsvr32 MyComServer.dll

Step #6 - Make a test by calling from VBS

Use notepad to create following test file, save it with extension "VBS" ( Visual Basic Script ):

Code: [Select]
set objA = CreateObject("ClassTest")
set objB = CreateObject("ClassTest")

if IsObject(objA) = False or IsObject(objB) = False then
  msgbox "You probably forgot to register library?"
else
  objA.SetValue(1)
  objB.SetValue(2)

  msgbox "Value stored in objA: " & objA.GetValue()
  msgbox "Value stored in objB: " & objB.GetValue()

  set objA = Nothing
  set objB = Nothing
end if

You should see that it is possible to work with objects, each with custom instance data.


Petr
« Last Edit: August 16, 2010, 10:42:09 AM by Petr Schreiber »
AMD Sempron 3400+ | 1GB RAM @ 533MHz | GeForce 6200 / GeForce 9500GT | 32bit Windows XP SP3

psch.thinbasic.com