© 2004 Microsoft Corporation. All rights reserved.

  • Article
Figure 3 The SetConnectionParameters Subroutine
  Private Sub SetConnectionParameters(Optional sINIAppName As Variant, _
                                    Optional sINIFullPath As Variant)
•••
    With m.udtConnectionParameters
        '— Data source
        .sDataSource = GetINIValue(m.oError, .sINIConnectionSection, _   
            "DataSource", m.sINIAppName, m.sINIFullPath)
        '— Database Name .sDatabaseName = GetINIValue(m.oError, _   
            .sINIConnectionSection, "DatabaseName", m.sINIAppName, _
            m.sINIFullPath)
        '— Database Provider
        .eDatabaseProvider = CInt(GetINIValue(m.oError, _ 
            .sINIConnectionSection, "DatabaseProvider", _
            m.sINIAppName, m.sINIFullPath))
        '— Application userid
        .sUserID = GetINIValue(m.oError, .sINIConnectionSection, _
            "AppID", m.sINIAppName, m.sINIFullPath)
        '— Application password
        .sPassword = GetINIValue(m.oError, .sINIConnectionSection, _
            "AppPassword", m.sINIAppName, m.sINIFullPath)
•••
Figure 4 The GetINIValue Function
  Public Function GetINIValue(oError As C_ErrorManager, _
    ByVal sSection As String, ByVal sKey As String, ByVal sINIAppName _
    As String, Optional sINIFullPath As Variant) As Variant
    Const sPROC_NAME As String = msOBJ_NAME & ".GetINIValue"
    On Error GoTo Err
    Const sPROPERTY_MANAGER As String = _
        "MTxSpm.SharedPropertyGroupManager.1"
    Dim oINI As C_INIManager
    Dim oSharedPropertyGroupManager As SharedPropertyGroupManager
    Dim oSharedPropertyGroup As SharedPropertyGroup
    Dim oSharedProperty As SharedProperty
    Dim bGroupAlreadyExists As Boolean
    Dim bPropertyAlreadyExists As Boolean
    Dim vValue As Variant
    '— Get the property group
    Set oSharedPropertyGroupManager = CreateObject(sPROPERTY_MANAGER)
    Set oSharedPropertyGroup = _
        oSharedPropertyGroupManager.CreatePropertyGroup(sINIAppName & "."   
        & "INIValues", LockSetGet, Process, bGroupAlreadyExists)
    Set oSharedProperty = oSharedPropertyGroup.CreateProperty _
        (sSection & "." & sKey, bPropertyAlreadyExists)
    If bPropertyAlreadyExists Then
        GetINIValue = oSharedProperty.Value
    Else
        Set oINI = New C_INIManager
        '— If the INI path was passed in, override the default with the 
        'passed in value.
        If HasValue(sINIFullPath) Then
            oINI.FilePath = sINIFullPath & "\" & sINIAppName & ".ini"
        End If
        vValue = oINI.Value(sSection, sKey)
        oSharedProperty.Value = vValue
        GetINIValue = vValue
    End If
    '— Clean up
    Set oINI = Nothing
    Set oSharedProperty = Nothing
    Set oSharedPropertyGroup = Nothing
    Set oSharedProperty = Nothing
Exit Function
Err:
    oError.Push Err, Err.Source, Error, sPROC_NAME
•••
Figure 5 Opening and Disconnecting the Recordset
  '— Select or Insert to create a disconnected recordset
Set oRs = New ADODB.Recordset
With oRs
    '— Get a disconnected recordset rather then a regular recordset
    '— because of its complete metadata properties
    Set .ActiveConnection = oCn
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockBatchOptimistic
    '— Open the recordset
    .Open Source:=sSQL, Options:=adCmdText
    '— Disconnect the recordset
    Set .ActiveConnection = Nothing
End With
'——————————————————————————————————
'— Set the recordset as the return value
'——————————————————————————————————
If lDataReturnType = geDataReturnType_ADOR Then
    Set ExecuteSQL = oRs
Else
    ExecuteSQL = ConstructReturnData(oRs, lDataReturnType)
End If
Figure 6 ConstructReturnData Function
  Private Function ConstructReturnData(ByRef oRs As ADODB.Recordset, _
    ByRef lDataReturnType As enumDataReturnType) As Variant _
    Const sPROC_NAME As String = msOBJ_NAME & ".ConstructReturnData"
    
    On Error GoTo Err
    '— Evaluate which way we need to send the data back to the user
    If IsObject(oRs) Then
        If oRs.State = adStateOpen Then
            Select Case lDataReturnType
                Case geDataReturnType_2DArray
                    If Not oRs.EOF Then
                        ConstructReturnData = oRs.GetRows
                    End If
                Case geDataReturnType_XML
                    ConstructReturnData = BuildXML(oRs)
            End Select
        End If
    End If
    
Exit Function
Err:
    m.oError.Push Err, Err.Source, Error, sPROC_NAME
    m.oError.RaiseLast
End Function
Figure 7 Creating the Metadata's Field Elements
  '— With <fields>
With .childNodes(lMetaDataTag).childNodes(lMetaDataFieldsTag)
    '— Loop through Recordset fields to
    '— create MetaData Field nodes
    For lCol = 0 To oRs.Fields.Count - 1
'— Create the Field node
.appendChild CreateNode("field")
'— Create all of the metadata attributes
'— With <field> attributes
With .childNodes(lCol).Attributes
    '— Create Index attribute
    .setNamedItem CreateAttribute("Index", lCol)
    '— Create Name attribute
    .setNamedItem CreateAttribute("Name", oRs.Fields(lCol).Name)
•••
Figure 8 Creating the Data Elements in XML
  '— Create Data node
.appendChild CreateNode("data")
'— Create Data Rows node
.childNodes(lDataTag).appendChild CreateNode("rows")
oRs.MoveFirst
'— With <rows>
With .childNodes(lDataTag).childNodes(lDataRowsTag)
    Do While Not oRs.EOF
        lRow = oRs.AbsolutePosition - 1
        '— Create the Row node
        .appendChild CreateNode("row")
        '— Create Index attribute
        .childNodes(lRow).Attributes.setNamedItem _
            CreateAttribute("Index", lRow)
        '— Create the Fields node
        .childNodes(lRow).appendChild CreateNode("fields")
        '— With <fields>
        With .childNodes(lRow).childNodes(lDataRowsRowFieldsTag)
            '— Loop through Recordset fields to
            '— create Data Field nodes
            For lCol = 0 To oRs.Fields.Count - 1
                '— Create the Field node
               .appendChild CreateNode("field")
                '— With <field>
                With .childNodes(lCol)
                    '— Create Index attribute
                    .Attributes.setNamedItem CreateAttribute _
                        ("Index", lCol)
                    '— Create Name attribute
                    .Attributes.setNamedItem CreateAttribute _
                        ("Name", oRs.Fields(lCol).Name)
                    '— Create Field Data
                    .Text = oRs.Fields(lCol).Value & ""
                End With
            Next
        End With
        oRs.MoveNext
    Loop
End With
End With
sXML = m.oXML.xml
Set oRs = Nothing
BuildXML = sXML