• Welcome to PlanetSquires Forums.
 

CWindow RC06

Started by José Roca, May 08, 2016, 02:21:23 AM

Previous topic - Next topic

José Roca

#15
I have learned a technique that eases a little the use of COM interfaces with FB.

The classic way is to do this kind of declaration:


TYPE IDictionaryVtbl
   ' // IDispatch interface
   QueryInterface AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL riid AS CONST IID CONST PTR, BYVAL ppvObject AS any ptr PTR) AS HRESULT
   AddRef AS FUNCTION (BYVAL this AS IDictionary PTR) AS ULONG
   Release AS FUNCTION (BYVAL this AS IDictionary PTR) AS ULONG
   GetTypeInfoCount AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL pctinfo AS UINT PTR) AS HRESULT
   GetTypeInfo AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL iTInfo AS UINT, BYVAL lcid AS LCID, BYVAL ppTInfo AS ITypeInfo ptr PTR) AS HRESULT
   GetIDsOfNames AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL riid AS CONST IID CONST PTR, BYVAL rgszNames AS LPOLESTR PTR, BYVAL cNames AS UINT, BYVAL lcid AS LCID, BYVAL rgDispId AS DISPID PTR) AS HRESULT
   Invoke AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL dispIdMember AS DISPID, BYVAL riid AS CONST IID CONST PTR, BYVAL lcid AS LCID, BYVAL wFlags AS WORD, BYVAL pDispParams AS DISPPARAMS PTR, BYVAL pVarResult AS VARIANT PTR, BYVAL pExcepInfo AS EXCEPINFO PTR, BYVAL puArgErr AS UINT PTR) AS HRESULT
   ' // IDictionary interface
   putref_Item AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL vKey AS VARIANT PTR, BYVAL pRetItem AS VARIANT PTR) AS HRESULT
   put_Item AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL vKey AS VARIANT PTR, BYVAL vNewItem AS VARIANT PTR) AS HRESULT
   get_Item AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL vKey AS VARIANT PTR, BYVAL vRetItem AS VARIANT PTR) AS HRESULT
   Add AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL vKey AS VARIANT PTR, BYVAL vItem AS VARIANT PTR) AS HRESULT
   get_Count AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL pCount AS long PTR) AS HRESULT
   Exists AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL vKey AS VARIANT PTR, BYVAL pExists AS SHORT PTR) AS HRESULT
   Items AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL pItemsArray AS VARIANT PTR) AS HRESULT
   put_Key AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL vKey AS VARIANT PTR, BYVAL vItem AS VARIANT PTR) AS HRESULT
   Keys AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL pKeysArray AS VARIANT PTR) AS HRESULT
   Remove AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL vKey AS VARIANT PTR) AS HRESULT
   RemoveAll AS FUNCTION (BYVAL this AS IDictionary PTR) AS HRESULT
   put_CompareMode AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL pcomp AS COMPAREMETHOD) AS HRESULT
   get_CompareMode AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL pcomp AS COMPAREMETHOD PTR) AS HRESULT
   _NewEnum AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL ppunk AS IUnknown PTR PTR) AS HRESULT
   get_HashVal AS FUNCTION (BYVAL this AS IDictionary PTR, BYVAL vKey AS VARIANT PTR, BYVAL HashVal AS VARIANT PTR) AS HRESULT
END TYPE

TYPE IDictionary_
   lpVtbl AS IDictionaryVtbl PTR
END TYPE


and use it as


DIM pDic AS IDictionary PTR
hr = CoCreateInstance(@CLSID_Dictionary, NULL, CLSCTX_INPROC_SERVER, @IID_IDictionary, @pDic)

DIM vKey AS VARIANT
VariantClear(@vKey)
V_VT(@vKey) = VT_BSTR
V_BSTR(@vKey) = SysAllocString("a")

DIM vItem AS VARIANT
VariantClear(@vItem)
V_VT(@vItem) = VT_BSTR
V_BSTR(@vItem) = SysAllocString("Athens")

pDic->lpVtbl->Add(pDic, @vKey, @vItem)

VariantClear(@vItem)
pDic->lpVtbl->get_Item(pDic, @vKey, @vItem)

VariantClear(@vKey)
VariantClear(@vItem)

IF pDic THEN pDic->lpVtbl->Release(pDic)


Continued in the next post.

José Roca

#16
But by declaring the methods of the interfaces as ABSTRACT (the IUnknown interface inherits from OBJECT, a built-in type).


TYPE Afx_IUnknown as Afx_IUnknown_
TYPE Afx_IUnknown_ EXTENDS OBJECT
DECLARE ABSTRACT FUNCTION QueryInterface (BYVAL riid AS REFIID, BYVAL ppvObject AS LPVOID PTR) AS HRESULT
DECLARE ABSTRACT FUNCTION AddRef() AS ULONG
DECLARE ABSTRACT FUNCTION Release() AS ULONG
END TYPE
TYPE AFXLPUNKNOWN as Afx_IUnknown PTR

TYPE Afx_IDispatch AS Afx_IDispatch_
TYPE Afx_IDispatch_  EXTENDS Afx_Iunknown
   DECLARE ABSTRACT FUNCTION GetTypeInfoCount (BYVAL pctinfo AS UINT PTR) as HRESULT
   DECLARE ABSTRACT FUNCTION GetTypeInfo (BYVAL iTInfo AS UINT, BYVAL lcid AS LCID, BYVAL ppTInfo AS ITypeInfo PTR PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION GetIDsOfNames (BYVAL riid AS CONST IID CONST PTR, BYVAL rgszNames AS LPOLESTR PTR, BYVAL cNames AS UINT, BYVAL lcid AS LCID, BYVAL rgDispId AS DISPID PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION Invoke (BYVAL dispIdMember AS DISPID, BYVAL riid AS CONST IID CONST PTR, BYVAL lcid AS LCID, BYVAL wFlags AS WORD, BYVAL pDispParams AS DISPPARAMS PTR, BYVAL pVarResult AS VARIANT PTR, BYVAL pExcepInfo AS EXCEPINFO PTR, BYVAL puArgErr AS UINT PTR) AS HRESULT  
END TYPE
TYPE AFX_LPDISPATCH AS Afx_IDispatch PTR

TYPE Afx_IDictionary AS Afx_IDictionary_
TYPE Afx_IDictionary_ EXTENDS Afx_IDispatch
   DECLARE ABSTRACT FUNCTION putref_Item (BYVAL vKey AS VARIANT PTR, BYVAL pRetItem AS VARIANT PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION put_Item (BYVAL vKey AS VARIANT PTR, BYVAL vNewItem AS VARIANT PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION get_Item (BYVAL vKey AS VARIANT PTR, BYVAL vRetItem AS VARIANT PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION Add (BYVAL vKey AS VARIANT PTR, BYVAL vItem AS VARIANT PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION get_Count (BYVAL pCount AS long PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION Exists (BYVAL vKey AS VARIANT PTR, BYVAL pExists AS SHORT PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION Items (BYVAL pItemsArray AS VARIANT PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION put_Key (BYVAL vKey AS VARIANT PTR, BYVAL vItem AS VARIANT PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION Keys (BYVAL pKeysArray AS VARIANT PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION Remove (BYVAL vKey AS VARIANT PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION RemoveAll () AS HRESULT
   DECLARE ABSTRACT FUNCTION put_CompareMode (BYVAL pcomp AS COMPAREMETHOD) AS HRESULT
   DECLARE ABSTRACT FUNCTION get_CompareMode (BYVAL pcomp AS COMPAREMETHOD PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION _NewEnum (BYVAL ppunk AS IUnknown PTR PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION get_HashVal (BYVAL vKey AS VARIANT PTR, BYVAL HashVal AS VARIANT PTR) AS HRESULT
END TYPE
TYPE AFX_LPDICTIONARY AS Afx_IDictionary PTR


the calls to the interface methods can use a simplified syntax:


pDic->Add(@vKey, @vItem)
pDic->get_Item(@vKey, @vItem)
pDic->Release


That is, without having to add ->lpVtbl and having to always pass the this pointer as the first parameter.


pDic->lpVtbl->Add(pDic, @vKey, @vItem)
pDic->lpVtbl->get_Item(pDic, @vKey, @vItem)
pDic->lpVtbl->Release(pDic)


Paul Squires

Quote from: Jose Roca on May 08, 2016, 02:56:09 AM
Hi Paul,

If you want to report a bug to dkl....

He has changed


type WCHAR as wstring
type PWCHAR as wstring ptr
type LPWCH as wstring ptr
type PWCH as wstring ptr
type LPCWCH as const wstring ptr
type PCWCH as const wstring ptr


to


type WCHAR as wchar_t
type PWCHAR as WCHAR ptr
type LPWCH as WCHAR ptr
type PWCH as WCHAR ptr
type LPCWCH as const WCHAR ptr
type PCWCH as const WCHAR ptr


both in stddef.bi and winnt.bi.

As a result, if you use this test code


DIM pbstr AS BSTR
pbstr = SysAllocString("This is a test")
print *pbstr
SysFreeString(pbstr)

print "press esc"
sleep


It prints 84, that is the ASC code of the first character.

If I #undef BSTR and define it as WSTRING PTR, it works:


#undef BSTR
TYPE BSTR AS WSTRING PTR

DIM pbstr AS BSTR
pbstr = SysAllocString("This is a test")
print *pbstr
SysFreeString(pbstr)



Jose, which version of FB were you using prior to the one where you noticed the change? I looked at several of the latest FB versions and this is what I think the BSTR definition resolves to (it seems to match the C header files I saw as well):


wtypes.bi
Type BSTR As OLECHAR Ptr

wtypesbase.bi
type OLECHAR as WCHAR

winnt.bi
Type WCHAR As wchar_t

stddef.bi
#ifdef __FB_DOS__
type wchar_t as ubyte
#elseif defined( __FB_WIN32__ ) or defined( __FB_CYGWIN__ )
type wchar_t as ushort
#else
type wchar_t as long
#endif


So, it seems to resolve to wchar_t (which is a long or ushort depending on platform).

Then I saw this:  http://stackoverflow.com/questions/1607266/whats-the-meaning-of-bstr-lpcolestr-and-others

Does this mean that for every time you use a BSTR you would have to CAST it?

*cast(wstring ptr, pbstr)


Paul Squires
PlanetSquires Software
WinFBE Editor and Visual Designer

José Roca

#18
Quote
Does this mean that for every time you use a BSTR you would have to CAST it?
*cast(wstring ptr, pbstr)

Yes. I think that I'm going to define my own type. WCHAR can only contain a unicode character, therefore a BSTR can't be a WCHAR, but an array of WCHARs. What they have done is like if we defined a STRING as of type UBYTE.

In the file AfxCOM.inc that I'm currently writing, I already have defined the two base types that allow the use of abstract methods, simplifying the syntax.


#ifndef __Afx_IUnknown_INTERFACE_DEFINED__
#define __Afx_IUnknown_INTERFACE_DEFINED__
TYPE Afx_IUnknown AS Afx_IUnknown_
TYPE Afx_IUnknown_ EXTENDS OBJECT
DECLARE ABSTRACT FUNCTION QueryInterface (BYVAL riid AS REFIID, BYVAL ppvObject AS LPVOID PTR) AS HRESULT
DECLARE ABSTRACT FUNCTION AddRef() AS ULONG
DECLARE ABSTRACT FUNCTION Release() AS ULONG
END TYPE
TYPE AFXLPUNKNOWN AS Afx_IUnknown PTR
#endif

#ifndef __Afx_IDispatch_INTERFACE_DEFINED__
#define __Afx_IDispatch_INTERFACE_DEFINED__
TYPE Afx_IDispatch AS Afx_IDispatch_
TYPE Afx_IDispatch_  EXTENDS Afx_Iunknown
   DECLARE ABSTRACT FUNCTION GetTypeInfoCount (BYVAL pctinfo AS UINT PTR) as HRESULT
   DECLARE ABSTRACT FUNCTION GetTypeInfo (BYVAL iTInfo AS UINT, BYVAL lcid AS LCID, BYVAL ppTInfo AS ITypeInfo PTR PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION GetIDsOfNames (BYVAL riid AS CONST IID CONST PTR, BYVAL rgszNames AS LPOLESTR PTR, BYVAL cNames AS UINT, BYVAL lcid AS LCID, BYVAL rgDispId AS DISPID PTR) AS HRESULT
   DECLARE ABSTRACT FUNCTION Invoke (BYVAL dispIdMember AS DISPID, BYVAL riid AS CONST IID CONST PTR, BYVAL lcid AS LCID, BYVAL wFlags AS WORD, BYVAL pDispParams AS DISPPARAMS PTR, BYVAL pVarResult AS VARIANT PTR, BYVAL pExcepInfo AS EXCEPINFO PTR, BYVAL puArgErr AS UINT PTR) AS HRESULT
END TYPE
TYPE AFX_LPDISPATCH AS Afx_IDispatch PTR
#endif


BTW which name do you think would be more appropriate for the overloaded function AfxNewCom? Maybe AfxNewObj, AfxNewObject, AfxCreateObject?

José Roca

> Jose, which version of FB were you using prior to the one where you noticed the change?

I was using version 1.04, but I think that the headers were the ones of version 1.02.

FreeBASIC binding for mingw-w64-v4.0.1

The ones that I'm using now:

FreeBASIC binding for mingw-w64-v4.0.4

José Roca

#20
@Hi Paul,

I have found a solution for the "A" and "W" functions.

Ihave written these two helper functions:


' ========================================================================================
' Translates ansi bytes into unicode bytes.
' ========================================================================================
FUNCTION AfxUCode (BYREF strIn AS STRING) AS STRING
   IF VARPTR(strIn) = 0 OR LEN(strIn) = 0 THEN EXIT FUNCTION
   IF IsTextUnicode(STRPTR(strIn), LEN(strIn), NULL) = 1 THEN FUNCTION = strIn : EXIT FUNCTION
   DIM buffer AS STRING = SPACE(LEN(strIn) * 2)
   DIM nLen AS LONG = MultiByteToWidechar(CP_ACP, MB_PRECOMPOSED, STRPTR(strIn), -1, CAST(WSTRING PTR, STRPTR(buffer)), LEN(buffer))
   FUNCTION = buffer
END FUNCTION
' ========================================================================================

' ========================================================================================
' Translates unicode bytes into ansi bytes.
' ========================================================================================
FUNCTION AfxACode (BYREF strIn AS STRING) AS STRING
   IF VARPTR(strIn) = 0 OR LEN(strIn) = 0 THEN EXIT FUNCTION
   IF IsTextUnicode(STRPTR(strIn), LEN(strIn), NULL) = 0 THEN FUNCTION = strIn : EXIT FUNCTION
   DIM buffer AS STRING = SPACE(LEN(strIn) \ 2)
   DIM nLen AS LONG = WidecharToMultiByte(CP_ACP, 0, CAST(WSTRING PTR, STRPTR(strIn)), -1, STRPTR(buffer), LEN(buffer), NULL, NULL)
   FUNCTION = buffer
END FUNCTION
' ========================================================================================


Now I can write this:


' ========================================================================================
' Returns the complete drive, path, file name, and extension of the program which is
' currently executing.
' ========================================================================================
FUNCTION AfxGetExePathNameA () AS STRING
   DIM buffer AS STRING * MAX_PATH + 1
   GetModuleFileNameA NULL, STRPTR(buffer), LEN(buffer)
   DIM p AS LONG = INSTRREV(buffer, ANY ":/\")
   FUNCTION = LEFT(buffer, p)
END FUNCTION
' ========================================================================================
' ========================================================================================
FUNCTION AfxGetExePathNameW () AS STRING
   DIM buffer AS WSTRING * MAX_PATH
   GetModuleFileNameW NULL, buffer, SIZEOF(buffer)
   DIM p AS LONG = INSTRREV(buffer, ANY ":/\")
   FUNCTION = AfxUcode(LEFT(buffer, p))
END FUNCTION
' ========================================================================================


AfxGetExePathNameW will return an ansi string with unicode contents. The trick is to use AfxUcode when returning the string to bypass the FB automatic conversion to ansi (in the above code, FUNCTION = AfxUcode(LEFT(buffer, p))). AfxUcode checks if the string is already in unicode format to no convert a unicode string to unicode again.

These ansi strings with unicode content can be used in place of BSTRs when calling API functions that require a BSTR, as we did with PowerBasic 9, passing the STRPTR of the variable.

This way, we don't need to worry about having to free the BSTRs.

José Roca

#21
There is a problem. Like with PB 9, the parameter of the function must be declared as STRING instead of BSTR.

This is a show stopper because we aren't going to change the declares.

Paul Squires

Quote from: Jose Roca on May 11, 2016, 07:05:43 AM
There is a problem. Like with PB 9, the parameter of the function must be declared as STRING instead of BSTR.

This is a show stopper because we aren't going to change the declares.

Hi Jose,

Which function are you talking about here? Is there a possibility of overloading the function call and then call the string function?

Here is something that appears to work. I just simply picked SysAllocString as an example.


#Include Once "windows.bi"

Type BSTR As OLECHAR Ptr
Declare Function SysAllocString Overload ( ByVal myValue As Long ) As BSTR

#Include Once "win/ole2.bi"


Function SysAllocString( ByVal myValue As Long ) As BSTR
   Function = SysAllocString(Str(myValue))
End Function


Dim pbstr As BSTR
pbstr = SysAllocString("This is a test")
Print *cast(wstring ptr, pbstr)
SysFreeString(pbstr)

pbstr = SysAllocString(999)
Print *Cast(WString Ptr, pbstr)
SysFreeString(pbstr)

Print "press esc"
Sleep

Paul Squires
PlanetSquires Software
WinFBE Editor and Visual Designer

José Roca

#23
> Which function are you talking about here?

Any function that has a wide string parameter. If we pass to it an ansi string containing unicode characters, FB  only sees that the type of the passeed string is ansi and converts it to unicode again.

Example:


SUB foo (BYVAL b AS WSTRING PTR)
   print *b; "..."
END SUB

foo(AfxUcode("pepe"))


The only way that works is to return a pointer to a BSTR or a WSTRING and then free it.

Paul Squires

#24
If you pass it BYVAL b AS CONST WSTRING PTR, will FB do any conversion?
..... it probably will. CONST only keeps the pointer from not being modified and not the string it points to (I assume).

Or,

FUNCTION AfxUCode (BYREF strIn AS CONST STRING) AS STRING
Paul Squires
PlanetSquires Software
WinFBE Editor and Visual Designer

José Roca

It isn't worth the effort. With PB9 we could use strings in combination with UCODE$ and ACODE$ because they are BSTRs with ansi contents. This is the opposite, ASCIIZ strings with unicode content. Therefore, we can't use them with parameters that will receive a BSTR. And using one method when we want to pass a BSTR and another when we will receive a BSTR is not consistent.

We have tried, but if it can't be, it can't be. If FB does not implement native BSTR support, we will have to use the BSTR API and allocate and free the strings.

José Roca

I have tried the new way to declare interfaces and works fine. They should use it in the headers besides the already existing ones of VTable and macros.

Will do more testing when they fix the broken headers.

Paul Squires

Thanks Jose, I haven't followed all the cases where you need to pass a BSTR or receive a BSTR. However, I was thinking about your AfxUCode function and thought that maybe if you made it so you just passed it a pointer to the string and a length then it would be generic enough to handle any type of string passed to it?


' ========================================================================================
' Translates ansi bytes into unicode bytes.
' ========================================================================================
Function AfxUCode (ByVal strIn As Any Ptr, ByVal strLength As Long) As String
   If strIn = 0 Or strLength = 0 Then Exit Function
   Dim buffer As String = Space(strLength * 2)
   If IsTextUnicode(strIn, strLength, Null) = 1 Then
Print "already unicode"   
      ' String is already unicode
      memcpy(Strptr(buffer), strIn, strLength * 2)
   Else
      ' String is not unicode. Do the conversion.
Print "convert to unicode"
      Dim nLen As Long = MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, Cast(ZString Ptr, strIn), -1, Strptr(buffer), Len(buffer))
   End If
   Function = buffer
End Function


Dim As String st = "This is a test"
Print AfxUCode( Strptr(st), Len(st) )

Dim wst As WString * 10 = "Paul"
Print AfxUCode( Strptr(wst), Len(wst) )


Print "press esc"
Sleep

Paul Squires
PlanetSquires Software
WinFBE Editor and Visual Designer

José Roca

#28
The purpose of these functions was to try something as we did with PB9. Otherwise, it is not needed.

The more satisfactory method is the CBStr class that I wrote, although can't be used to create temporary BSTRs on the fly because of memory leaks.

José Roca

Another question are variants. We can use a class or procedures. Private procedures have the advantage of dead code removal and the disadvantage of not freeing the variant automatically.


'#define unicode
#INCLUDE ONCE "win/ole2.bi"

' ========================================================================================
' Initializes a variant from a string.
' ========================================================================================
PRIVATE FUNCTION VarFromStr OVERLOAD (BYVAL pwsz AS WSTRING PTR) AS VARIANT
   DIM v AS VARIANT
   VariantInit(@v)
   V_VT(@v) = VT_BSTR
   V_BSTR(@v) = SysAllocString(pwsz)
   FUNCTION = v
   VariantClear(@v)
END FUNCTION
' ========================================================================================

' ========================================================================================
PRIVATE SUB VarFromStr OVERLOAD (BYVAL pvar AS VARIANT PTR, BYVAL pwsz AS WSTRING PTR)
   IF pvar = NULL THEN EXIT SUB
   VariantClear(pvar)
   V_VT(pvar) = VT_BSTR
   V_BSTR(pvar) = SysAllocString(pwsz)
END SUB

' ========================================================================================
PRIVATE SUB VarFromStr OVERLOAD (BYREF v AS VARIANT, BYVAL pwsz AS WSTRING PTR)
   IF VARPTR(v) = NULL THEN EXIT SUB
   VariantClear(@v)
   V_VT(@v) = VT_BSTR
   V_BSTR(@v) = SysAllocString(pwsz)
END SUB
' ========================================================================================

DIM v AS VARIANT
v = VarFromStr("Athens")
print *CAST(WSTRING PTR, v.bstrVal)

VarFromStr(@v, "Paris")
print *CAST(WSTRING PTR, v.bstrVal)

VarFromStr(v, "Rome")
print *CAST(WSTRING PTR, v.bstrVal)

VariantClear(@v)

print
print "press esc"
Sleep