Sub Application_OnStart
   dim mConn
   set mConn = Server.CreateObject("ADODB.Connection")
   mConn.Open "DSN=Dictionary","",""	
 
   BuildArray "a_Country", "CountryCode", "Select * from Country", mConn
   BuildArray "a_DeepWide", "ID1,ID2,ID3", "Select * from DeepWide", mConn
   BuildArray "a_10List", "ListID", "Select * from List", mConn
   mConn.Close
 End Sub
 
 Sub BuildArray(Byval strArrayName, ByVal strKeyField, ByVal strSQL, mConn)
 On Error Resume Next
   Dim rs
   set rs = mConn.Execute(strSQL, lngRecordsAffected, COMMAND_TYPE_TEXT)
 '--- Fill Array ------------------------------------------------------
   If Not rs.EOF Then
     Application(strArrayName) = rs.GetRows()
   End If    
   rs.Close
   set rs = nothing
 End Sub
 

Figure 3   BuildDictionary

 Sub BuildDictionary(Dict, ByVal strKeyField, ByVal strSQL, mconn)
 If A_PRODUCTION_MODE_ON Then On Error Resume Next
   Dim rs, cmd, fld, aItem, strKey, strField, 
   Dim strTemp, strKeyFieldTemp, intFieldcounter
 
   Dict.RemoveAll
   
 '--- Command object -------------------------------------------------
   Set cmd = CreateObject("ADODB.Command")
   Set cmd.ActiveConnection = mconn
   cmd.CommandText = strSQL
   cmd.CommandType = adCmdText	
   
 '--- open recordset -------------------------------------------------
   Set rs = CreateObject("ADODB.Recordset")
   Set rs.SOURCE = cmd
   rs.CursorType = adOpenStatic	
   rs.LockType = adLockOptimistic	
   rs.CacheSize = 150
   rs.Open
   
 '--- begin loop -------------------------------------------
   If Not rs.EOF Then
     ReDim aItem(rs.Fields.Count - 1)
 
     Do While Not rs.EOF
 
 '--- build Item Array ------------------------------------
       intFieldcounter = 0
       For Each fld In rs.Fields
         If Not IsNull(fld) Then
           If fld.Attributes AND adFldLong Then ‘adFldLong = 128
 
 '--- Memo field -------------------------
             If fld.ActualSize > 0 Then
               strTemp = fld.GetChunk(DEFAULT_SIZE_GET_CHUNK)
               Do While Len(Trim(strTemp)) > 0
                 aItem(intFieldcounter) = aItem(intFieldcounter) & strTemp
                 strTemp = fld.GetChunk(DEFAULT_SIZE_GET_CHUNK)
               Loop
             Else
               aItem(intFieldcounter) = BLANK
             End If
           Else
             AItem(intFieldcounter) = fld
           End If
         End If
         IntFieldcounter = intFieldcounter + 1
       Next
 
 '--- build key --------------------------------------------
       strKeyFieldTemp = strKeyField
       strKey = ""
       If InStr(strKeyFieldTemp, ",") Then
         Do While InStr(strKeyFieldTemp, ",")
           StrField = Left(strKeyFieldTemp, InStr(strKeyFieldTemp, ",") - 1)
           StrKey = strKey & rs(strField) & "|"
           StrKeyFieldTemp = Mid(strKeyFieldTemp, InStr(strKeyFieldTemp, ",") + 1)
         Loop
 
 '--- get the last field -----------------------------------
           strField = Mid(strKeyFieldTemp, InStr(strKeyFieldTemp, ",") + 1)
           strKey = strKey & rs(strField)
 
       Else
         StrKey = rs(strKeyFieldTemp)
       End If
 
 '--- add item via key to dict ----------------------------
       Dict.Add strKey, aItem
       rs.MoveNext
     Loop
   End If
   
   rs.Close
   Set rs = Nothing
   Set cmd = Nothing
 End Sub

Figure 4   FetchDictionaryItem

 Function FetchDictionaryItem(Dict, ByVal strKey, ByVal intItemPosition)
 If A_PRODUCTION_MODE_ON Then On Error Resume Next
   Dim aFields
   Dim strItem
 
 '--- check for Dict ----------------------------------------
   If Dict.Count = -1 Then
     Session(ERROR_MESSAGE) = "ERROR:FetchDictItem:Empty:"
     FetchDictionaryItem = Empty
   End If
 
 '--- check for key ----------------------------------------------
   If Not Dict.Exists(strKey) Then
 '    Session(ERROR_MESSAGE) = "ERROR:FetchDictItem:Empty:Key" & strKey
     FetchDictionaryItem = Empty
     Exit Function
   End If
   
 '--- find item for key -------------------------------------------
   aFields = Dict.Item(strKey)
   If Not IsArray(aFields) Then
     Session(ERROR_MESSAGE) = "ERROR:FetchDictItem:Item not array" & strKey
     FetchDictionaryItem = Empty
     Exit Function
   End If
 
 '--- return item in array which was in Dict ----------------
   FetchDictionaryItem = aFields(intItemPosition)
   
 '--- check err object for problems -------------------------------
   If Err.Number <> 0 Then
     Session(ERROR_MESSAGE) = "ERROR:FetchDictItem:Field Error:" & intItemPosition
   End If
 
 End Function