Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

DICTIONARY OBJET wrapper functions

Collapse
X
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
  • #1

    DICTIONARY OBJET wrapper functions

    ' Wrapper functions and procedures to use the Dictionary object
    ' included in the Microsoft Scriptin Runtime (scrrun.dll).

    ' The routines access directly the COM functions through the VTable
    ' which is faster than the Invoke method used by COM Automation.

    ' Another advantage is that each routine returns an error code,
    ' instead of the infamous %DISP_E_EXCEPTION (decimal -2147614729,
    ' hexadecimal &H80020009)
    Code:
    ' *********************************************************************************************
' DICTIONARY OBJECT
' Object that stores data key, item pairs.
' Remarks:
' A Dictionary object is the equivalent of a PERL associative array. Items can be any form of
' data, and are stored in the array. Each item is associated with a unique key. The key is used
' to retrieve an individual item and is usually an integer or a string, but can be anything
' except an array.
' *********************************************************************************************

  #DIM ALL
  #DEBUG ERROR ON
  #INCLUDE "win32api.INC"

  GLOBAL Dic_Error_Code AS DWORD

' *********************************************************************************************
' HRESULT Item([in] *VARIANT Key, [in] *VARIANT Par1)
' Sets an item for a specified key in a Dictionary object.
' Parameters:
' lpDic : Required. Always the name of a Dictionary object.
' vKey : Required. Key associated with the item being retrieved.
' vNewItem : Required. New value associated with the specified key.
' Remarks:
' If key is not found when changing an item, a new key is created with the specified newitem.
' If key is not found when attempting to return an existing item, a new key is created and its
' corresponding item is left empty.
' Example: IDictionary_PutItem(lpDic, "b", "Belgium")
' *********************************************************************************************
  DECLARE FUNCTION Template_IDictionary_PutItem CDECL(BYVAL pThis AS DWORD, BYREF vKey AS VARIANT, BYREF vNewItem AS VARIANT) AS DWORD
' *********************************************************************************************
  SUB IDictionary_PutItem (BYVAL lpDic AS DWORD, BYVAL vKey AS VARIANT, BYVAL vNewItem AS VARIANT) EXPORT
     LOCAL ppthis AS DWORD PTR
     LOCAL pvtbl AS DWORD PTR
     LOCAL ppmethod AS DWORD PTR
     LOCAL pmethod AS DWORD
     ppthis = lpDic
     pvtbl = @ppthis
     ppmethod = pvtbl + 32
     pmethod = @ppmethod
     CALL DWORD pmethod USING Template_IDictionary_PutItem(lpDic, vKey, vNewItem) TO Dic_Error_Code
  END SUB
' *********************************************************************************************

' *********************************************************************************************
' HRESULT Item([in] *VARIANT Key, [out,retval] *VARIANT pReturn)
' Returns an item for a specified key in a Dictionary object.
' Parameters:
' lpDic : Required. Always the name of a Dictionary object.
' vKey : Required. Key associated with the item being retrieved.
' Example:
' LOCAL vRes AS VARIANT
' IDictionary_GetItem(lpDic, "b", vRes)
' *********************************************************************************************
  DECLARE FUNCTION Template_IDictionary_GetItem CDECL(BYVAL pThis AS DWORD, BYREF vKey AS VARIANT,_
  BYREF vReturn AS VARIANT) AS DWORD
' *********************************************************************************************
  SUB IDictionary_GetItem (BYVAL lpDic AS DWORD, BYVAL vKey AS VARIANT, BYREF vReturn AS VARIANT) EXPORT
     LOCAL ppthis AS DWORD PTR
     LOCAL pvtbl AS DWORD PTR
     LOCAL ppmethod AS DWORD PTR
     LOCAL pmethod AS DWORD
     ppthis = lpDic
     pvtbl = @ppthis
     ppmethod = pvtbl + 36
     pmethod = @ppmethod
     CALL DWORD pmethod USING Template_IDictionary_GetItem(lpDic, vKey, vReturn) TO Dic_Error_Code
  END SUB
' *********************************************************************************************

' *********************************************************************************************
' HRESULT Add([in] *VARIANT Key, [in] *VARIANT Item)
' Adds a key and item pair to a Dictionary object.
' Parameters:
' lpDic : Required. Always the name of a Dictionary object.
' vKey : Required. The key associated with the item being added.
' vItem : Required. The item associated with the key being added.
' *********************************************************************************************
  DECLARE FUNCTION Template_IDictionary_Add CDECL(BYVAL pThis AS DWORD, BYREF vKey AS VARIANT, BYREF vItem AS VARIANT) AS DWORD
' *********************************************************************************************
  SUB IDictionary_Add (BYVAL lpDic AS DWORD, BYVAL vKey AS VARIANT, BYVAL vItem AS VARIANT) EXPORT
     LOCAL ppthis AS DWORD PTR
     LOCAL pvtbl AS DWORD PTR
     LOCAL ppmethod AS DWORD PTR
     LOCAL pmethod AS DWORD
     ppthis = lpDic
     pvtbl = @ppthis
     ppmethod = pvtbl + 40
     pmethod = @ppmethod
     CALL DWORD pmethod USING Template_IDictionary_Add(lpDic, vKey, vItem) TO Dic_Error_Code
  END SUB
' *********************************************************************************************

' *********************************************************************************************
' HRESULT Count([out,retval] *I4 pReturn)
' Returns the number of items in a collection or Dictionary object. Read-only.
' Parameter:
' lpDic : Required. Always the name of a Dictionary object.
' *********************************************************************************************
  DECLARE FUNCTION Template_IDictionary_GetCount CDECL(BYVAL pThis AS DWORD, BYREF pReturn AS LONG) AS DWORD
' *********************************************************************************************
  FUNCTION IDictionary_GetCount (BYVAL lpDic AS DWORD) EXPORT AS LONG
     LOCAL lpCount AS LONG
     LOCAL ppthis AS DWORD PTR
     LOCAL pvtbl AS DWORD PTR
     LOCAL ppmethod AS DWORD PTR
     LOCAL pmethod AS DWORD
     ppthis = lpDic
     pvtbl = @ppthis
     ppmethod = pvtbl + 44
     pmethod = @ppmethod
     CALL DWORD pmethod USING Template_IDictionary_GetCount(lpDic, lpCount) TO Dic_Error_Code
     FUNCTION = lpCount
  END FUNCTION
' *********************************************************************************************

' *********************************************************************************************
' HRESULT Exists([in] *VARIANT Key, [out,retval] *BOOL pReturn)
' Returns true if a specified key exists in the Dictionary object, false if it does not.
' Parameters:
' lpDic : Required. Always the name of a Dictionary object.
' vKey : Required. Key value being searched for in the Dictionary object.
' *********************************************************************************************
  DECLARE FUNCTION Template_IDictionary_Exists CDECL(BYVAL pThis AS DWORD, BYREF Key AS VARIANT, BYREF pReturn AS LONG) AS DWORD
' *********************************************************************************************
  FUNCTION IDictionary_Exists (BYVAL lpDic AS DWORD, BYVAL vKey AS VARIANT) EXPORT AS LONG
     LOCAL lpBool AS LONG
     LOCAL ppthis AS DWORD PTR
     LOCAL pvtbl AS DWORD PTR
     LOCAL ppmethod AS DWORD PTR
     LOCAL pmethod AS DWORD
     ppthis = lpDic
     pvtbl = @ppthis
     ppmethod = pvtbl + 48
     pmethod = @ppmethod
     CALL DWORD pmethod USING Template_IDictionary_Exists(lpDic, vKey, lpBool) TO Dic_Error_Code
     FUNCTION = CINT(lpBool)
  END FUNCTION
' *********************************************************************************************

' *********************************************************************************************
' HRESULT Items([out,retval] *VARIANT pReturn)
' Returns an array containing all the items in a Dictionary object.
' Parameter:
' lpDic : Required. Always the name of a Dictionary object.
' *********************************************************************************************
' Example:
'
' IDictionary_Add(lpDic, "a", "Athens")
' IDictionary_Add(lpDic, "b", "Belgrade")
' IDictionary_Add(lpDic, "c", "Cairo")
' LOCAL vRes AS VARIANT
' IDictionary_Items(lpDic, vRes)
' DIM vArray(0) AS VARIANT           ' Assign the SafeArray to an Array of variants
' LET vArray() = vRes
' LOCAL i AS LONG
' FOR i = LBOUND(vArray) TO UBOUND(vArray)
'    PRINT VARIANT$(vArray(i))
' NEXT
'
' *********************************************************************************************
  DECLARE FUNCTION Template_IDictionary_Items CDECL(BYVAL pThis AS DWORD, BYREF pReturn AS VARIANT) AS DWORD
' *********************************************************************************************
  SUB IDictionary_Items (BYVAL lpDic AS DWORD, BYREF vItems AS VARIANT) EXPORT
     LOCAL ppthis AS DWORD PTR
     LOCAL pvtbl AS DWORD PTR
     LOCAL ppmethod AS DWORD PTR
     LOCAL pmethod AS DWORD
     ppthis = lpDic
     pvtbl = @ppthis
     ppmethod = pvtbl + 52
     pmethod = @ppmethod
     CALL DWORD pmethod USING Template_IDictionary_Items(lpDic, vItems) TO Dic_Error_Code
  END SUB
' *********************************************************************************************

' *********************************************************************************************
' HRESULT Key([in] *VARIANT Key, [in] *VARIANT Par1)
' Sets a key in a Dictionary object.
' Parameters:
' lpDic : Required. Always the name of a Dictionary object.
' vKey : Required. Key value being changed.
' vNewKey : Required. New value that replaces the specified key.
' Remarks:
' If key is not found when changing a key, a new key is created and its associated item is left
' empty.
' Example: IDictionary_PutKey(lpDic, "b", "d")
' *********************************************************************************************
  DECLARE FUNCTION Template_IDictionary_PutKey CDECL(BYVAL pThis AS DWORD, BYREF vKey AS VARIANT, BYREF vNewKey AS VARIANT) AS DWORD
' *********************************************************************************************
  SUB IDictionary_PutKey (BYVAL lpDic AS DWORD, BYVAL vKey AS VARIANT, BYVAL vNewKey AS VARIANT) EXPORT
     LOCAL ppthis AS DWORD PTR
     LOCAL pvtbl AS DWORD PTR
     LOCAL ppmethod AS DWORD PTR
     LOCAL pmethod AS DWORD
     ppthis = lpDic
     pvtbl = @ppthis
     ppmethod = pvtbl + 56
     pmethod = @ppmethod
     CALL DWORD pmethod USING Template_IDictionary_PutKey(lpDic, vKey, vNewKey) TO Dic_Error_Code
  END SUB
' *********************************************************************************************

' *********************************************************************************************
' HRESULT Keys([out,retval] *VARIANT pReturn)
' Returns an array containing all existing keys in a Dictionary object.
' Parameter:
' lpDic : Required. Always the name of a Dictionary object.
' *********************************************************************************************
' Example:
'
' IDictionary_Add(lpDic, "a", "Athens")
' IDictionary_Add(lpDic, "b", "Belgrade")
' IDictionary_Add(lpDic, "c", "Cairo")
' LOCAL vRes AS VARIANT
' IDictionary_Keys(lpDic, vRes)
' DIM vArray(0) AS VARIANT           ' Assign the SafeArray to an Array of variants
' LET vArray() = vRes
' LOCAL i AS LONG
' FOR i = LBOUND(vArray) TO UBOUND(vArray)
'    PRINT VARIANT$(vArray(i))
' NEXT
'
' *********************************************************************************************
  DECLARE FUNCTION Template_IDictionary_Keys CDECL(BYVAL pThis AS DWORD, BYREF pReturn AS VARIANT) AS DWORD
' *********************************************************************************************
  SUB IDictionary_Keys (BYVAL lpDic AS DWORD, BYREF vKeys AS VARIANT) EXPORT
     LOCAL ppthis AS DWORD PTR
     LOCAL pvtbl AS DWORD PTR
     LOCAL ppmethod AS DWORD PTR
     LOCAL pmethod AS DWORD
     ppthis = lpDic
     pvtbl = @ppthis
     ppmethod = pvtbl + 60
     pmethod = @ppmethod
     CALL DWORD pmethod USING Template_IDictionary_Keys(lpDic, vKeys) TO Dic_Error_Code
  END SUB
' *********************************************************************************************

' *********************************************************************************************
' HRESULT Remove([in] *VARIANT Key)
' Removes a key, item pair from a Dictionary object.
' Parameter:
' lpDic : Required. Always the name of a Dictionary object.
' *********************************************************************************************
  DECLARE FUNCTION Template_IDictionary_Remove CDECL(BYVAL pThis AS DWORD, BYREF vKey AS VARIANT) AS DWORD
' *********************************************************************************************
  SUB IDictionary_Remove (BYVAL lpDic AS DWORD, BYVAL vKey AS VARIANT) EXPORT
     LOCAL ppthis AS DWORD PTR
     LOCAL pvtbl AS DWORD PTR
     LOCAL ppmethod AS DWORD PTR
     LOCAL pmethod AS DWORD
     ppthis = lpDic
     pvtbl = @ppthis
     ppmethod = pvtbl + 64
     pmethod = @ppmethod
     CALL DWORD pmethod USING Template_IDictionary_Remove(lpDic, vKey) TO Dic_Error_Code
  END SUB
' *********************************************************************************************

' *********************************************************************************************
' HRESULT RemoveAll()
' The RemoveAll method removes all key, item pairs from a Dictionary object.
' Parameter:
' lpDic : Required. Always the name of a Dictionary object.
' *********************************************************************************************
  DECLARE FUNCTION Template_IDictionary_RemoveAll CDECL(BYVAL pThis AS DWORD) AS DWORD
' *********************************************************************************************
  SUB IDictionary_RemoveAll (BYVAL lpDic AS DWORD) EXPORT
     LOCAL ppthis AS DWORD PTR
     LOCAL pvtbl AS DWORD PTR
     LOCAL ppmethod AS DWORD PTR
     LOCAL pmethod AS DWORD
     ppthis = lpDic
     pvtbl = @ppthis
     ppmethod = pvtbl + 68
     pmethod = @ppmethod
     CALL DWORD pmethod USING Template_IDictionary_RemoveAll(lpDic) TO Dic_Error_Code
  END SUB
' *********************************************************************************************

' *********************************************************************************************
' HRESULT CompareMode([in] CompareMethod Par0)
' Sets the comparison mode for comparing string keys in a Dictionary object.
' Parameters:
' lpDic : Required. Always the name of a Dictionary object.
' lCompare : A value representing the comparison mode. Acceptable values are 0 (Binary),
' 1 (Text), 2 (Database). Values greater than 2 can be used to refer to comparisons using
' specific Locale IDs (LCID).
' Remarks: An error occurs if you try to change the comparison mode of a Dictionary object that
' already contains data.
' *********************************************************************************************
  DECLARE FUNCTION Template_IDictionary_PutCompareMode CDECL(BYVAL pThis AS DWORD, BYVAL lCompare AS LONG) AS DWORD
' *********************************************************************************************
  SUB IDictionary_PutCompareMode (BYVAL lpDic AS DWORD, BYVAL lCompare AS LONG) EXPORT
     LOCAL ppthis AS DWORD PTR
     LOCAL pvtbl AS DWORD PTR
     LOCAL ppmethod AS DWORD PTR
     LOCAL pmethod AS DWORD
     ppthis = lpDic
     pvtbl = @ppthis
     ppmethod = pvtbl + 72
     pmethod = @ppmethod
     CALL DWORD pmethod USING Template_IDictionary_PutCompareMode(lpDic, lCompare) TO Dic_Error_Code
  END SUB
' *********************************************************************************************

' *********************************************************************************************
' HRESULT CompareMode([out,retval] *CompareMethod pReturn)
' Returns the comparison mode for comparing string keys in a Dictionary object.
' Parameter:
' lpDic : Required. Always the name of a Dictionary object.
' Return Value: 0 (Binary), 1 (Text), 2 (Database)
' *********************************************************************************************
  DECLARE FUNCTION Template_IDictionary_GetCompareMode CDECL(BYVAL pThis AS DWORD, BYREF lpReturn AS LONG) AS DWORD
' *********************************************************************************************
  FUNCTION IDictionary_GetCompareMode (BYVAL lpDic AS DWORD) EXPORT AS LONG
     LOCAL lpReturn AS LONG
     LOCAL ppthis AS DWORD PTR
     LOCAL pvtbl AS DWORD PTR
     LOCAL ppmethod AS DWORD PTR
     LOCAL pmethod AS DWORD
     ppthis = lpDic
     pvtbl = @ppthis
     ppmethod = pvtbl + 76
     pmethod = @ppmethod
     CALL DWORD pmethod USING Template_IDictionary_GetCompareMode(lpDic, lpReturn) TO Dic_Error_Code
     FUNCTION = lpReturn
  END FUNCTION
' *********************************************************************************************

' *********************************************************************************************
' HRESULT HashVal([in] *VARIANT Key, [out,retval] *VARIANT pReturn)
' This property is undocumented.
' Parameter:
' lpDic : Required. Always the name of a Dictionary object.
' Example:
' IDictionary_GetHashVal(lpDic, "b", vRes)
' PRINT "HashVal: " VARIANT#(vRes)
' *********************************************************************************************
  DECLARE FUNCTION Template_IDictionary_GetHashVal CDECL(BYVAL pThis AS DWORD, BYREF vKey AS VARIANT,_
  BYREF vReturn AS VARIANT) AS DWORD
' *********************************************************************************************
  SUB IDictionary_GetHashVal (BYVAL lpDic AS DWORD, BYVAL vKey AS VARIANT, BYREF vReturn AS VARIANT) EXPORT
     LOCAL ppthis AS DWORD PTR
     LOCAL pvtbl AS DWORD PTR
     LOCAL ppmethod AS DWORD PTR
     LOCAL pmethod AS DWORD
     ppthis = lpDic
     pvtbl = @ppthis
     ppmethod = pvtbl + 84
     pmethod = @ppmethod
     CALL DWORD pmethod USING Template_IDictionary_GetHashVal(lpDic, vKey, vReturn) TO Dic_Error_Code
  END SUB
' *********************************************************************************************

' *********************************************************************************************
' Returns an error message
' *********************************************************************************************
  FUNCTION DicObjError (BYVAL dwError AS DWORD) EXPORT AS STRING
     IF dwError = 0 THEN EXIT FUNCTION
     LOCAL pBuffer   AS ASCIIZ PTR
     LOCAL ncbBuffer AS DWORD
     ncbBuffer = FormatMessage(%FORMAT_MESSAGE_ALLOCATE_BUFFER OR _
        %FORMAT_MESSAGE_FROM_SYSTEM OR %FORMAT_MESSAGE_IGNORE_INSERTS, _
        BYVAL %NULL, dwError, BYVAL MAKELANGID(%LANG_NEUTRAL, %SUBLANG_DEFAULT), _
        BYVAL VARPTR(pBuffer), 0, BYVAL %NULL)
     IF ncbBuffer THEN
        FUNCTION = "Error " & FORMAT$(dwError) & " [&H" & HEX$(dwError, 8) & "] " & @pBuffer
        LocalFree pBuffer
     ELSE
        FUNCTION = "Error " & FORMAT$(dwError) & " [&H" & HEX$(dwError, 8) & "]
     END IF
  END FUNCTION
' *********************************************************************************************


' *********************************************************************************************
' ** Main **
' *********************************************************************************************
  FUNCTION PBMAIN

    ' -------------------------------------------------------------------------
    ' ** STARTUP **
    ' -------------------------------------------------------------------------
    ' Create an instance of the object.
    ' -------------------------------------------------------------------------
    LOCAL oDic AS DISPATCH
    SET oDic = NEW DISPATCH IN "Scripting.Dictionary"
    IF ISFALSE ISOBJECT(oDic) THEN EXIT FUNCTION
    ' -------------------------------------------------------------------------

    ' -------------------------------------------------------------------------
    ' Get the object pointer to be used with the wrapper functions
    ' -------------------------------------------------------------------------
    LOCAL lpDic AS DWORD
    lpDic = OBJPTR(oDic)
    ' --------------------------------------------------------------------------

    IDictionary_Add(lpDic, "a", "Athens")
    IDictionary_Add(lpDic, "b", "Belgrade")
    IDictionary_Add(lpDic, "c", "Cairo")

    LOCAL vRes AS VARIANT
    IDictionary_Items(lpDic, vRes)
    IF Dic_Error_Code THEN PRINT DicObjError(Dic_Error_Code)

    DIM vArray(0) AS VARIANT
    vArray() = vRes
    LOCAL i AS LONG
    FOR i = LBOUND(vArray) TO UBOUND(vArray)
       PRINT VARIANT$(vArray(i))
    NEXT

    ' -------------------------------------------------------------------------
    ' ** CLEANUP **
    ' -------------------------------------------------------------------------
    ' Release the Dictionary object
    ' -------------------------------------------------------------------------
    SET oDic = NOTHING

    WAITKEY$

  END FUNCTION
' *********************************************************************************************

    ------------------
    Tags: None
Previous template Next
Working...
X

We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.

By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.

I Agree