United States
Great Britain & Wales
Northern Ireland
Republic of Ireland
Canada
Note! if you are here to find the dates of specific holidays because you searched for "national holidays", "federal holidays" or "bank holidays", you can use this site to view the dates of holidays for a specific year.
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