وب سرویس

[amirzazadeh]

سلام و وقت به خیر.
تو فایل ضمیمه قسمتی رو که با رنگ قرمز مشخص کردم خطا دریافت می کنم. دوستان عزیز ممنون میشم راهنمایی بفرمایید.


کدها مربوط به وب سرویس واکشی نسخه ارائه شده صفحه 174 راهنما هست.(خطا در خط 46 کدها با عنوان object required دریافت میشه)

Public Function GetDeliverFetch() As DeliverFetch



Dim DelFetchJSON As String

DelFetchJSON = "{""cpartySessionId"": """ & Form_Form1.SessionText & """," _

& """checkCode"": """ & Form_PaperFinal.DelTxt & """}"

Dim D As New Dictionary

Dim R As Object

Dim res As String

Dim Request As New MSXML2.XMLHTTP60



With Request

.Open "post", WSURL, False

    .setRequestHeader "Host", "test.ihio.gov.ir"

    .setRequestHeader "Content-Type", "application/json; charset=utf-8"

    .setRequestHeader "terminalId", Form_pass.terminalId

    .setRequestHeader "token", Form_Form1.TokenText

    .setRequestHeader "clientIPAddress", clientIPAddress

    .setRequestHeader "clientAgentinfo", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"

    .send DelFetchJSON

      Set D = ParseJSON(.responseText, "")

      Set R = ParseJSON1(.responseText)

    End With

res = Request.responseBody

Dim i As Integer

For i = 0 To D.Count - 1

   Select Case D.Keys(i)

      Case ".resCode"

          GetDeliverFetch.resCode = D.Items(i)

      Case ".resMessage"

           GetDeliverFetch.resMessage = D.Items(i)

     Case ".info"

           GetDeliverFetch.info = D.Items(i)

     Case ".info.deliveredDate"

           GetDeliverFetch.deliveredDate = D.Items(i)

     Case ".info.orderPartnerInfo.partnerName"

           GetDeliverFetch.orderPartnerInfo.partnerName = D.Items(i)

      Case ".info.orderPartnerInfo.noMedicalSystem"

           GetDeliverFetch.orderPartnerInfo.noMedicalSystem = D.Items(i)

       

End Select

Next i

resCode = R("resCode")

resMessage = R("resMessage")

If resCode = 1 Then

Dim infos() As subInfos

ReDim infos(1 To R("subscriptionDeliveredInfos").Count)

Dim X As Object

Dim z As Integer

For z = 1 To R("subscriptionDeliveredInfos").Count

    Set X = R("subscriptionDeliveredInfos")(z)

    With infos(i)

        .amount = X("amount")

        '.bulkId = X("bulkId")

        '.consumption = X("consumption")

        '.consumptionInstruction = X("consumptionInstruction")

        '.description = X("description")

        '.numberOfDelivered = X("numberOfDelivered")

        '.numberOfPeriod = X("numberOfPeriod")

        '.numberOfRequest = X("numberOfRequest")

        '.patientPayment = X("patientPayment")

        '.serviceDescription = X("serviceDescription")

        '.serviceFullName = X("serviceFullName")

        '.serviceGenericCode = X("serviceGenericCode")

        '.serviceInterfaceName = X("serviceInterfaceName")

        '.serviceNationalNumber = X("serviceNationalNumber")

        '.serviceOrderGenericCode = X("serviceOrderGenericCode")

        '.serviceOrderNationalNumber = X("serviceNationalNumber")

        '.serviceShortName = X("serviceShortName")

     

    End With

Next z

Else

MsgBox resMessage

End If

End Function