PlanetSquires Forums

Please login or register.

Login with username, password and session length
Advanced search  
Pages: 1 [2]

Author Topic: CWindow RC 14  (Read 5669 times)

José Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3282
Re: CWindow RC 14
« Reply #15 on: July 25, 2016, 12:46:40 AM »

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).
« Last Edit: July 25, 2016, 04:11:43 AM by Jose Roca »
Logged

José Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3282
Re: CWindow RC 14
« Reply #16 on: July 25, 2016, 04:34:50 AM »

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.


« Last Edit: July 25, 2016, 08:16:50 PM by Jose Roca »
Logged

José Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3282
Re: CWindow RC 14
« Reply #17 on: July 25, 2016, 08:26:25 PM »

Added all the methods listed in the TODO list posted above. Looks like it is ready to use.

Code: [Select]
' // 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
« Last Edit: July 26, 2016, 02:04:57 AM by Jose Roca »
Logged

José Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3282
Re: CWindow RC 14
« Reply #18 on: July 26, 2016, 02:10:19 AM »

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.

Code: [Select]
' ========================================================================================
' 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
' ========================================================================================
« Last Edit: July 26, 2016, 02:27:36 AM by Jose Roca »
Logged

José Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3282
Re: CWindow RC 14
« Reply #19 on: July 26, 2016, 02:06:42 PM »

Using the new data types to implement the Join function:

Code: [Select]
' ========================================================================================
' 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

Code: [Select]
   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:

Code: [Select]
   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

José Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3282
Re: CWindow RC 14
« Reply #20 on: July 27, 2016, 02:31:03 AM »

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.

Code: [Select]
' ========================================================================================
' 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:

Code: [Select]
CoInitialize NULL
DIM s AS STRING = "Test string"
s = AfxBase64Encode(s)
? s
s = AfxBase64Decode(s)
? s
CoUninitialize

José Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3282
Re: CWindow RC 14
« Reply #21 on: July 27, 2016, 02:52:33 AM »

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.

Code: [Select]
' ========================================================================================
' 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.
« Last Edit: July 27, 2016, 02:55:51 AM by Jose Roca »
Logged

José Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3282
Re: CWindow RC 14
« Reply #22 on: July 28, 2016, 12:18:14 AM »

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.

José Roca

  • Moderator
  • Guru Member
  • *****
  • Posts: 3282
Re: CWindow RC 14
« Reply #23 on: July 28, 2016, 12:55:55 AM »

It is going very well. Very easy to use:

Code: [Select]
' // 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.

« Last Edit: July 28, 2016, 01:06:46 AM by Jose Roca »
Logged
Pages: 1 [2]