Dictionary Object Demo

[José Roca]

Illustrates the use of the Dictionary Object methods and properties.

Code Select Expand


' =============================================================================================
' Dictionary Object demo
' 2008 José Roca - Use at your own risk.
' =============================================================================================

' SED_PBCC
#COMPILE EXE
#DIM ALL
#INCLUDE "SCRRUN.INC"
#INCLUDE "oaidl.inc"   ' for tagVARIANT

' =============================================================================================
' Reads the contents of a safe array contained in a Variant and shows it.
' =============================================================================================
SUB ShowItems (BYREF vVar AS VARIANT)
   LOCAL lpVt AS tagVARIANT PTR, lpArray AS DWORD
   LOCAL lLBound AS LONG, lUBound AS LONG
   LOCAL i AS LONG, ix AS LONG, vRes AS VARIANT
   lpVt = VARPTR(vVar)
   lpArray = @lpVt.parray
   IF SafeArrayGetDim(lpArray) = 0 THEN EXIT SUB
   SafeArrayGetLBound(lpArray, 1, lLBound)
   SafeArrayGetUBound(lpArray, 1, lUBound)
   FOR i = lLBound TO lUBound
      ix = i : vRes = EMPTY
      SafeArrayGetElement(lpArray, ix, vRes)
      IF VARIANTVT(vRes) = %VT_BSTR THEN PRINT VARIANT$(vRes) ELSE PRINT VARIANT#(vRes)
   NEXT
END SUB
' =============================================================================================

' =============================================================================================
' Copy the embeded array of variants to an array of variants and show them.
' Alternate way to the above. Easier to use, but slower and wastes memory.
' =============================================================================================
SUB ShowItems2 (BYREF vVar AS VARIANT)
   LOCAL i AS LONG
   REDIM vArray(0) AS VARIANT
   vArray() = vVar
   FOR i = LBOUND(vArray) TO UBOUND(vArray)
      PRINT VARIANT$(vArray(i))
   NEXT
END SUB
' =============================================================================================

' =============================================================================================
' Translate the compare mode to a string
' =============================================================================================
FUNCTION GetCompareModeStr (BYVAL lCompare AS LONG) AS STRING
   SELECT CASE AS LONG lCompare
      CASE %CompareMethod_BinaryCompare   : FUNCTION = "Binary compare"
      CASE %CompareMethod_TextCompare     : FUNCTION = "Text compare"
      CASE %CompareMethod_DatabaseCompare : FUNCTION = "Database compare"
      CASE ELSE                           : FUNCTION = "Unknown compare"
   END SELECT
END FUNCTION
' =============================================================================================

' =============================================================================================
' Main
' =============================================================================================
FUNCTION PBMAIN

   ' ========================================================================================
   ' Creates an instance of the Dictionary Object
   ' ========================================================================================
   LOCAL pDic AS IDictionary
   pDic = NEWCOM "Scripting.Dictionary"
   IF ISNOTHING(pDic) THEN
      PRINT "Error creating an instance of the Dictionary Object"
      WAITKEY$
      EXIT FUNCTION
   END IF
   ' ========================================================================================

   ' ========================================================================================
   ' Change the compare mode property
   ' ========================================================================================
   LOCAL lCompare AS LONG
   pDic.CompareMode = %CompareMethod_TextCompare
   lCompare = pDic.CompareMode
   PRINT "Compare mode changed to: " & GetCompareModeStr(lCompare)
   ' ========================================================================================

   ' ========================================================================================
   ' Adds some key/value pairs
   ' ========================================================================================
   LOCAL vKey AS VARIANT, vItem AS VARIANT
   vKey = "a" : vItem = "Athens"
   pDic.Add vKey, vItem
   vKey = "b" : vItem = "Belgrade"
   pDic.Add vKey, vItem
   vKey = "c" : vItem = "Cairo"
   pDic.Add vKey, vItem
   ' ========================================================================================

   ' ========================================================================================
   ' Get all the items and show them
   ' ========================================================================================
   LOCAL vItems AS VARIANT
   vItems = pDic.Items
   PRINT "-------------------------------------------------"
   PRINT "Items:"
   PRINT "-------------------------------------------------"
   ShowItems vItems
   ' ========================================================================================

   ' ========================================================================================
   ' Get all the keys and show them
   ' ========================================================================================
   LOCAL vKeys AS VARIANT
   vKeys = pDic.Keys
   PRINT "-------------------------------------------------"
   PRINT "Keys:"
   PRINT "-------------------------------------------------"
   ShowItems vKeys
   ' ========================================================================================

   ' ========================================================================================
   ' Change key "b" to "m" and "Belgrade" to "México"
   ' ========================================================================================
   LOCAL vNewKey AS VARIANT, vNewItem AS VARIANT
   vKey = "b" : vNewKey = "m"
   pDic.Key(vKey) = vNewKey
   vItem = "m" : vNewItem = "México"
   pDic.Item(vItem) = vNewItem
   ' ========================================================================================

   ' ========================================================================================
   ' Get the key's count
   ' ========================================================================================
   LOCAL nCount AS LONG
   nCount = pDic.Count
   PRINT "-------------------------------------------------"
   PRINT "Count: " & FORMAT$(nCount)
   PRINT "-------------------------------------------------"
   ' ========================================================================================

   ' ========================================================================================
   ' Check if key "m" exists
   ' ========================================================================================
   vKey = "m"
   IF pDic.Exists(vKey) THEN
      PRINT "Key m exists"
   ELSE
      PRINT "Key m doesn't exists"
   END IF
   ' ========================================================================================

   ' ========================================================================================
   ' Get the item for key "m" and show it
   ' ========================================================================================
   vItem = EMPTY : vKey = "m"
   vItem = pDic.Item(vKey)
   PRINT "Value of key m: " & VARIANT$(vItem)
   ' ========================================================================================

   ' ========================================================================================
   ' Remove key "m"
   ' ========================================================================================
   vKey = "m"
   pDic.Remove vKey
   IF pDic.Exists(vKey) THEN
      PRINT "Key m exists"
   ELSE
      PRINT "Key m has been deleted"
   END IF
   ' ========================================================================================

   ' ========================================================================================
   ' Remove all keys
   ' ========================================================================================
   pDic.RemoveAll
   PRINT "All the keys must have been deleted"
   nCount = pDic.Count
   PRINT "Count: " & FORMAT$(nCount)
   ' ========================================================================================

   ' ========================================================================================
   ' Releases the interface
   ' ========================================================================================
   pDic = NOTHING
   ' ========================================================================================

   WAITKEY$

END FUNCTION
' =============================================================================================