Illustrates the use of the Dictionary Object methods and properties.
' =============================================================================================
' 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
' =============================================================================================
