Contains many new wrappers and also changes to the CBSTR and CBWSTR classes to support UTF8.
Apparently, DIR doesn't work with unicode, so I have written the CFindFile class.
Example:
#define unicode
#INCLUDE ONCE "windows.bi"
#INCLUDE ONCE "Afx/CFindFile.inc"
USING Afx
DIM pFinder AS CFindFile
DIM cwsPath AS CWSTR = "C:\Users\Pepe\FreeBasic64\Tests\*.bas"
IF pFinder.FindFile(cwsPath) = S_OK THEN
DO
IF pFinder.IsDots = FALSE THEN ' // skip . and .. files
IF UCASE(pFinder.FileExt) = "BAS" THEN
PRINT pFinder.FileNameX
END IF
END IF
IF pFinder.FindNext = 0 THEN EXIT DO
LOOP
END IF
pFinder.Close
print
print "press any key"
sleep
' // After closing the search with the Close method, you can start a new
' // search without having to create a new instance of the CFindFile class.
cwsPath = "C:\Users\Pepe\FreeBasic64\Tests\*.exe"
IF pFinder.FindFile(cwsPath) = S_OK THEN
DO
IF pFinder.IsDots = FALSE THEN ' // skip . and .. files
IF UCASE(pFinder.FileExt) = "EXE" THEN
PRINT pFinder.FileNameX
END IF
END IF
IF pFinder.FindNext = 0 THEN EXIT DO
LOOP
END IF
pFinder.Close
print
print "press any key"
sleep
I have been working in the implementation of a wrapper class to deal with one-dimensional safe arrays of BSTRs. Still some work to do, but it is a promissing beginning. Maybe we will end with a new data type...
I'm doing this for two reasons: 1) because I will need it for COM programming; 2) because using arrays of WSTRs or CBSTRs doesn't look as a good option, since each element of the array will have more than 500 bytes of additional overhead.
' ########################################################################################
' Microsoft Windows
' File: CBSTRSA.inc
' Contents: Safe array wrapper class.
' Copyright (c) 2011 Jose Roca
' Portions Copyright (c) Microsoft Corporation
' 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 "win/oaidl.bi"
NAMESPACE Afx
' ========================================================================================
' Macro for debug
' To allow debugging, define _CBSTRSA_DEBUG_ 1 in your application before including this file.
' ========================================================================================
#ifndef _CBSTRSA_DEBUG_
#define _CBSTRSA_DEBUG_ 0
#ENDIF
#ifndef _CBSTRSA_DP_
#define _CBSTRSA_DP_ 1
#MACRO CBSTRSA_DP(st)
#IF (_CBSTRSA_DEBUG_ = 1)
OutputDebugStringW(st)
#ENDIF
#ENDMACRO
#ENDIF
' ========================================================================================
' ########################################################################################
' CBSTRSA - Safe array class
' ########################################################################################
TYPE CBSTRSA
Public:
DIM m_psa AS SAFEARRAY PTR
Public:
DECLARE CONSTRUCTOR
DECLARE CONSTRUCTOR (BYVAL lLBound AS LONG, BYVAL cElements AS DWORD)
DECLARE DESTRUCTOR
DECLARE FUNCTION LBound () AS LONG
DECLARE FUNCTION UBound () AS LONG
DECLARE FUNCTION Count () AS DWORD
DECLARE FUNCTION Create (BYVAL lLBound AS LONG, BYVAL cElements AS DWORD) AS SAFEARRAY PTR
DECLARE FUNCTION Redim (BYVAL cElements AS DWORD) AS HRESULT
DECLARE FUNCTION LocksCount () AS DWORD
DECLARE FUNCTION Copy () AS SAFEARRAY PTR
DECLARE FUNCTION CopyData (BYVAL psaTarget AS SAFEARRAY PTR) AS HRESULT
DECLARE FUNCTION PtrOfIndex (BYVAL idx AS LONG) AS ANY PTR
DECLARE FUNCTION AccessData () AS ANY PTR
DECLARE FUNCTION UnaccessData () AS HRESULT
DECLARE FUNCTION Get (BYVAL idx AS LONG) AS CBSTR
DECLARE FUNCTION Put (BYVAL idx AS LONG, BYREF cbs AS CBSTR) AS HRESULT
DECLARE FUNCTION Append (BYREF cbs AS CBSTR) AS HRESULT
DECLARE FUNCTION Destroy () AS HRESULT
DECLARE FUNCTION DestroyData () AS HRESULT
DECLARE FUNCTION Attach (BYVAL psaSrc AS SAFEARRAY PTR) AS HRESULT
DECLARE FUNCTION Detach () AS SAFEARRAY PTR
DECLARE FUNCTION GetPtr () AS SAFEARRAY PTR
DECLARE FUNCTION CopyFrom (BYVAL psaSrc AS SAFEARRAY PTR) AS HRESULT
END TYPE
' ========================================================================================
' CBSTRSA default constructor
' ========================================================================================
CONSTRUCTOR CBSTRSA
CBSTRSA_DP("CBSTRSA CONSTRUCTOR Default")
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
' Creates a one-dimensional BSTR safe array.
' Parameters:
' - lLBound: The lower bound value; that is, the index of the first element in the array.
' Can be negative.
' - cElements: The number of elements in the array.
' ========================================================================================
CONSTRUCTOR CBSTRSA (BYVAL lLBound AS LONG, BYVAL cElements AS DWORD)
CBSTRSA_DP("CBSTRSA CONSTRUCTOR - " & WSTR(lLBound) & " " & WSTR(cElements))
m_psa = this.Create(lLBound, cElements)
END CONSTRUCTOR
' ========================================================================================
' ========================================================================================
' Destroys the safe array when the class is destroyed
' ========================================================================================
DESTRUCTOR CBSTRSA
CBSTRSA_DP("CBSTRSA DESTRUCTOR - " & WSTR(m_psa))
IF m_psa THEN
SafeArrayUnlock(m_psa)
SafeArrayDestroy(m_psa)
END IF
END DESTRUCTOR
' ========================================================================================
' ========================================================================================
' Returns the lower bound for of a safe array.
' ========================================================================================
FUNCTION CBSTRSA.LBound () AS LONG
CBSTRSA_DP("CBSTRSA LBOUND")
IF m_psa = NULL THEN RETURN 0
DIM plLBound AS LONG
SafeArrayGetLBound(m_psa, 1, @plLBound)
RETURN plLBound
END FUNCTION
' ========================================================================================
' ========================================================================================
' Returns the upper bound for any dimension of a safe array.
' ========================================================================================
FUNCTION CBSTRSA.UBound () AS LONG
CBSTRSA_DP("CBSTRSA UBOUND")
IF m_psa = NULL THEN RETURN 0
DIM plUBound AS LONG
SafeArrayGetUBound(m_psa, 1, @plUBound)
RETURN plUBound
END FUNCTION
' ========================================================================================
' ========================================================================================
' Returns the number of elements in the the array.
' ========================================================================================
FUNCTION CBSTRSA.Count () AS DWORD
CBSTRSA_DP("CBSTRSA COUNT")
IF m_psa = NULL THEN RETURN 0
DIM plLBound AS LONG, plUBound AS LONG
SafeArrayGetLBound(m_psa, 1, @plLBound)
SafeArrayGetUBound(m_psa, 1, @plUBound)
RETURN plUbound - plLBound + 1
END FUNCTION
' ========================================================================================
' ========================================================================================
' Changes the right-most (least significant) bound of a safe array.
' Parameter:
' - cElements: Number of elements of the array.
' Remarks:
' If you reduce the bound of an array, SafeArrayRedim deallocates the array elements
' outside the new array boundary. If the bound of an array is increased, SafeArrayRedim
' allocates and initializes the new array elements. The data is preserved for elements
' that exist in both the old and new array.
' Return value:
' S_OK Success.
' E_FAIL Failure.
' DISP_E_ARRAYISLOCKED The array is locked.
' ========================================================================================
FUNCTION CBSTRSA.Redim (BYVAL cElements AS DWORD) AS HRESULT
CBSTRSA_DP("CBSTRSA REDIM")
IF m_psa = NULL THEN RETURN E_FAIL
DIM psaboundNew AS SAFEARRAYBOUND
psaboundNew.cElements = cElements
psaboundNew.lLBound = m_psa->rgsabound(0).lLBound
SafeArrayUnlock(m_psa)
DIM hr AS HRESULT = SafeArrayRedim(m_psa, @psaboundNew)
SafeArrayLock(m_psa)
RETURN hr
END FUNCTION
' ========================================================================================
' ========================================================================================
' Returns the number of Number of times the array has been locked without
' the corresponding unlock.
' ========================================================================================
FUNCTION CBSTRSA.LocksCount () AS DWORD
CBSTRSA_DP("CBSTRSA LOCKSCOUNT")
IF m_psa THEN RETURN m_psa->cLocks
END FUNCTION
' ========================================================================================
' ========================================================================================
' Creates a copy of the safe array.
' Return value:
' Pointer of the new array descriptor. You must free this pointer calling the API
' function SafeArrayDestroy.
' ========================================================================================
FUNCTION CBSTRSA.Copy () AS SAFEARRAY PTR
CBSTRSA_DP("CBSTRSA COPY")
DIM psaOut AS SAFEARRAY PTR
IF m_psa THEN SafeArrayCopy(m_psa, @psaOut)
RETURN psaOut
END FUNCTION
' ========================================================================================
' ========================================================================================
' Copies the source array to the target array after releasing any resources in the
' target array. This is similar to SafeArrayCopy, except that the target array has
' to be set up by the caller. The target is not allocated or reallocated.
' Parameter:
' - psaTarget
' The target safe array. On exit, the array referred to by psaTarget contains a
' copy of the data in m_psa.
' Return value:
' S_OK Success.
' E_FAIL Failure.
' E_INVALIDARG The dimensions or the number of dimensions don't match.
' E_OUTOFMEMORY Insufficient memory to create the copy.
' ========================================================================================
FUNCTION CBSTRSA.CopyData (BYVAL psaTarget AS SAFEARRAY PTR) AS HRESULT
CBSTRSA_DP("CBSTRSA COPYDATA")
RETURN SafeArrayCopyData(m_psa, psaTarget)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Returns a pointer to an array element.
' Parameters:
' - idx: Index value that identifies an element of the array.
' Return Value:
' Pointer to the array element on success or NULL on failure.
' Failure will happen if the index is invalid.
' ========================================================================================
FUNCTION CBSTRSA.PtrOfIndex (BYVAL idx AS LONG) AS ANY PTR
CBSTRSA_DP("CBSTRSA PTROFINDEX")
DIM rgidx AS LONG = idx, pvData AS ANY PTR
IF m_psa THEN SafeArrayPtrOfIndex(m_psa, @rgidx, @pvData)
RETURN pvData
END FUNCTION
' ========================================================================================
' ========================================================================================
' Increments the lock count of an array, and retrieves a pointer to the array data.
' Return value: A pointer to the array data.
' Remarks: After calling AccessData, you must call the UnaccessData function to unlock the array.
' ========================================================================================
FUNCTION CBSTRSA.AccessData () AS ANY PTR
CBSTRSA_DP("CBSTRSA ACCESSDATA")
DIM pvData AS ANY PTR
IF m_psa THEN SafeArrayAccessData(m_psa, @pvData)
RETURN pvData
END FUNCTION
' ========================================================================================
' ========================================================================================
' Decrements the lock count of an array, and invalidates the pointer retrieved by AccessData.
' Return value:
' S_OK Success.
' E_UNEXPECTED The array could not be unlocked.
' ========================================================================================
FUNCTION CBSTRSA.UnaccessData () AS HRESULT
CBSTRSA_DP("CBSTRSA UNACCESSDATA")
RETURN SafeArrayUnaccessData(m_psa)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Retrieves an element of the array. If the function fails, it returns an empty string.
' The function can fail if the index is invalid.
' ========================================================================================
FUNCTION CBSTRSA.Get (BYVAL idx AS LONG) AS CBSTR
CBSTRSA_DP("CBSTRSA GET - CBSTR")
DIM cbs AS CBSTR, rgidx AS LONG = idx
IF m_psa THEN SafeArrayGetElement(m_psa, @idx, @cbs)
RETURN cbs
END FUNCTION
' ========================================================================================
' ========================================================================================
' Stores the BSTR element at a given location in the array.
' Returns S_OK on success, or an error HRESULT on failure.
' DISP_E_BADINDEX: The specified index is not valid.
' ========================================================================================
FUNCTION CBSTRSA.Put (BYVAL idx AS LONG, BYREF cbs AS CBSTR) AS HRESULT
CBSTRSA_DP("CBSTRSA PUT - CBSTR")
DIM rgidx AS LONG = idx
IF m_psa THEN RETURN SafeArrayPutElement(m_psa, @idx, *cbs)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Creates a one-dimensional BSTR SafeArray
' Parameters:
' - lLBound
' The lower bound value; that is, the index of the first element in the array.
' Can be negative.
' - cElements
' The number of elements in the array.
' Return value:
' A safe array descriptor, or null if the array could not be created.
' ========================================================================================
FUNCTION CBSTRSA.Create (BYVAL lLBound AS LONG, BYVAL cElements AS DWORD) AS SAFEARRAY PTR
CBSTRSA_DP("CBSTRSA CREATE - " & WSTR(lLBound) & " - " & WSTR(cElements))
DIM rgsabound AS SAFEARRAYBOUND
rgsabound.cElements = cElements
rgsabound.lLBound = lLBound
RETURN SafeArrayCreate(VT_BSTR, 1, @rgsabound)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Appends a CBSTR to the end of the safe array.
' If the safe array doesn't exist, an empty one-dimensional array is created.
' Return value:
' Returns S_OK on success, or an error HRESULT on failure.
' ========================================================================================
FUNCTION CBSTRSA.Append (BYREF cbs AS CBSTR) AS HRESULT
CBSTRSA_DP("CBSTRSA APPEND - CBSTR")
IF m_psa = NULL THEN m_psa = this.Create(0, 0)
IF m_psa THEN
DIM cElements AS DWORD = this.Count + 1
this.Redim(cElements)
RETURN SafeArrayPutElement(m_psa, @cElements, *cbs)
END IF
END FUNCTION
' ========================================================================================
' ========================================================================================
' Destroys an existing array descriptor and all of the data in the array.
' SysFreeString will be called on each element.
' Returns S_OK on success, or an error HRESULT on failure.
' E_INVALIDARG: The argument psa is not valid.
' DISP_E_ARRAYISLOCKED: The array is locked.
' ========================================================================================
FUNCTION CBSTRSA.Destroy () AS HRESULT
CBSTRSA_DP("CBSTRSA DESTROY")
SafeArrayUnlock(m_psa)
RETURN SafeArrayDestroy(m_psa)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Destroys all the data in a safe array.
' SysFreeString will be called on each element.
' Returns S_OK on success, or an error HRESULT on failure.
' E_INVALIDARG: The argument psa is not valid.
' DISP_E_ARRAYISLOCKED: The array is locked.
' ========================================================================================
FUNCTION CBSTRSA.DestroyData () AS HRESULT
CBSTRSA_DP("CBSTRSA DESTROYDATA")
SafeArrayUnlock(m_psa)
DIM hr AS HRESULT = SafeArrayDestroyData(m_psa)
SafeArrayLock(m_psa)
RETURN hr
END FUNCTION
' ========================================================================================
' ========================================================================================
' Attaches a SAFEARRAY structure to a CSafeArray object.
' Parameters:
' psaSrc: A pointer to the SAFEARRAY structure.
' Return value:
' Returns S_OK on success, or an error HRESULT on failure.
' ========================================================================================
FUNCTION CBSTRSA.Attach (BYVAL psaSrc AS SAFEARRAY PTR) AS HRESULT
CBSTRSA_DP("CBSTRSA ATTACH")
IF psaSrc = NULL THEN RETURN E_FAIL
DIM hr AS HRESULT = this.Destroy
IF SUCCEEDED(hr) THEN
m_psa = psaSrc
hr = SafeArrayLock(m_psa)
END IF
RETURN hr
END FUNCTION
' ========================================================================================
' ========================================================================================
' This method detaches the SAFEARRAY from the CSafeArray object.
' Return value: Returns a pointer to a SAFEARRAY object.
' ========================================================================================
FUNCTION CBSTRSA.Detach () AS SAFEARRAY PTR
CBSTRSA_DP("CBSTRSA DETACH")
SafeArrayUnlock(m_psa)
FUNCTION = m_psa
m_psa = NULL
END FUNCTION
' ========================================================================================
' ========================================================================================
' Returns the address of the SafeArray descriptor.
' ========================================================================================
FUNCTION CBSTRSA.GetPtr () AS SAFEARRAY PTR
CBSTRSA_DP("CBSTRSA GETPTR")
RETURN m_psa
END FUNCTION
' ========================================================================================
' ========================================================================================
' Copies the contents of a safe array.
' Parameter:
' psaSrc: Pointer to an array descriptor created by SafeArrayCreate.
' Return value:
' Returns S_OK on success, or an HRESULT on failure.
' Remarks:
' SafeArrayPutElement, automatically calls SafeArrayLock and SafeArrayUnlock before and
' after assigning the element.
' ========================================================================================
FUNCTION CBSTRSA.CopyFrom (BYVAL psaSrc AS SAFEARRAY PTR) AS HRESULT
CBSTRSA_DP("CBSTRSA COPYFROM")
IF psaSrc = NULL THEN RETURN E_INVALIDARG
this.Destroy
DIM hr AS HRESULT = SafeArrayCopy(psaSrc, @m_psa)
SafeArrayLock(m_psa)
RETURN hr
END FUNCTION
' ========================================================================================
END NAMESPACE
A little usage example:
DIM psa AS CBSTRSA = CBSTRSA(1, 3)
' AfxMsg "Bounds: " & STR(psa.LBound) & " - " & STR(psa.UBound)
' AfxMsg "Count: " & STR(psa.Count)
DIM hr AS HRESULT
hr = psa.Put(1, "One")
hr = psa.Put(2, "Two")
hr = psa.Put(3, "Three")
' AfxMsg psa.Get(1)
' AfxMsg psa.Get(2)
' AfxMsg psa.Get(3)
hr = psa.Append("Four")
AfxMsg "Count: " & STR(psa.Count)
AfxMsg psa.Get(4)
> DIM psa AS CBSTRSA = CBSTRSA(1, 3)
1 is the lower bound and 3 the number of elements in the array.
How to access the data directly using AccessData / UnaccessData, which is fater that using Get if we want to list the entire array.
DIM psa AS CBSTRSA = CBSTRSA(1, 3)
psa.Put(1, "One")
psa.Put(2, "Two")
psa.Put(3, "Three")
DIM pvData AS AFX_BSTR PTR = psa.AccessData
IF pvData THEN
DIM cElements AS LONG = psa.UBound - psa.LBound + 1
DIM i AS LONG
FOR i = 0 TO cElements - 1
print *pvData[i]
NEXT
END IF
psa.UnaccessData
This direct access allows us to swap pointers, e.g.
DIM psa AS CBSTRSA = CBSTRSA(1, 3)
psa.Put(1, "One")
psa.Put(2, "Two")
psa.Put(3, "Three")
DIM pvData AS AFX_BSTR PTR = psa.AccessData
IF pvData THEN
DIM ptemp AS ANY PTR
ptemp = pvData[0]
pvData[0] = pvData[1]
pvData[1] = ptemp
END IF
psa.UnaccessData
print psa.Get(1)
print psa.Get(2)
I'm experimenting to find a faster way to implement insertion, deletion and sorting that using the Get Put methods.
For that, I need to know what these API safe array functions do. SafeArrayAccessData returns a pointer to an array of pointers to the data.
HRESULT WINAPI SafeArrayAccessData (SAFEARRAY * psa, void ** ppvData)
{
HRESULT hr;
if(!psa || !ppvData)
return E_INVALIDARG;
hr = SafeArrayLock(psa);
*ppvData = SUCCEEDED(hr) ? psa->pvData : NULL;
return hr;
}
And the result is that I have managed to sort the safe array using the C function qsort :)
'// qsort CBSTRSA comparison function
FUNCTION AfxCBSTRSACompare CDECL (BYVAL a AS AFX_BSTR PTR, BYVAL b AS AFX_BSTR PTR) AS LONG
FUNCTION = wcscmp(*a, *b)
END FUNCTION
DIM psa AS CBSTRSA = CBSTRSA(1, 3)
psa.Put(1, "One")
psa.Put(2, "Two")
psa.Put(3, "Three")
DIM pvData AS AFX_BSTR PTR = psa.AccessData
qsort pvData, 3, SIZEOF(AFX_BSTR), CPTR(ANY PTR, @AfxCBSTRSACompare)
psa.UnaccessData
print psa.Get(1)
print psa.Get(2)
print psa.Get(3)
I will add a Sort method to the class.
Awesome! Great addition to the new string classes :)
Everything becomes easy if you know how to use pointers and have good information about the inner working of the Windows API functions. I have found source code in the ReactOS implementation:
https://doxygen.reactos.org/db/d60/dll_2win32_2oleaut32_2safearray_8c.html#a10fe94cb927948f4b3b03f9b0424a59d
To sort in descending order, we only need to reverse the value returned by wcscmp:
'// Reverse qsort CBSTRSA comparison function
FUNCTION AfxCBSTRSAReverseCompare CDECL (BYVAL a AS AFX_BSTR PTR, BYVAL b AS AFX_BSTR PTR) AS LONG
DIM r AS LONG = wcscmp(*a, *b)
IF r = 1 THEN r = -1 ELSE IF r = -1 THEN r = 1
RETURN r
END FUNCTION
DIM psa AS CBSTRSA = CBSTRSA(1, 3)
psa.Put(1, "One")
psa.Put(2, "Two")
psa.Put(3, "Three")
DIM pvData AS AFX_BSTR PTR = psa.AccessData
qsort pvData, 3, SIZEOF(AFX_BSTR), CPTR(ANY PTR, @AfxCBSTRSAReverseCompare)
psa.UnaccessData
print psa.Get(1)
print psa.Get(2)
print psa.Get(3)
Once added to the class, we only will have to call Sort with an optional flag for ascending or descending order.
That is, instead of
DIM pvData AS AFX_BSTR PTR = psa.AccessData
qsort pvData, 3, SIZEOF(AFX_BSTR), CPTR(ANY PTR, @AfxCBSTRSAReverseCompare)
psa.UnaccessData
We will call
psa.Sort
And this is fast, because we are only swapping pointers, not data.
Appending and shrinking is also easy and fast. The problem is to delete items that are not at the end of the array or inserting items.
Scannig can be fast doing a binary search if the array is sorted, but for unsorted arrays we will have to do a linear search, which is slow.
A good thing about safe arrays is that, unlike propietary arrays, they can be passed to an application written in another language just passing a pointer because they carry information about the type and bounds.
They can also be used with a great variety of data types, among them variants (an even UDTs), but variants are another data type not supported by FB and I will have to write a class for them.
I have added the following code to the class:
' ========================================================================================
' qsort CBSTRSA comparison function
' ========================================================================================
PRIVATE FUNCTION AfxCBSTRSACompare CDECL (BYVAL a AS AFX_BSTR PTR, BYVAL b AS AFX_BSTR PTR) AS LONG
FUNCTION = wcscmp(*a, *b)
END FUNCTION
' ========================================================================================
' ========================================================================================
' Reverse qsort CBSTRSA comparison function
' ========================================================================================
PRIVATE FUNCTION AfxCBSTRSAReverseCompare CDECL (BYVAL a AS AFX_BSTR PTR, BYVAL b AS AFX_BSTR PTR) AS LONG
DIM r AS LONG = wcscmp(*a, *b)
IF r = 1 THEN r = -1 ELSE IF r = -1 THEN r = 1
RETURN r
END FUNCTION
' ========================================================================================
' ========================================================================================
PRIVATE SUB CBSTRSA.Sort (BYVAL bAscend AS BOOLEAN = TRUE)
CBSTRSA_DP("CBSTRSA SORT")
DIM pvData AS AFX_BSTR PTR = this.AccessData
IF bAscend THEN
qsort pvData, this.Count, SIZEOF(AFX_BSTR), CPTR(ANY PTR, @AfxCBSTRSACompare)
ELSE
qsort pvData, this.Count, SIZEOF(AFX_BSTR), CPTR(ANY PTR, @AfxCBSTRSAReverseCompare)
END IF
this.UnaccessData
END SUB
' ========================================================================================
You only need to call psa.Sort and the safe array will be sorted.
Once finished the class, we can implement the Join and Split functions, that I have delayed because I was not convinced about using arrays of CB/CWSTRs. Also I never have liked the Array() syntax, because array descriptors in each language are proprietary and can't be used with other languages. In turn, the safe array descriptor is standard in Windows.
I have implemented Clear and Erase as aliases of DestroyData. They clear all the elements of the array. To destroy the array, call Destroy or free the class.
Since safe arrays use BSTRs, the class uses CBSTRs, but you can assign also STRINGs, WSTRINGs, CWSTRs and literals.
Added operators @ and [].
@ returns the safe array pointer to allow to pass or return it using @psa.
[] allows to use print psa[1] instead of psa.Get(1).
Added two new constructors to allow to construct a new CBSTRA from another CBSTRA or another SAFEARRAY and two LET operators for the same task. I also have modified the CopyFrom method to check if the passed parameter is a one dimensional VT_BSTR safe array.
The constructor and LET operator that accept a safe array pointer call the Attach method to take ownership of the safe array and destroy it when the class is destroyed. They are thought to assign directly to a CBSTRSA the result of a function that returns a safearray without having to make a copy. Never use them to assign to it another CBSTRSA by using cbs2 = *cbs1 or you will have trouble. Use instead cbs2 = cbs1.
TODO:
To implement the methods CopyFromVariant, CopyToVariant, MoveFromVariant and MoveToVariant.
To implement methods to Delete and Insert array elements. For speed, I will try to do it moving the pointers to the BSTRs in the array of BSTR pointers of the safe array without touching the string data.
To implement a binary search for scanning the array. Will have to use a boolean flag set to true if the Sort method is called and set to false if any of the methods that alter the contents of the safe array, such Append or Redim, or the future Delete and Insert, are called. If the array is sorted, I will use a binary search for speed; otherwise, a linear search.
We are close to have dynamic unicode arrays.
Added all the methods listed in the TODO list posted above. Looks like it is ready to use.
' // Dimension a one based safe array with 3 elements
DIM psa AS CBSTRSA = CBSTRSA(1, 3)
' // Assign data to them
psa.Put(1, "One")
psa.Put(2, "Two")
psa.Put(3, "Three")
' // Append another element
psa.Append("Four")
' // Sort the list
psa.Sort
' // Delete the second element
psa.DeleteItem(2)
' // The array now contains three elements
print psa.Count
' // Print the contents of the array
FOR i AS LONG = psa.LBound TO psa.UBOUND
PRINT psa.Get(i)
NEXT
New version. There was an small bug in the Append function.
With this new class we can write functions that return a safe array of BSTRs.
' ========================================================================================
' Splits a string into tokens, which are sequences of contiguous characters separated by
' any of the characters that are part of delimiters.
' - wszStr = The string to split.
' - wszDelimiters = The delimiter characters.
' Return value: A CBSTRSA (safe array) containing a token in each element.
' Usage example:
' DIM wsz AS WSTRING * 260 = "- This, a sample string."
' DIM cbsa AS CBSTRSA = AfxStrSplit(wsz, " ,.-")
' FOR i AS LONG = cbsa.LBound TO cbsa.UBound
' PRINT cbsa.Get(i)
' NEXT
' ========================================================================================
PRIVATE FUNCTION AfxStrSplit (BYREF wszStr AS WSTRING, BYREF wszDelimiters AS WSTRING) AS CBSTRSA
DIM cws AS CWSTR = wszStr, cbsa AS CBSTRSA
DIM pwsz AS WSTRING PTR = wcstok(cws, @wszDelimiters)
WHILE pwsz <> NULL
cbsa.Append(pwsz)
pwsz = wcstok(NULL, @wszDelimiters)
WEND
RETURN cbsa
END FUNCTION
' ========================================================================================
Using the new data types to implement the Join function:
' ========================================================================================
' Returns a string consisting of all of the strings in an array, each separated by a delimiter.
' If the delimiter is a null (zero-length) string then no separators are inserted between
' the string sections. If the delimiter expression is the 3-byte value of "," which may be
' expressed in your source code as the string literal """,""" or as Chr(34,44,34) then a
' leading and trailing double-quote is added to each string section. This ensures that the
' returned string contains standard comma-delimited quoted fields that can be easily parsed.
' Usage example:
' DIM cbsa AS CBSTRSA = CBSTRSA(1, 3)
' cbsa.Put(1, "One")
' cbsa.Put(2, "Two")
' cbsa.Put(3, "Three")
' DIM cws AS CWSTR = AfxStrJoin(cbsa, ",")
' PRINT cws ' ouput: One,Two,Three
' ========================================================================================
PRIVATE FUNCTION AfxStrJoin (BYREF cbsa AS CBSTRSA, BYREF wszDelimiter AS WSTRING) AS CWSTR
DIM nCount AS LONG = cbsa.Count
IF nCount = 0 THEN RETURN ""
DIM cws AS CWSTR
' // Add a leading ""
IF wszDelimiter = CHR(34, 44, 34) THEN cws = CHR(34)
' // Use direct access for speed
DIM pvData AS AFX_BSTR PTR = cbsa.AccessData
IF pvData = NULL THEN RETURN ""
FOR i AS LONG = 0 TO nCount - 1
cws += *pvData[i]
IF i <> nCount - 1 AND wszDelimiter <> "" THEN cws += wszDelimiter
NEXT
cbsa.UnaccessData
' // Add a trailing ""
IF wszDelimiter = CHR(34, 44, 34) THEN cws += CHR(34)
RETURN cws
END FUNCTION
' ========================================================================================
I'm using direct access
DIM pvData AS AFX_BSTR PTR = cbsa.AccessData
IF pvData = NULL THEN RETURN ""
FOR i AS LONG = 0 TO nCount - 1
cws += *pvData[i]
IF i <> nCount - 1 AND wszDelimiter <> "" THEN cws += wszDelimiter
NEXT
cbsa.UnaccessData
for speed.
We could also use the slower Get function:
DIM lb AS LONG = cbsa.LBound
DIM ub AS LONG = cbsa.UBound
FOR i AS LONG = lb TO ub
cws += cbsa.Get(i)
IF i <> ub AND wszDelimiter <> "" THEN cws += wszDelimiter
NEXT
Two new additions to the collection of string functions. Base 64 encoding and decoding.
As it uses com, start your application with CoInitilize NULL and end it with CoUninitialize.
' ========================================================================================
' Base64 is a group of similar encoding schemes that represent binary data in an ASCII
' string format by translating it into a radix-64 representation. The Base64 term
' originates from a specific MIME content transfer encoding.
' Base64 encoding schemes are commonly used when there is a need to encode binary data
' that needs be stored and transferred over media that are designed to deal with textual
' data. This is to ensure that the data remains intact without modification during
' transport. Base64 is used commonly in a number of applications including email via MIME,
' and storing complex data in XML.
' ========================================================================================
' ========================================================================================
' Base64 mime encoding
' ========================================================================================
PRIVATE FUNCTION AfxBase64Encode (BYREF strData AS STRING) AS STRING
' // Create a byte safe array
DIM rgsabound AS SAFEARRAYBOUND
rgsabound.cElements = LEN(strData)
rgsabound.lLBound = 0
DIM psa AS SAFEARRAY PTR
psa = SafeArrayCreate(VT_UI1, 1, @rgsabound)
IF psa = NULL THEN EXIT FUNCTION
' // Lock the safearray for access
DIM pvData AS ANY PTR
SafeArrayAccessData(psa, @pvData)
IF pvData THEN
' // copy the contents of the string
memcpy pvData, STRPTR(strData), LEN(strData)
' // Unlock the safe array
SafeArrayUnaccessData(psa)
END IF
' // Create a variant to host the safe array
DIM vData AS VARIANT
vData.vt = VT_ARRAY OR VT_UI1
vData.parray = psa
' // Create an instance of the IXMLDOMDocument interface
DIM pXmlDocument AS IXMLDOMDocument PTR
CoCreateInstance(@CLSID_DOMDocument, NULL, CLSCTX_INPROC_SERVER, @IID_IXMLDOMDocument, @pXmlDocument)
IF pXmlDocument THEN
' // Create a "b64" element node
DIM pXmlElement AS IXMLDOMElement PTR
DIM pbstrTagName AS AFX_BSTR = SysAllocString("b64")
IF pbstrTagName THEN
pXmlDocument->lpvtbl->createElement(pXmlDocument, pbstrTagName, @pXmlElement)
SysFreeString pbstrTagName
END IF
' // Set the data type to binary base 64 encoded
IF pXmlElement THEN
DIM pDataType AS AFX_BSTR = SysAllocString("bin.base64")
IF pDataType THEN
pXmlElement->lpvtbl->put_dataType(pXmlElement, pDataType)
SysFreeString pDataType
END IF
' // Put the data in the node
pXmlElement->lpvtbl->put_nodeTypedValue(pXmlElement, vData)
' // Get the data as text
DIM pbstrText AS AFX_BSTR
pXmlElement->lpvtbl->get_Text(pXmlElement, @pbstrText)
' // Return the base 64 encoded text
IF pbstrText THEN
FUNCTION = *pbstrText
SysFreeString pbstrText
END IF
IUnknown_Release(pXmlElement)
END IF
IUnknown_Release(pXmlDocument)
END IF
' // Clear the variant
VariantClear @vData
END FUNCTION
' ========================================================================================
' ========================================================================================
' Base64 mime decoding
' ========================================================================================
PRIVATE FUNCTION AfxBase64Decode (BYREF strData AS STRING) AS STRING
' // Create an instance of the IXMLDOMDocument interface
DIM pXmlDocument AS IXMLDOMDocument PTR
CoCreateInstance(@CLSID_DOMDocument, NULL, CLSCTX_INPROC_SERVER, @IID_IXMLDOMDocument, @pXmlDocument)
IF pXmlDocument THEN
' // Create a "b64" element node
DIM pXmlElement AS IXMLDOMElement PTR
DIM pbstrTagName AS AFX_BSTR = SysAllocString("b64")
IF pbstrTagName THEN
pXmlDocument->lpvtbl->createElement(pXmlDocument, pbstrTagName, @pXmlElement)
SysFreeString pbstrTagName
END IF
' // Set the data type to binary base 64 encoded
IF pXmlElement THEN
DIM pDataType AS AFX_BSTR = SysAllocString("bin.base64")
IF pDataType THEN
pXmlElement->lpvtbl->put_dataType(pXmlElement, pDataType)
SysFreeString pDataType
END IF
' // Put the data as text
DIM pbstrText AS AFX_BSTR = SysAllocString(strData)
IF pbstrText THEN
pXmlElement->lpvtbl->put_Text(pXmlElement, pbstrText)
SysFreeString pbstrText
END IF
' // Get the data as a byte safe array
DIM vData AS VARIANT
pXmlElement->lpvtbl->get_nodeTypedValue(pXmlElement, @vData)
IF vData.parray THEN
' // The number of dimensions must be 1
IF SafeArrayGetDim(vData.parray) = 1 THEN
' // Retrieve the number of elements of the array
DIM nLBound AS LONG, nUBound AS LONG
SafeArrayGetLBound(vData.parray, 1, @nLBound)
SafeArrayGetUBound(vData.parray, 1, @nUBound)
' // Calculate the number of bytes to read
DIM nBytes AS LONG = nUbound - nLBound + 1
IF nBytes THEN
' // Lock the safearray for access
DIM pvData AS ANY PTR
SafeArrayAccessData(vData.parray, @pvData)
IF pvData THEN
' // Read the data
DIM buffer AS STRING = SPACE(nBytes)
memcpy STRPTR(buffer), pvData, nBytes
' // Unlock the array
SafeArrayUnaccessData(vData.parray)
' // Return the data
FUNCTION = buffer
END IF
END IF
END IF
END IF
VariantClear @vData
IUnknown_Release(pXmlElement)
END IF
IUnknown_Release(pXmlDocument)
END IF
END FUNCTION
' ========================================================================================
Usage example:
CoInitialize NULL
DIM s AS STRING = "Test string"
s = AfxBase64Encode(s)
? s
s = AfxBase64Decode(s)
? s
CoUninitialize
What it does is to put the data in an XML node and let XML to do the task of encoding / decoding. Wanted to try my skills working with safe arrays and COM at low-level. Besides, some code found in the FB forum crashed.
It is a translation of functions that I wrote with PowerBASIC, that are much shorter because of the PB support for variants, BSTRs and COM.
' ========================================================================================
' Base64 mime encoding
' ========================================================================================
FUNCTION AfxBase64Encode (BYVAL bstrData AS WSTRING) AS WSTRING
LOCAL pXmlDocument AS IXMLDOMDocument
LOCAL pXmlElement AS IXMLDOMElement
LOCAL vData AS VARIANT
DIM rgData(0) AS BYTE
AfxStringToByteArray(bstrData, rgData())
vData = rgData()
TRY
pXmlDocument = NEWCOM "Msxml2.DOMDocument"
pXmlElement = pXmlDocument.createElement("b64")
pXmlElement.dataType = "bin.base64"
pXmlElement.nodeTypedValue = vData
FUNCTION = pXmlElement.Text
CATCH
' MSGBOX HEX$(OBJRESULT, 8)
END TRY
END FUNCTION
' ========================================================================================
' ========================================================================================
' Base64 mime decoding
' ========================================================================================
FUNCTION AfxBase64Decode (BYVAL bstrData AS WSTRING) AS WSTRING
LOCAL pXmlDocument AS IXMLDOMDocument
LOCAL pXmlElement AS IXMLDOMElement
LOCAL vData AS VARIANT
DIM rgData(0) AS BYTE
TRY
pXmlDocument = NEWCOM "Msxml2.DOMDocument"
pXmlElement = pXmlDocument.createElement("b64")
pXmlElement.dataType = "bin.base64"
pXmlElement.Text = bstrData
vData = pXmlElement.nodeTypedValue
rgData() = vData
FUNCTION = AfxByteArrayToString(rgData())
CATCH
' MSGBOX HEX$(OBJRESULT, 8)
END TRY
END FUNCTION
' ========================================================================================
In PB, vData = rgData() does all the work of creating a safe array and attach it to the variant.
I have begin to work in my first COM class with FreeBASIC, CBSTRDIC, an associative array of key, item pairs, for CBSTRs. The Windows Dictionary object works with variants to support a wide variety of data types, but as FB has no native suport for variants, it is a real pain to use them, so I have wrapped it to work with CBSTRs. Maybe I will write a new class if first I write a class for variants.
It is going very well. Very easy to use:
' // Creates an instance of the CBstrDic class
' // Must use NEW to be able to delete the class before the call to CoUninitialize
' // We can use the dotted syntax if pDic goes out of scope before the call to CoUninitialize
DIM pDic AS CBSTRDIC PTR = NEW CBSTRDIC
' // Adds some key, value pairs
pDic->Add "a", "Athens"
pDic->Add "b", "Belgrade"
pDic->Add "c", "Cairo"
' // Get the key's count
DIM nCount AS LONG = pDic->Count
PRINT "Count: ", nCount
' // Change key "b" to "m" and "Belgrade" to "México"
pDic->Key("b") = "m"
pDic->Item("m") = "México"
' // Check if key "m" exists
IF pDic->Exists("m") THEN PRINT "Key m exists" ELSE PRINT "Key m doesn't exists"
' // Get the item for key "m" and display it
DIM cbsItem AS CBSTR = pDic->Item("m")
PRINT "Value of key m: " & cbsItem
' // Remove key "m"
pDic->Remove "m"
IF pDic->Exists("m") THEN PRINT "Key m exists" ELSE PRINT "Key m doesn't exists"
' // Remove all keys
pDic->RemoveAll
PRINT "All the keys must have been deleted"
nCount = pDic->Count
PRINT "Count: ", nCount
Only two functions remain to finish the class, Keys and Items, that will return safe arrays with all the keys and all the items. I also will see if I can implement an iterator; otherwise, I will use an enumerator.