bod-idv-tw小書製作: 以HolidayWebService為例，說明使用classic asp存取asmx web service

參考資料來源：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

bod-idv-tw小書製作

站內搜尋：Yahoo搜尋的結果，如果沒有給完整的網址，請在站內再搜尋一次！

2013-10-05

以HolidayWebService為例，說明使用classic asp存取asmx web service

沒有留言:

張貼留言