CWindow RC 14

Started by José Roca, July 23, 2016, 01:43:37 AM

Previous topic - Next topic

José Roca

Contains many new wrappers and also changes to the CBSTR and CBWSTR classes to support UTF8.

José Roca

#1
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


José Roca

#2
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


José Roca

#3
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.

José Roca

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


José Roca

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.

José Roca

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;
}


José Roca

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.

Paul Squires

Awesome! Great addition to the new string classes  :)
Paul Squires
PlanetSquires Software

José Roca

#9
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.

José Roca

#10
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.

José Roca

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.

José Roca

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.

José Roca

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.

José Roca

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.