Holiday Web Service

With no programming required, you can add the dates of Holidays to your Google Desktop and personalized Google homepage by using our new gadget!

Add to Google

Do you want to add these Holidays to your site? You can add this gadget to your site! No coding required!

Countries Supported

United States
Great Britain & Wales
Northern Ireland
Republic of Ireland
Canada

Classic ASP Example Code

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

Return to Example Code