Calling PowerBASIC DLLs from FreeBASIC (dynamic strings)

[Paul Squires]

PowerBASIC uses BSTR strings whereas FreeBASIC uses a different implementation. This means that if you try to pass a string from a FreeBASIC program to a PowerBASIC DLL you will run into problems. I was working on some code to help a fellow FireFly user use Perfect Sync's SQLTools product so I thought that I would post some code here to help others.

SQLTools uses ANSI style BSTR strings. ie PowerBASIC dynamic strings.

I wrote a simple FreeBASIC string class called aString in order to handle the creation of the string via SysAllocStringByteLen and freeing of the string by SysFreeString. The beauty of this method is that you can treat aString almost like it is a native data type. With the scoping rules, the aString will have its Destructor method called automatically whenever the variable goes out of scope (eg at the end of a sub or function call). The Destructor automatically calls SysFreeString so the user never has to track and free the strings themselves. Pretty convenient.

aString.bi

Code Select Expand


#Pragma Once

#Include Once "win/ole2.bi"


Type aString
   ' Simple ANSI/BSTR type class to take a FreeBASIC string and create
   ' a PowerBASIC compatible string to pass to PowerBASIC created DLL's
   ' that use "String" parameters.
   ' Takes an ANSI string as input, and returns a BSTR that contains an ANSI string.
   ' Does not perform any ANSI-to-Unicode translation.
   Private:
      m_str As BSTR
     
   Public:
      Declare Constructor( ByRef xStr As Const String = "" )
      Declare Destructor()
      Declare Property handle() As BSTR
      Declare Property handle( ByVal bHandle As BSTR)
      Declare Property text() As String
      Declare Property text( ByRef xStr As Const String )
Declare Operator Let ( ByRef x As Const String )
End Type

Constructor aString( ByRef xStr As Const String )
   this.text = xStr
End Constructor

Destructor aString() 
   SysFreeString(m_str)
End Destructor

Property aString.handle( ByVal bHandle As BSTR)
   this.m_str = bHandle
End Property

Property aString.handle() As BSTR
   Property = this.m_str
End Property

Property aString.text() As String 
   Dim sTemp As String
   Dim psz   As ZString Ptr = Cast(zString Ptr, this.m_str)
   If this.m_str Then sTemp = *psz
   Property = sTemp
End Property

Property aString.text( ByRef xStr As Const String )
   SysFreeString(m_str)
   m_str = SysAllocStringByteLen(xStr, Len(xStr))  ' creates an ANSI BSTR
End Property

Operator aString.Let( ByRef rhs As Const String )
   this.text = rhs
End Operator




Here is an example:

Code Select Expand


Declare Function SetValue Lib "testdll_pb" (ByVal TheString As BSTR) As Integer

Sub DoSubroutine()

   ' Create and assign the string through the constructor
   Dim st As aString = "Paul Squires"
   
   ' Print out the text being held in the BSTR
   Print st.text
   
   ' Assign a new string to the BSTR using the LET operator
   st = "A new string using the LET operator"
   
   ' Print out the text being held in the BSTR
   Print st.text

   ' Assign a new string to the BSTR using the TEXT property
   st.text = "A new string assigned via the TEXT property"
   
   ' Print out the text being held in the BSTR
   Print st.text

   ' Call the external PB DLL that accepts a BSTR (pass the Handle property)
   Print "SetValue = "; SetValue(st.handle)                                 
   
   ' When this subroutine exits, the st variable will go out of
   ' scope and the destructor will be called freeing the allocated BSTR.
End Sub

DoSubroutine



Notice how I have declared the string for the PB DLL function.
ByVal TheString As BSTR

Instead of passing the actual string text to the PB DLL, you simply pass the handle property of the aString variable you created.
SetValue(st.handle)


Here is the code that I created that calls SQLTools, opens an Excel spreadsheet, queries a column for the name 'Paul' and returns the data. It works perfectly. The code below will not run for you because I have left out the customer's authorization code and a few equates. It does show you how to declare DLL functions and call PB DLL's using the BSTR and aString approach.

Code Select Expand


Extern "Windows-MS" Lib "SQLT3Std"
'-------------------------- Configuration Family --------------------------
    Declare Function  SQL_Authorize Lib "SQLT3Std.DLL" _
               Alias "SQL_Authorize" _
                     (ByVal lAuthCode As Long) _
                  As  Long

    Declare Function  SQL_Init Lib "SQLT3Std.DLL" _
               Alias "SQL_Init" _
                  As  Long

    Declare Function  SQL_Shutdown Lib "SQLT3Std.DLL" _
               Alias "SQL_Shutdown" _
                  As  Long

'-------------------------- Database Open/Close Family --------------------------
    Declare Function  SQL_OpenDB Lib "SQLT3Std.DLL" _
               Alias "SQL_OpenDB" _
                     (ByVal sConnectionString As BSTR, _
                      ByVal lPrompt As Long = 0, _
                      ByVal sIgnoreErrors As BSTR = 0) _
                  As  Long

    Declare Function  SQL_CloseDB Lib "SQLT3Std.DLL" _
               Alias "SQL_CloseDB" _
                  As  Long

'-------------------------- Statement Family --------------------------
    Declare Function  SQL_Stmt Lib "SQLT3Std.DLL" _
               Alias "SQL_Stmt" _
                     (ByVal lAction As Long, _
                      ByVal sStatement As BSTR, _
                      ByVal sIgnoreErrors As BSTR = 0) _
                  As  Long

    Declare Function  SQL_Fetch Lib "SQLT3Std.DLL" _
               Alias "SQL_Fetch" _
                     (ByVal lWhichRow As Long = 0, _
                      ByVal sIgnoreErrors As BSTR = 0) _
                  As  Long

    Declare Function  SQL_EOD Lib "SQLT3Std.DLL" _
               Alias "SQL_EOD" _
                  As  Long

'-------------------------- Result Column Family --------------------------
    Declare Function  SQL_ResColString Lib "SQLT3Std.DLL" _
               Alias "SQL_ResColString" _
                     (ByVal lColumnNumber As Long) _
                  As  BSTR

End Extern


Dim st As aString
Dim r  As Long

r = SQL_Authorize(&hxxxxxxxx)  '<-- enter your customer serial code here
Print "Authorize="; r

r = SQL_Init()
Print "Init="; r

st = "Driver={Microsoft Excel Driver (*.xls)};Driverid=790; ;FIRSTROWHASNAMES=1;READONLY=FALSE;Dbq=E:\FB\SQLTools\test.xls;DefaultDir=E:\FB\SQLTools;"
r = SQL_OpenDB(st.handle)
Print "OpenDB="; r

st = "SELECT * FROM `SHEET1$` WHERE `COL1` = 'Paul'"
r = SQL_Stmt(IMMEDIATE, st.handle)
Print "Stmt="; r

Dim i As Long
Do
   SQL_Fetch( NEXT_ROW )
   If SQL_EOD() <> 0 Then Exit Do
   i = i + 1
   st.handle = SQL_ResColString(1)
   Print "Row# "; i, st.text,
   st.handle = SQL_ResColString(2)
   Print st.text
Loop

r = SQL_CloseDB()
Print "CloseDB="; r

r = SQL_Shutdown()
Print "Shutdown="; r



You should create an import library for PB DLL. Refer to my post on MakeLIB for an easy way to do that.
http://www.planetsquires.com/protect/forum/index.php?topic=3675.msg27071

I hope this is useful. I am still learning so I may have to modify this post from time to time.

[José Roca]

I have written this one to deal with Unicode dynamic strings.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: AfxBstr.inc
' Contents: Windows wrapper functions.
' Copyright (c) 2015 Jose Roca
' Compiler: FreeBasic
' All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#pragma once

#include once "windows.bi"
#include once "win/ole2.bi"

' ========================================================================================
' AfxBstr class
' ========================================================================================
TYPE AfxBstr

   Private:
      m_bstr AS BSTR

   Public:
      DECLARE CONSTRUCTOR (BYREF wszStr AS CONST WSTRING = "")
      DECLARE DESTRUCTOR
      DECLARE PROPERTY Attach (BYVAL bstrHandle AS BSTR)
      DECLARE PROPERTY Assign (BYREF wszStr AS CONST WSTRING)
      DECLARE PROPERTY Handle () AS BSTR
      DECLARE FUNCTION Len () AS LONG
      DECLARE FUNCTION ToAnsi () AS STRING
      DECLARE PROPERTY FromAnsi (BYREF ansiText AS CONST STRING)
      DECLARE SUB MakeUpper
      DECLARE SUB MakeLower

END TYPE
' ========================================================================================

' ========================================================================================
' AfxBstr class constructor
' ========================================================================================
CONSTRUCTOR AfxBstr (BYREF wszBstr AS CONST WSTRING = "")
   this.Assign = wszBstr
END CONSTRUCTOR
' ========================================================================================

' ========================================================================================
' AfxBstr class destructor
' ========================================================================================
DESTRUCTOR AfxBstr
   IF m_bstr THEN SysFreeString m_bstr
END DESTRUCTOR
' ========================================================================================

' ========================================================================================
' Attaches a BSTR
' ========================================================================================
PROPERTY AfxBstr.Attach (BYVAL bstrHandle AS BSTR)
   IF m_bstr THEN SysFreeString(m_bstr)
   m_bstr = bstrHandle
END PROPERTY
' ========================================================================================

' ========================================================================================
' Assigns new text to the BSTR
' ========================================================================================
PROPERTY AfxBstr.Assign (BYREF wszStr AS CONST WSTRING)
   IF m_bstr THEN SysFreeString(m_bstr)
   m_bstr = SysAllocString(wszStr)
END PROPERTY
' ========================================================================================

' ========================================================================================
' Returns the handle of the BSTR
' ========================================================================================
PROPERTY AfxBstr.Handle () AS BSTR
   PROPERTY = m_bstr
END PROPERTY
' ========================================================================================

' ========================================================================================
' Returns the length of the BSTR in characters
' ========================================================================================
FUNCTION AfxBstr.Len () AS LONG
   IF m_bstr THEN FUNCTION = SysStringLen(m_bstr)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns the text of the string converted to ansi
' ========================================================================================
FUNCTION AfxBstr.ToAnsi () AS STRING
   IF m_bstr THEN FUNCTION = STR(*m_bstr)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Assigns ansi text to the BSTR after being converted to unicode.
' ========================================================================================
PROPERTY AfxBstr.FromAnsi (BYREF ansiText AS CONST STRING)
   this.Assign = WSTR(ansiText)
END PROPERTY
' ========================================================================================

' ========================================================================================
' Converts the string to upper case
' ========================================================================================
SUB AfxBstr.MakeUpper
   *m_bstr = UCASE(*m_bstr)
END SUB
' ========================================================================================

' ========================================================================================
' Converts the string to lower case
' ========================================================================================
SUB AfxBstr.MakeLower
   *m_bstr = LCASE(*m_bstr)
END SUB
' ========================================================================================


I have adapted my CSED editor (not yet finished) to work with FreeBasic. At least now I can work comfortably.

As I'm mainly interested in 64-bit and Unicode, can't use my OLE container. Will have to use ATL.DLL for now.

[Paul Squires]

Awesome Jose, thanks! 

[Marc Pons]

Thanks Jose , as always very goog  job.

My last adaptation for Csed_fb is in the forum , if you want sources , do not hesitate

marc

[José Roca]

Thanks, Marc. I already can compile FreeBasic programs with it and that's all I need. The changes are for private use and I'm not going to release the editor. For example, since I'm not going to work with Linux, I can continue using the MS Resource Compiler, so I'm not going to add support for GoRc.

Working with COM with this compiler is almost like if it was working with PB 6.1. No native support for Ole strings and variants, no automatic release of objects, classes that are very useful for other purposes, but not for COM, etc. A pain in the...

I don't think I'm going to do much work with this compiler. Just some tests from time to time to no lose my skills. Too much work to do.

Making cross compilers means to no fully support the Windows operating system.

[José Roca]

Learned to use namespaces to avoid conflicts with reserved words. Was having a conflict with the function Len and FB's LEN in the new function Append.

Wanted to use operators, such + and +=, but no luck except with Let. Anybody has succeeded?

In the Append function I'm using a clever solution borrowed from MFC to avoid to having to create an intermediate string. Can be used in other functions.

Code Select Expand


' ########################################################################################
' Microsoft Windows
' File: AfxBstr.inc
' Contents: Windows wrapper functions.
' Copyright (c) 2015 Jose Roca
' Compiler: FreeBasic
' All Rights Reserved.
' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
' EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
' MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
' ########################################################################################

#pragma once

#include once "windows.bi"
#include once "win/ole2.bi"
#include once "win/shlwapi.bi"

NAMESPACE Afx.Bstrings

' ========================================================================================
' AfxBstr - OLE strings class
' ========================================================================================
TYPE AfxBstr

   Private:
      m_bstr AS BSTR

   Public:
      DECLARE CONSTRUCTOR (BYREF wszStr AS CONST WSTRING = "")
      DECLARE DESTRUCTOR
      DECLARE PROPERTY Attach (BYVAL bstrHandle AS BSTR)
      DECLARE OPERATOR Let (BYREF wszStr AS CONST WSTRING)
      DECLARE PROPERTY Handle () AS BSTR
      DECLARE FUNCTION Len () AS LONG
      DECLARE FUNCTION ToAnsi () AS STRING
      DECLARE SUB MakeUpper
      DECLARE SUB MakeLower
      DECLARE SUB Append (BYREF wszStr AS WSTRING)
      DECLARE FUNCTION Compare (BYVAL pszStr1 AS LPCWSTR, BYVAL pszStr2 AS LPCWSTR) AS LONG
      DECLARE FUNCTION Equal (BYVAL pszStr1 AS LPCWSTR, BYVAL pszStr2 AS LPCWSTR) AS LONG

END TYPE
' ========================================================================================

' ========================================================================================
' AfxBstr class constructor
' ========================================================================================
CONSTRUCTOR AfxBstr (BYREF wszStr AS CONST WSTRING = "")
   m_bstr = SysAllocString(wszStr)
END CONSTRUCTOR
' ========================================================================================

' ========================================================================================
' AfxBstr class destructor
' ========================================================================================
DESTRUCTOR AfxBstr
   IF m_bstr THEN SysFreeString m_bstr
END DESTRUCTOR
' ========================================================================================

' ========================================================================================
' Attaches a BSTR
' ========================================================================================
PROPERTY AfxBstr.Attach (BYVAL bstrHandle AS BSTR)
   IF m_bstr THEN SysFreeString(m_bstr)
   m_bstr = bstrHandle
END PROPERTY
' ========================================================================================

' ========================================================================================
' Assigns new text to the BSTR
' Note: We can also pass a FB ansi string (the conversion to Unicode is automatic)
' ========================================================================================
OPERATOR AfxBstr.Let (BYREF wszStr AS CONST WSTRING)
   IF m_bstr THEN SysFreeString(m_bstr)
   m_bstr = SysAllocString(wszStr)
END OPERATOR
' ========================================================================================

' ========================================================================================
' Returns the handle of the BSTR
' ========================================================================================
PROPERTY AfxBstr.Handle () AS BSTR
   PROPERTY = m_bstr
END PROPERTY
' ========================================================================================

' ========================================================================================
' Returns the length of the BSTR in characters
' ========================================================================================
FUNCTION AfxBstr.Len () AS LONG
   IF m_bstr THEN FUNCTION = SysStringLen(m_bstr)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Returns the text of the string converted to ansi
' ========================================================================================
FUNCTION AfxBstr.ToAnsi () AS STRING
   IF m_bstr THEN FUNCTION = STR(*m_bstr)
END FUNCTION
' ========================================================================================

' ========================================================================================
' Converts the string to upper case
' ========================================================================================
SUB AfxBstr.MakeUpper
   *m_bstr = UCASE(*m_bstr)
END SUB
' ========================================================================================

' ========================================================================================
' Converts the string to lower case
' ========================================================================================
SUB AfxBstr.MakeLower
   *m_bstr = LCASE(*m_bstr)
END SUB
' ========================================================================================

' ========================================================================================
' Appends a string to the BSTR. The string can be a literal or a FB STRING or WSTRING variable.
' To append another BSTR:
' DIM bs AS AfxBstr = "1st string"
' DIM b2 AS AfxBstr = "2nd string"
' bs.Append *b2.Handle
' ========================================================================================
SUB AfxBstr.Append (BYREF wszStr AS WSTRING)
   DIM n1 AS UINT = SysStringLen(m_bstr)
   DIM nLen AS UINT = .LEN(wszStr)
   IF nLen = 0 THEN EXIT SUB
   DIM b AS BSTR = SysAllocStringLen(NULL, n1+nLen)
   IF b = NULL THEN EXIT SUB
   memcpy(b, m_bstr, n1 * SIZEOF(WSTRING))
   memcpy(b+n1, @wszStr, nLen * SIZEOF(WSTRING))
   SysFreeString(m_bstr)
   m_bstr = b
END SUB
' ========================================================================================

' ========================================================================================
' Compares two BSTRs
' Returns zero if the strings are identical. Returns a positive value if the string pointed
' to by lpStr1 is alphabetically greater than that pointed to by lpStr2. Returns a negative
' value if the string pointed to by lpStr1 is alphabetically less than that pointed to by lpStr2.
' ========================================================================================
FUNCTION AfxBstr.Compare (BYVAL pszStr1 AS LPCWSTR, BYVAL pszStr2 AS LPCWSTR) AS LONG
   FUNCTION = StrCmpW(pszStr1, pszStr2)
END FUNCTION
' ========================================================================================
' ========================================================================================
FUNCTION AfxBstr.Equal (BYVAL pszStr1 AS LPCWSTR, BYVAL pszStr2 AS LPCWSTR) AS LONG
   FUNCTION = StrCmpW(pszStr1, pszStr2) = 0
END FUNCTION
' ========================================================================================

END NAMESPACE


[José Roca]

Am I the only guy here interested in Unicode? Most of the humanity don't use English, and to display Unicode strings in a GUI the controls need to be Unicode aware. A control created with CreateWindowExW can be used by everybody; one created with CreateWindowEx don't.

[Paul Squires]

Am I the only guy here interested in Unicode?

I am extremely interested in unicode. I just have not converted the entire FireFly code generator to produce unicode compatible code. I would also need to convert the FireFly Functions library. Now that cWindow for FB is looking good, the transition to unicode in FireFly FB should be easier.

[David Warner]

I'm also interested in writing Unicode based applications. It would be great if FireFly offered a way to easily create a Unicode GUI for databases such as SQL Server.

[Jean-pierre Leroy]

Hi Paul,

I am extremely interested in unicode. I just have not converted the entire FireFly code generator to produce unicode compatible code. I would also need to convert the FireFly Functions library. Now that cWindow for FB is looking good, the transition to unicode in FireFly FB should be easier.

I'm also interested in Unicode; any chance to have at the same time an update of FireFly for PowerBASIC in an unicode flavor ?

Thanks,
Jean-Pierre