參考資料來源：
http://www.holidaywebservice.com/
Holiday Web Service提供的功能：
http://www.holidaywebservice.com/Holidays/US/USHolidayService.asmx
除了HolidayWebService，還有另一個版本HolidayWebService2，可以使用：
http://www.holidaywebservice.com/HolidayService_v2/HolidayService2.asmx
使用Classic ASP存取HolidayWebService的範例程式碼：
http://www.holidaywebservice.com/exampleCode.aspx
http://www.holidaywebservice.com/ExampleCode_ASP.aspx
- 提供WebService的網址是：cWEB_SERVICE_BASE_URL = http://www.holidaywebservice.com/Holidays/US/USHolidayService.asmx
- HolidayWebService提供哪些services？(範例中已先定義好字串了)
cWEB_SERVICE_GET_HOLIDAYS_AVAILABLE = "GetHolidaysAvailable"
cWEB_SERVICE_GET_HOLIDAYS_FOR_MONTH = "GetHolidaysForMonth"
cWEB_SERVICE_GET_HOLIDAYS_FOR_YEAR = "GetHolidaysForYear"
cWEB_SERVICE_GET_HOLIDAYS_FOR_DATE_RANGE = "GetHolidaysForDateRange"
cWEB_SERVICE_GET_HOLIDAY_DATE = "GetHolidayDate"
- 使用GetHttpResponse自訂函數，向HolidayWebService請求回應值
- Set oXmlHttp = Server.CreateObject("MSXML2.ServerXMLHTTP")
- oXmlHttp.Open "POST", url, False
url = WebService的網址 + 所定義服務字串
例url=cWEB_SERVICE_BASE_URL & "/" & cWEB_SERVICE_GET_HOLIDAYS_FOR_MONTH
- 設定請求內容的型態：
oXmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
- 送出請求：oXmlHttp.Send 請求內容的參數
請求內容的參數，如果是請求回應指定年月中的Holiday，
請求的字串範例： "year=" & Escape(年) & "&month=" & Escape(月)
- 取得web service回傳的內容
GetHttpResponse = oXmlHttp.ResponseText
- 使用WebServiceSimpleDataValue自訂函數，顯示取得的資料內容(適用在某年度的某節日對應日期查詢)
- 建立XML物件，用來存放取得的回傳值
Set oXmlDoc = CreateXmlObject()
- 將回傳值放到所建立的XML物件中
oXmlDoc.LoadXml(xmlString)
- 取得節點名稱、節點的值
Set oXmlNode = oXmlDoc.documentElement
sDataType = oXmlNode.nodeName
vReturnValue = oXmlNode.Text
- 解析回傳內容、呈現回傳內容 ...
- 使用WebServiceDatasetToRecordset自訂函數，顯示取得的資料內容
- 建立XML物件，用來存放取得的回傳值
Set oXmlDoc = CreateXmlObject()
- 將回傳值放到所建立的XML物件中
oXmlDoc.LoadXml(xmlString)
- 建立節點物件
Set oXmlNode = oXmlDoc.SelectSingleNode("//xs:sequence")
- 建立ADODB Recordset物件，用來存放所取得的回傳內容
Set oRs = Server.CreateObject("ADODB.Recordset")
oRs.ActiveConnection = nothing
oRs.CursorLocation = adUseClient
oRs.LockType = adLockBatchOptimistic
oRs.CursorType = adOpenDynamic
- 建立Recordset要存放資料的欄位名稱、值 ...
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
- 將回傳值寫入Recordset中
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
- 呈現回傳值
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.holidaywebservice.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
