Option Explicit
Const adUseClient = 3
Const adLockBatchOptimistic = 4
Const adOpenDynamic = 2
Const adVarChar = 200
Const adDate = 7
Const adDBDate = 133
Const adFldIsNullable = &H00000020
Const NODE_ELEMENT = 1
Const cXMLDOM_TYPENAME = "MSXML2.DOMDocument"
Const cXMLHTTP_TYPENAME = "MSXML2.ServerXMLHTTP"
Const cLOG_PATH = "./"
Const cLOG_FILENAME = "call_holiday_service.log"
Const cWEB_SERVICE_BASE_URL = "http://www.27seconds.com/Holidays/US/USHolidayService.asmx"
Const cWEB_SERVICE_GET_HOLIDAYS_AVAILABLE = "GetHolidaysAvailable"
Const cWEB_SERVICE_GET_HOLIDAYS_FOR_MONTH = "GetHolidaysForMonth"
Const cWEB_SERVICE_GET_HOLIDAYS_FOR_YEAR = "GetHolidaysForYear"
Const cWEB_SERVICE_GET_HOLIDAYS_FOR_DATE_RANGE = "GetHolidaysForDateRange"
Const cWEB_SERVICE_GET_HOLIDAY_DATE = "GetHolidayDate"
Dim oRs, _
oFld
Dim sResponse, _
sTmp
'sResponse = GetHolidaysAvailableResponse()
'sResponse = GetHolidaysForMonthResponse(2005, 5)
'sResponse = GetHolidaysForYearResponse(2005)
'sResponse = GetHolidaysForDateRangeResponse("2004-12-20", "2005-1-15")
'sResponse = GetHolidayDateResponse("easter", 2005)
'To see the XML returned, uncomment these next lines
'WriteLog String(25, "-")
'WriteLog sResponse
'WriteLog String(25, "-")
'To display simple data types (e.g. GetHolidayDate)
'Response.Write WebServiceSimpleDataValue(sResponse)
'To display DataSets, you have to first convert the Dataset to a Recordset
' (e.g. GetHolidaysAvailable, GetHolidaysForMonth, GetHolidaysForYear, GetHolidaysForDateRange)
'Set oRs = WebServiceDatasetToRecordset(sResponse)
' oRs.MoveFirst
' Do Until oRs.EOF
' sTmp = ""
' For Each oFld In oRs.Fields
' sTmp = sTmp & _
' oFld.Name & "=" & oFld.Value & vbCrLf
' Next
' Response.Write sTmp
' oRs.MoveNext
' Loop
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'Helper function for calling the GetHolidaysAvailable web service method
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetHolidaysAvailableResponse()
GetHolidaysAvailableResponse = GetHttpResponse(cWEB_SERVICE_BASE_URL & "/" & cWEB_SERVICE_GET_HOLIDAYS_AVAILABLE, Nothing)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'Helper function for calling the GetHolidaysForMonth web service method
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetHolidaysForMonthResponse(yr, mth)
Dim sData
sData = "year=" & Escape(yr) & "&month=" & Escape(mth)
GetHolidaysForMonthResponse = GetHttpResponse(cWEB_SERVICE_BASE_URL & "/" & cWEB_SERVICE_GET_HOLIDAYS_FOR_MONTH, sData)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'Helper function for calling the GetHolidaysForYear web service method
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetHolidaysForYearResponse(yr)
Dim sData
sData = "year=" & Escape(yr)
GetHolidaysForYearResponse = GetHttpResponse(cWEB_SERVICE_BASE_URL & "/" & cWEB_SERVICE_GET_HOLIDAYS_FOR_YEAR, sData)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'Helper function for calling the GetHolidaysForDateRange web service method
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetHolidaysForDateRangeResponse(startDate, endDate)
Dim sData
sData = "startDate=" & Escape(startDate) & "&endDate=" & Escape(endDate)
GetHolidaysForDateRangeResponse = GetHttpResponse(cWEB_SERVICE_BASE_URL & "/" & cWEB_SERVICE_GET_HOLIDAYS_FOR_DATE_RANGE, sData)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'Helper function for calling the GetHolidayDate web service method
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetHolidayDateResponse(holidayName, yr)
Dim sData
sData = "holidayName=" & Escape(holidayName) & "&year=" & Escape(yr)
GetHolidayDateResponse = GetHttpResponse(cWEB_SERVICE_BASE_URL & "/" & cWEB_SERVICE_GET_HOLIDAY_DATE, sData)
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'Helper function to get POST data to a server and get the text response
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetHttpResponse(ByVal url, ByVal dataToSend)
Dim oXmlHttp: Set oXmlHttp = Server.CreateObject(cXMLHTTP_TYPENAME)
Dim bSendData
oXmlHttp.Open "POST", url, False
bSendData = False
If IsObject(dataToSend) Then
If Not dataToSend Is Nothing Then
bSendData = True
End If
ElseIf Len(Trim(dataToSend)) > 0 Then
bSendData = True
End If
If bSendData Then
If bSendData And IsObject(dataToSend) = False Then
'set the content type
oXmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
End If
oXmlHttp.Send dataToSend
Else
oXmlHttp.Send
End If
GetHttpResponse = oXmlHttp.ResponseText
Set oXmlHttp = Nothing
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'Helper function to get the value of a simple data type returned by a Web Service
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function WebServiceSimpleDataValue(ByVal xmlString)
Dim oXmlDoc: Set oXmlDoc = CreateXmlObject()
Dim oXmlNode
Dim sDataType
Dim vReturnValue
oXmlDoc.LoadXml(xmlString)
Set oXmlNode = oXmlDoc.documentElement
sDataType = oXmlNode.nodeName
vReturnValue = oXmlNode.Text
Select Case sDataType
Case "dateTime"
vReturnValue = CDate( _
Mid(vReturnValue, 1, 4) & "-" & _
Mid(vReturnValue, 6, 2) & "-" & _
Mid(vReturnValue, 9, 2) & " " & _
Mid(vReturnValue, 12, 2) & ":" & _
Mid(vReturnValue, 15, 2) & ":" & _
Mid(vReturnValue, 18, 2) _
)
'Example:
'2005-03-27T00:00:00.0000000-05:00
'123456789012345678901234567890123
End Select
WebServiceSimpleDataValue = vReturnValue
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'Helper function to get convert a DataSet data type returned by a Web Service to an
'ADO recordset
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function WebServiceDatasetToRecordset(ByVal xmlString)
Dim oXmlDoc: Set oXmlDoc = CreateXmlObject()
Dim oXmlNode, _
oXmlNode_Field, _
oXmlNode_Record
Dim oRs, _
oFld
Dim sFieldName, _
sFieldType
Dim iDataType
oXmlDoc.LoadXml(xmlString)
Set oXmlNode = oXmlDoc.SelectSingleNode("//xs:sequence")
Set oRs = Server.CreateObject("ADODB.Recordset")
oRs.ActiveConnection = nothing
oRs.CursorLocation = adUseClient
oRs.LockType = adLockBatchOptimistic
oRs.CursorType = adOpenDynamic
For Each oXmlNode_Field In oXmlNode.ChildNodes
sFieldName = oXmlNode_Field.Attributes.GetNamedItem("name").Value
sFieldType = oXmlNode_Field.Attributes.GetNamedItem("type").Value
Select Case sFieldType
Case "xs:dateTime"
iDataType = adDate
Case Else
iDataType = adVarchar
End Select
oRs.Fields.Append sFieldName, iDataType, 1024, adFldIsNullable
Next
oRs.Open
Set oXmlNode = oXmlDoc.SelectSingleNode("//NewDataSet")
For Each oXmlNode_Record In oXmlNode.ChildNodes
oRs.AddNew
For Each oXmlNode_Field In oXmlNode_Record.ChildNodes
sFieldName = oXmlNode_Field.nodeName
oRs(sFieldName) = oXmlNode_Field.Text
Next
oRs.Update
Next
Set WebServiceDatasetToRecordset = oRs
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'Helper function to create an XML Object
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function CreateXmlObject()
Set CreateXmlObject = Server.CreateObject(cXMLDOM_TYPENAME)
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'Helper function to append messages to a log file
'
'*** WriteLog assumes WRITE permissions on the directory that the log is being written to
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function WriteLog(ByVal psMessage)
Dim sFileName
sFileName = cLOG_PATH & cLOG_FILENAME
Dim oFs: Set oFs = Server.CreateObject("Scripting.FileSystemObject")
Dim oTs: Set oTs = oFs.OpenTextFile(sFileName, 8, True) '8 = ForAppending
oTs.WriteLine Now() & vbTab & psMessage
oTs.Close
Set oTs = Nothing
Set oFs = Nothing
WriteLog = True
End Function
|
