< "" Then CurrentLCID = SetLocale(LCID)
If IsNumeric(iNumDecimals) Then
FormatCurrencyPerLocale = FormatCurrency(varValue, iNumDecimals)
Else
FormatCurrencyPerLocale = FormatCurrency(varValue)
End If
If Not IsEmpty(CurrentLCID) Then SetLocale CurrentLCID
End Function
Function FHasNoContent(objValue)
FHasNoContent = True
If IsNull(objValue) Then Exit Function
If IsEmpty(objValue) Then Exit Function
If Not IsObject(objValue) Then
If objValue = "" Then Exit Function
Else
If objValue Is Nothing Then Exit Function
End if
FHasNoContent = False
End Function
Function IIf(fCond, varTrue, varFalse)
If fCond Then
IIf = varTrue
Else
IIf = varFalse
End If
End Function
Function Nz(varValue, varReplace)
If FHasNoContent(varValue) Then
Nz = varReplace
Else
Nz = varValue
End If
End Function
Function Sum(strExpr)
Dim nSum, i
nSum = 0
Set objCurrNodeT = objCurrNode
For i = 0 To cGroupCount - 1
Set objCurrNode = objGroupNodes.item(i)
nSum = nSum + ToNumber(Eval(strExpr))
Next
Set objCurrNode = objCurrNodeT
Sum = nSum
End Function
Function Count(strExpr)
Dim nCount, i
If strExpr = "*" Then
Count = cGroupCount
Exit Function
End If
Set objCurrNodeT = objCurrNode
nCount = 0
For i = 0 To cGroupCount - 1
Set objCurrNode = objGroupNodes.item(i)
If Not FHasNoContent(Eval(strExpr)) Then
nCount = nCount + 1
End If
Next
Set objCurrNode = objCurrNodeT
Count = nCount
End Function
Function Avg(strExpr)
Dim nSum
Dim nCount
nSum = Sum(strExpr)
nCount = Count(strExpr)
If nCount > 0 Then
Avg = nSum / nCount
Else
Avg = nSum
End If
End Function
Function Min(strExpr)
Dim varMin, i
Dim varTemp
Set objCurrNodeT = objCurrNode
For i = 0 To cGroupCount - 1
Set objCurrNode = objGroupNodes.item(i)
varTemp = Eval(strExpr)
If IsEmpty(varMin) Or (varTemp < varMin) Then
varMin = varTemp
End If
Next
Set objCurrNode = objCurrNodeT
Min = varMin
End Function
Function Max(strExpr)
Dim varMax, i
Dim varTemp
varMax = Eval(strExpr)
Set objCurrNodeT = objCurrNode
For i = 0 To cGroupCount - 1
Set objCurrNode = objGroupNodes.item(i)
varTemp = Eval(strExpr)
If IsEmpty(varMax) Or (varTemp > varMax) Then
varMax = varTemp
End If
Next
Set objCurrNode = objCurrNodeT
Max = varMax
End Function
Function GetValue(strRef, nType)
' Set Null as the default return value
GetValue = Null
' Return Null if anything goes wrong
On Error Resume Next
Dim objNode
Set objNode = objCurrNode.selectSingleNode(strRef)
If (objNode Is Nothing) Or IsNull(objNode) Or IsEmpty(objNode) Or Not IsObject(objNode) Then
Exit Function
End If
Dim CurrentLCID
CurrentLCID = SetLocale(1033)
Select Case nType
Case 2 ' adSmallInt
GetValue = CLng(objNode.text)
Case 3 ' adInteger
GetValue = CLng(objNode.text)
Case 20 ' adBigInt
GetValue = CLng(objNode.text)
Case 17 ' adUnsignedTinyInt
GetValue = CLng(objNode.text)
Case 18 ' adUnsignedSmallInt
GetValue = CLng(objNode.text)
Case 19 ' adUnsignedInt
GetValue = CLng(objNode.text)
Case 21 ' adUnsignedBigInt
GetValue = CLng(objNode.text)
Case 4 ' adSingle
GetValue = CDbl(objNode.text)
Case 5 ' adDouble
GetValue = CDbl(objNode.text)
Case 6 ' adCurrency
GetValue = CCur(objNode.text)
Case 14 ' adDecimal
GetValue = CDbl(objNode.text)
Case 131 ' adNumeric
GetValue = CDbl(objNode.text)
Case 139 ' adVarNumeric
GetValue = CDbl(objNode.text)
Case 11 ' adBoolean
GetValue = CBool(objNode.text)
Case 7 ' adDate
GetValue = BuildDateFromStr(objNode.text, True)
Case 133 ' adDBDate
GetValue = BuildDateFromStr(objNode.text, True)
Case 134 ' adDBTime
GetValue = BuildDateFromStr(objNode.text, True)
Case 135 ' adDBTimeStamp
GetValue = BuildDateFromStr(objNode.text, True)
Case 8 ' adBSTR
GetValue = objNode.text
Case 120 ' adChar
GetValue = objNode.text
Case 200 ' adVarChar
GetValue = objNode.text
Case 201 ' adLongVarChar
GetValue = objNode.text
Case 130 ' adWChar:
GetValue = objNode.text
Case 202 ' adVarWChar
GetValue = objNode.text
Case 203 ' adLongVarWChar
GetValue = objNode.text
Case -7 ' Special value used to get just the date.
GetValue = BuildDateFromStr(objNode.text, False)
Case Else
GetValue = objNode.text
End Select
SetLocale CurrentLCID
End Function
Dim gStaticDate
Function StaticDate()
If IsEmpty(gStaticDate) Then gStaticDate = GetValue("/*/@generated", -7)
StaticDate = gStaticDate
End Function
Dim gStaticNow
Function StaticNow()
If IsEmpty(gStaticNow) Then gStaticNow = GetValue("/*/@generated", 7)
StaticNow = gStaticNow
End Function
Function BuildDateFromStr(strDate, fIncludeTime)
Dim CurrentLCID
CurrentLCID = SetLocale(1033)
' This requires that the Locale be set to en-us (1033).
BuildDateFromStr = CDate(Left(strDate,10))
If (fIncludeTime) Then
BuildDateFromStr = BuildDateFromStr + CDate(Right(strDate,8))
End If
SetLocale CurrentLCID
End Function
Function ArrayItem(arr, index)
If index > UBound(arr) Then
ArrayItem = ""
Else
ArrayItem = arr(index)
End If
End Function
Function HyperlinkPartFromNodeList(nodelist, nPart)
If nodelist.length = 0 Then
HyperlinkPartFromNodeList = ""
Else
HyperlinkPartFromNodeList = HyperlinkPartFromString(nodelist.item(0).text, nPart)
End If
End Function
Function HyperlinkPart(strRef, nPart)
HyperlinkPart = HyperlinkPartFromString(GetValue(strRef, 200), nPart)
End Function
Function HyperlinkPartFromString(strHyperlink, nPart)
Dim arrParts
Dim strHyperlinkPart
Dim strAddress, strSubAddress
arrParts = Split(strHyperlink, "#")
Select Case nPart
Case 0 ' acDisplayedValue
strHyperlinkPart = ArrayItem(arrParts, 0)
If strHyperlinkPart = "" Then
strAddress = ArrayItem(arrParts, 1)
strSubAddress = ArrayItem(arrParts, 2)
If strAddress = "" and strSubAddress = "" Then
strHyperlinkPart = ""
ElseIf strSubAddress = "" Then
strHyperlinkPart = strAddress
ElseIf strAddress = "" Then
strHyperlinkPart = strSubAddress
Else
strHyperlinkPart = strAddress & " - " & strSubAddress
End If
End If
Case 1 ' acDisplayText
strHyperlinkPart = ArrayItem(arrParts, 0)
Case 2 ' acAddress
strHyperlinkPart = ArrayItem(arrParts, 1)
Case 3 ' acSubAddress
strHyperlinkPart = ArrayItem(arrParts, 2)
Case 4 ' acScreenTip
strHyperlinkPart = ArrayItem(arrParts, 3)
Case 5 ' acFullAddress
strAddress = ArrayItem(arrParts, 1)
strSubAddress = ArrayItem(arrParts, 2)
If strAddress = "" and strSubAddress = "" Then
strHyperlinkPart = "#"
ElseIf strSubAddress = "" Then
strHyperlinkPart = strAddress
Else
strHyperlinkPart = strAddress & "#" & strSubAddress
End If
End Select
HyperlinkPartFromString = strHyperlinkPart
End Function
]]>
