Printable View
با سلام و عرض ادب خدمت استاتید محترمنقل قول:
نوشته شده توسط mazoolagh
من برنامه فوق را تست کردم متاسفانه پیغام ( اطلاعات ارسالی غیر معتبر میباشد با کد 1946-) را داد در حالی که با همین یوزر پس در سایت خود بیمه سلامت اطلاعات را میفرستیم و جواب میگیریم
مجددا از لطف تمامی دوستان که زحمت کشیدید بی نهایت متشکرم
سلامنقل قول:
نوشته شده توسط ATA_TABRIZ
یوزر پسورد و ترمینال ای دی متفاوت از یوزر پسورد خود سایت هست شما باید با تکمیل فرم از اداره بیمه این اطلاعات رو دریافت کنید.قسمتی از آنها به ایمیل و قسمتی از اون به صورت پیامک ارسال میشه.
نمونه توکن دریافتی از برنامه:
{
"resCode" : 1,
"resMessage" : "توکن با موفقیت ایجاد شد",
"info" : {
"token" : "Wo2xs1IyKV6z/lqbVPR9m++IBU4="
}
}
سلام و با تشکر از راهنمایی ارزنده شمانقل قول:
نوشته شده توسط amirzazadeh
لطفا با یوزر- پسورد - ترمینال آی دی معتبری که در اختیار دارین اون کد vb.net رو هم یکبار دیگه چک کنین.
سلام و درود
کد vb.net متاسفانه همون خطا رو میده.
مستند نمونه براتون اپلود می کنم.
ضمیمه 152386
براتون امکان داره که اون ها رو برام بفرستید؟ البته اگر مایل باشید.نقل قول:
نوشته شده توسط amirzazadeh
صد البته دلیل نفرستادنش هم قابل درک هست.
به صورت خصوصی براتون ارسال شد.(به ایمیل شما با دامنه yahoo.com)
همین mazoolagh در yahoo
پیشاپیش ممنون
سر فرصت کد vb.net رو چک میکنم و در همون تاپیکی که ایجاد کردین خبر میدم.
جناب امیرزاده ضمن تشکر از راهنماییهای شما و دیگر دوستان مخصوصا جناب Mazoolaghنقل قول:
نوشته شده توسط amirzazadeh
لطف میکنید فرم ونحوه ارتباط با بیمه سلامت را ارسال بفرمایید ضمنا این فرم برای نرم افزاری که در چند مرکز کار میکند معتبر است یا برای هر مرکز باید فرم جداگانه پر و یوزر پسورد گرفته شود
البته یوزر ای دی فکر کنم همان کد موسسه است که در سایت اعتبار سنجی وجود دارد و برای هر مرکز مخصوص آن میباشد
قبلا از مساعدت شما نهایت تشکر را دارم
با سلام
به صورت پيام خصوصي ارسال شد.
با سلام و عرض ادب
برای مرحله دوم که ایجاد نشست کاری هست من با بهره گیری از تجارب دوستان عزیز از این کد ها استفاده کردم ولی با وجود ارسال اطلاعات پیام خطای ذیل دریافت میشه:
{
"resMessage" : "توکن نامعتبر می باشد.",
"resCode" : -12111,
"info" : null
}
کد هایی که استفاده شده:
Option Compare Database
Option Explicit
'Const WSURL As String = "http://webapi.ihio.gov.ir/erx-core/v1/service/auth/token/fetch"
Const WSURL As String = "http://test.ihio.gov.ir/erx-core/v3/service/auth/session/cparty/open"
Const AuthJSON2 As String = "{""cpartyUsername"": ""test"",""cpartyPassword"": ""test123""}"
Const terminalId As Long = 112164
Const token As String = "Wo2xs1IyKV6z/lqbVPR9m++IBU4="
Const clientIPAddress As String = "90.110.180.171"
Const clientAgentinfo As String = "80.191.203.92"
Public ds2 As String
Public Type DailySession
resCode As Long
resMessage As String
sessionId As String
End Type
Public Function GetDailySession() As DailySession
Dim P As String
Dim Request As New MSXML2.XMLHTTP60
With Request
.Open "post", WSURL, False
.setRequestHeader "Host", "webapi.ihio.gov.ir"
.setRequestHeader "Content-Type", "application/json; charset=utf-8"
.setRequestHeader "terminalId", terminalId
.setRequestHeader "token", token
.setRequestHeader "clientIPAddress", clientIPAddress
.setRequestHeader "clientAgentinfo", clientAgentinfo
.send AuthJSON2
End With
ds2 = Request.responseText
End Function
ضمنا استاتوس دریافتی 400 هست.
.................................
ممنون میشم اگر دوستان راهکار اصلاحی ارائه کنند
یک مورد بود که دقت نکرده بودم و اینجا اصلاح کردم.نقل قول:
نوشته شده توسط mazoolagh
در واقع token خودش در Info برمیگرده بنابراین باید بصورت زیر نوشته بشه:
Case ".info.token"
فایل نمونه پیوست رو اگر کسی دریافت کرده باید اصلاح بشه.
البته تا زمانی که اطلاعات واقعی رو (که جناب میرزازاده فرستادن) در دست نداشتم متوجه این مورد نشده بودم.
نقل قول:
نوشته شده توسط amirzazadeh
البته یک تاپیک دیگه هم در بخش وب سرویس ها ساخته شده که من تا دست کم یک هفته ازش خبر نداشتم!
https://barnamenevis.org/showthread....A7%D9%85%D8%AA
چون در این تاپیک پاسخ دیگه هم هست و در بخش مناسبتری هم آمده، اونجا پست میکنم.
سلام و روز خوشنقل قول:
نوشته شده توسط amirzazadeh
لطفا در مورد این clientIPAddress و clientAgentinfo یک توضیح بدین که دقیقا چی هست؟
با سلام و درود تبریک عید میلاد پیامبر
فایل بروز شده راهنما را براتون آپلود کردم
http://s17.picofile.com/file/8412711...D8%AA.rar.html
با توجه به راهنمای مذکور
clientIPAddress : همون ip valid کاربر هست که به نظر میاد برای ارتقای امنیت سیستم دریافت میشه.
مورد دوم برای من هم مبهم هست ولی با توجه به توضیحات فایل راهنما مربوط به ip مرورگر وب مورد استفاده هست(ie,mozilla,...)
باز هم ممنون به خاطر توجه شما به این تاپیک
......................
باید سر فرصت مطالعه کنم ببینم چی به چی هست.
فعلا که مشخص شد در version 3 تغییرات اساسی دادن.
در مورد clientAgentInfo مثالی که در راهنما داده شده قطعا اشتباه هست و نمیتونه ip باشه، به احتمال خیلی زیاد منظورش user agent مرورگر هست.
البته ما از مرورگر برای post استفاده نمیکنیم ولی useragent مرورگر پیشفرض منظور میشه.
موضوع اصلی اینه که اصلا نیازی به این کار نیست و این header خودکار اضافه میشه،
مثلا وقتی با اکسس کار میکنیم روی دستگاه من که مرورگر پیشفرض edge هست داریم:
User-Agent: Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko
اگر از restsharp استفاده کنیم :
User-Agent: RestSharp/106.0.0.0
اما وقتی از webclient استفاده میکنیم خودمون باید بهش مقدار بدیم.
نهایت اینکه بسیار بیهوده است این خواسته و حتی ip .
سلام
خسته نباشد از توجه شما نهایت تشکر را دارم
من وقتی ماژول را به پروژه ام اضافه کردم این اررور را میده
ضمیمه 152397
لطف میکنید علت را بفرمائید
ممنون از توجه شما
سلامنقل قول:
نوشته شده توسط ATA_TABRIZ
احتمالا ماژول دوم (JSON Parser)كه وظيفه تفسير پاسخ رو بر عهده داره به برنامه اضافه نكرديد( در برنامه ضميمه شده توسط جناب mazoolagh اين ماژول موجود هست).
.......................
موفق باشيد
سلام مجدداداز توجه شما ممنونم
جناب امیرزاده ماژول دوم را اضافه کرده بودم باز دوباره تست کردم همان اررور را داد
جالب بود یک دیتابیس جدید ایجاد کردم دوتا ماژول را ایمپورت کردم باز یک اررور دیگه داد ضمیمه 152401
سلام
تصوير رفرنس هاي مورد نياز رو براتون اپلود كردم ببينيد همه رو تو برنامتون اضافه كرديد.
سلام جناب amirzazadehنقل قول:
نوشته شده توسط amirzazadeh
ممنون از لطفتون
حل شد
تمام رفرنس وجود داشت فقط باید ترتیب قرار گرفتن رفرنس عوض میشد
بازم از توجه شما تشکر میکنمضمیمه 152404
آیا دریافت توکن موفقیت آمیز بود؟نقل قول:
نوشته شده توسط ATA_TABRIZ
با سلام و عرض ادب
با کمک دوستان عزیز و گرامی مرحله دوم هم به سرانجام رسید و ایجاد جلسه کاری (session) تکمیل گردید:
{
"resCode" : 1,
"resMessage" : "عملیات با موفقیت انجام شد",
"info" : {
"sessionId" : "95cc39043e2475fcbc9b30834cf528c148952fÐÑ6Ò8Ô? 152Ù11Ô09d3835edda6a493f680e4d5298de95505ebadaf5 1c938cbd6328c54ae893abd705c8fcb6888037b5946d65f402 d48a35be3b13460c4e9fe15b1c26caeaaa6c862f64fa4cdeb2 87b3966f8cb794dd923146c731866b95db13621899509e80a2 f68fd47d37f4147513782d4d49d3208e158bea4d754eÒÑÓ ?ÖeÚÒÓÐÐ5114d23cdee67ed4b43e7d15b1df4efe85d7 1dÒ?ÐÖ?c4ÐÒÚ1Ô?9ÕÚ4ÙØ54?e1da25202d83f32 797725d50482abff4998905f58b7094d7e6fe582ac4c8dacc9 04011afd2f35382345bcdd35ceb61ff2450bff2386a3be18fc 91ee575cd8aba23a4b727b3374d32a73022f046add5f5e23d3 a26639744990990173b27f1b0a4e416394c59032d36cd58dd1 19c1ea447e4e3d8593e44b71804159142d252bf2ce419948c4 f26d382bb00d52bd0acf30a32f8307e738f4a736e57e2e5a91 8e14097940a2bceb620009d75aaaaab36959544c61e71588f5 936eb13b46e6beb734bfcd0f18b40ab0ba811073a2b0129190 5576a2b0d8ea97b16f9f71f32a9100c3c3a7d011efd87800d1 ca5084751277df56b2c550aad14b5a17023df4ef2a70f0ac96 ecf2f47fe3bd859bc511ce5c91db0f9f48c308d11d600ee44b e6d43",
همانطور که دوست گرانقدر جناب mazoolagh اشاره کرده بودند دو هدر مربوط به ip صرفا نمایشی بوده و هر مقداری رو قبول می کنند.
...............
سلام و درود
برای ایجاد مرحله سوم که نشست شهروند هست مطابق مراحل قبلی کدها ارسال میشه:
Option Compare Database
Option Explicit
Const WSURL As String = "http://test.ihio.gov.ir/erx-core/v3/service/auth/session/citizen/open"
Const AuthJSON3 As String = _
"{""cpartySessionId"": ""95cc39043e2475fcbc9b30834cf528c148952fÐÑ6Ò8Ô ?152Ù11Ô09d3835edda6a493f680e4d5298de95505ebadaf 51c938cbd6328c54ae893abd705c8fcb6888037b5946d65f40 2d48a35be3b13460c4e9fe15b1c26caeaaa6c862f64fa4cdeb 287b3966f8cb794dd923146c731866b95db13621899509e80a 2f68fd47d37f4147513782d4d49d3208e158bea4d754eÒÑ ?ÖeÚÒÓÐÐ5114d23cdee67ed4b43e7d15b1df4efe85d 71dÒ?ÐÖ?c4ÐÒÚ1Ô?9ÕÚ4ÙØ54?e1da25202d83f3 2797725d50482abff4998905f58b7094d7e6fe582ac4c8dacc 904011afd2f35382345bcdd35ceb61ff2450bff2386a3be18f c91ee575cd8aba23a4b727b3374d32a73022f046add5f5e23d 3a26639744990990173b27f1b0a4e416394c59032d36cd58dd 119c1ea447e4e3d8593e44b71804159142d252bf2ce419948c 4f26d382bb00d52bd0acf30a32f8307e738f4a736e57e2e5a9 18e14097940a2bceb620009d75aaaaab36959544c61e71588f 5936eb13b46e6beb734bfcd0f18b40ab0ba811073a2b012919 05576a2b0d8ea97b16f9f71f32a9100c3c3a7d011efd87800d 1ca5084751277df56b2c550aad14b5a17023df4ef2c001fa41 7e34ab0cfb714562d3ae18cfad1477264dc84cb49357324091 01889e"",""nationalNumber"": ""1502161206""}"
Const terminalId As Long = 173162
Const token As String = "d448f575db31a44ea15fd57c41483f908456ce5814abece79 99d0884abfc8e364059b0b31bc305a014c8e42c72f96f62c05 abf51b44cded6a7f07c8c78089c9e22bfc41e7c2b5a86689a8 36fab446cd2"
Const clientIPAddress As String = "90.110.180.171"
Const clientAgentInfo As String = "80.191.203.11"
Public Type CitizenSession
resCode As Long
resMessage As String
info As String
citizenSessionId As String
End Type
Public Function GetCitizenSession() As CitizenSession
Dim D As New Dictionary
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", terminalId
.setRequestHeader "token", token
.setRequestHeader "clientIPAddress", clientIPAddress
.setRequestHeader "clientAgentinfo", "Mozilla/5.0 (Windows NT 6.1; rv:25.0) Gecko/20100101 Firefox/25.0"
.send AuthJSON3
Set D = ParseJSON(.responseText, "")
End With
res = request.responseBody
Dim i As Integer
For i = 0 To D.Count - 1
Select Case D.Keys(i)
Case ".resCode"
GetCitizenSession.resCode = D.Items(i)
Case ".resMessage"
GetCitizenSession.resMessage = D.Items(i)
Case ".info.sessionid"
GetCitizenSession.citizenSessionId = D.Items(i)
End Select
Next i
End Function
مشکلی که هست چون کد sessionId دریافت شده از مرحله قبل حاوی کاراکترهای Nonunicode (کاراکتر فارسی) هست این خطا رو دریافت می کنیم.
resCode=-14125
resMessage=اطلاعات ورودی در قالب UTF-8 نمی باشد.
citizenSessionId=
پیشنهادتون برای رفع این مشکل چیه؟
..........
سپاسگزارم
سلام
با استفاده از این ماژول مشکل برطرف شد.
Option Compare Database
Public Function removeObsoleteWhiteSpace _
(FromString As Variant) As Variant
If IsNull(FromString) Then 'handle Null values
removeObsoleteWhiteSpace = Null
Exit Function
End If
Dim strTemp As String
strTemp = Replace(FromString, vbCr, "")
strTemp = Replace(strTemp, vbLf, "")
strTemp = Replace(strTemp, vbTab, "")
strTemp = Replace(strTemp, vbVerticalTab, "")
strTemp = Replace(strTemp, vbBack, "")
strTemp = Replace(strTemp, vbNullChar, "")
While InStr(strTemp, " ") > 0
strTemp = Replace(strTemp, " ", " ")
Wend
strTemp = trim(strTemp)
removeObsoleteWhiteSpace = strTemp
End Function
و اصلاح این کد
GetDailySession.sessionId = removeObsoleteWhiteSpace(StrConv(D.Items(i), vbUnicode))
.........................
سلام و روز خوش
داستان این به کجا رسید؟
همه سرویس ها رو نوشتین و جواب گرفتین؟
سلام و درود فراوان
در حال کلنجار با سرویس های ذخیره نسخه هستم.
فقط در مورد تفسیر پاسخ در حالتیکه info به صورت آرایه دریافت میشه نحوه استخراج ارایه ها به چه شکلی خواهد بود؟
لطفا همین response رو در یک فایل text پیوست یا ایمیل کنین.
در ضمن مشخص کنین که مربوط به کدوم سرویس بوده.
سلام . کد سرویس مورد نظر(جستجو irc بر اساس کد ژنریک):
Option Compare Database
Const WSURL As String = "http://test.ihio.gov.ir/erx-core/v3/service/product/search/irc/generic"
Public Type SearchG
resCode As Long
resMessage As String
info As String
fullName As String
End Type
Public Function GetSearchG() As SearchG
Dim JSON8 As String
JSON8 = "{""cpartySessionId"": """ & Form_Form1.SessionText & """," _
& """citizenSessionId"": """ & Form_Form1.CitizenText & """ ," _
& """genCode"": """ & Form_prescribe.GenericCode & """}"
Dim D As New Dictionary
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_Form1.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 JSON8
Set D = ParseJSON(.responseText, "")
End With
res = Request.responseBody
Dim i As Integer
For i = 0 To D.Count - 1
Select Case D.Keys(i)
Case ".resCode"
GetSearchG.resCode = D.Items(i)
If GetSearchG.resCode = 1 Then
Form_prescribe.DrugNameTxt = D.Items(3)
Form_prescribe.DrugNationalCode = D.Items(5)
Form_prescribe.AllowedTxt = D.Items(9)
Form_prescribe.Descripton = D.Items(7)
Form_prescribe.BasePriceTxt = D.Items(8)
End If
Case ".resMessage"
GetSearchG.resMessage = D.Items(i)
Case ".info.fullName"
GetSearchG.fullName = D.Items(i)
Case ".info"
GetSearchG.info = D.Items(i)
End Select
Next i
End Function
Sub TEST8()
Dim x As SearchG
x = GetSearchG()
Debug.Print "resCode=" + CStr(x.resCode) + vbCrLf + "resMessage=" + x.resMessage + vbCrLf + "info=" + CStr(x.info)
End Sub
این هم پاسخ دریافتی که برای یک کد ژنریک سه کد IRC رو به صورت آرایه نشون میده:
Debug.Print Request.responseText
{
"resCode" : 1,
"resMessage" : "فهرست خدمات دارویی با موفقیت واکشی شد.",
"info" : [ {
"isDefault" : true,
"fullName" : "CYCLOLUX INJECTION PARENTERAL 377 MG/1ML 15 ML(Çä Èí ÇÓ ˜íÔ)",
"shortName" : "04025|Óí˜áæáæ˜Ó 0.5 ãíáí ãæá ÏÑ ãíáí áíÊÑ æíÇá 15 ãíáí áíÊÑ(-11449)",
"nationalNumber" : "1024711070474046",
"interfaceName" : "04025|Óí˜áæáæ˜Ó 0.5 ãíáí ãæá ÏÑ ãíáí áíÊÑ æíÇá 15 ãíáí áíÊÑ(-11449)",
"description" : "GADOTERATE MEGLUMINE INJECTION PARENTERAL 377 mg/1mL 15 mL",
"basePrice" : 1000000,
"state" : {
"isCovered" : false,
"shape" : "A"
}
}, {
"isDefault" : false,
"fullName" : "CLARISCAN INJECTION PARENTERAL 377 MG/1ML 15 ML(ÇåÑÇä ÊÌÇÑÊ)",
"shortName" : "4025|˜áÇÑíÓ˜ä ÊÒÑíÞí ÑäÊÑÇá 377 MG/1ML 15 ML(-33353)",
"nationalNumber" : "3787511735350824",
"interfaceName" : "4025|˜áÇÑíÓ˜ä ÊÒÑíÞí ÑäÊÑÇá 377 MG/1ML 15 ML(-33353)",
"description" : "GADOTERATE MEGLUMINE INJECTION PARENTERAL 377 mg/1mL 15 mL",
"basePrice" : 874000,
"state" : {
"isCovered" : false,
"shape" : "A"
}
}, {
"isDefault" : false,
"fullName" : "DOTAREM INJECTION PARENTERAL 377 MG/1ML 15 ML(˜æÈá ÏÇÑæ)",
"shortName" : "04025|ÏæÊÇÑã 377 ãíáí Ñã ÏÑ ãíáí áíÊÑ æíÇá 15 ãíáí áíÊÑ(-8567)",
"nationalNumber" : "0277558570881415",
"interfaceName" : "04025|ÏæÊÇÑã 377 ãíáí Ñã ÏÑ ãíáí áíÊÑ æíÇá 15 ãíáí áíÊÑ(-8567)",
"description" : "GADOTERATE MEGLUMINE INJECTION PARENTERAL 377 mg/1mL 15 mL",
"basePrice" : 1244000,
"state" : {
"isCovered" : false,
"shape" : "A"
}
} ]
}
...... Time
یک parser دیگه (از همون آقای Tim Hall) هست که کاملتره و البته کدش هم مفصلتر - اینجا کپی نمیکنم کدش رو ولی در گیت هست:
https://github.com/VBA-tools/VBA-JSON
و البته در برنامه پیوست هم میتونین ببینین.
برای راحتی در برنامه پیوست responsetext رو در یک فایل به اسم a.json ریختم و از اونجا میخونم، بالطبع شما همون رو مستقیم استفاده میکنین:
Option Compare Database
Option Explicit
Public Type IrcProductInfoState
isCovered As Boolean
isSpecialDisease As Boolean
shape As String
End Type
Public Type IrcProductInfo
id As Integer
isDefault As Boolean
fullName As String
shortName As String
nationalNumber As String
interfaceName As String
description As String
basePrice As Long
state As IrcProductInfoState
End Type
Sub readfile()
Dim fso As New FileSystemObject
Dim T As TextStream
Set T = fso.OpenTextFile(CurrentProject.Path & "\a.json", ForReading)
Dim S As String
S = T.ReadAll
T.Close
Set T = Nothing
Set fso = Nothing
Dim R As Object
Set R = ParseJson(S)
Dim resCode As Long
Dim resMessage As String
resCode = R("resCode")
resMessage = R("resMessage")
Dim infos() As IrcProductInfo
ReDim infos(1 To R("info").Count)
Dim x As Object
Dim i As Integer
For i = 1 To R("info").Count
Set x = R("info")(i)
With infos(i)
.id = x("id")
.isDefault = x("isDefault")
.fullName = x("fullName")
.shortName = x("shortName")
.nationalNumber = x("nationalNumber")
.interfaceName = x("interfaceName")
.description = x("description")
.basePrice = x("basePrice")
.state.isCovered = x("state")("isCovered")
.state.isSpecialDisease = x("state")("isSpecialDisease")
.state.shape = x("state")("shape")
End With
Next i
End Sub
روش کار مشخص هست و بخصوص برای شما نیاز به توضیح بیشتری نیست.
ضمیمه 152549
برنامه نمونه:
سپاس و درود بيكراننقل قول:
نوشته شده توسط mazoolagh
و ممنون به خاطر پاسخ كامل مبسوط و نمونه همراه .
..................................
پيروز و سربلند باشيد.
با سلام و تشکر ویژهنقل قول:
نوشته شده توسط mazoolagh
کدها رو با برنامه خودم چک کردم .عالی و بی نقص عمل می کنند.:تشویق::تشویق::تشویق:
سلام و وقت به خیر.
تو فایل ضمیمه قسمتی رو که با رنگ قرمز مشخص کردم خطا دریافت می کنم. دوستان عزیز ممنون میشم راهنمایی بفرمایید.
کدها مربوط به وب سرویس واکشی نسخه ارائه شده صفحه 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
سلام مجدد
با عرض قسمت معرفی رو جا انداخته بودم.
Option Compare Database
Const WSURL As String = "http://test.ihio.gov.ir/erx-core/v3/service/prescription/delivered/fetch"
Public Type subInfos
numberOfDelivered As Double
numberOfRequest As Double
numberOfPeriod As Double
description As String
amount As Double
patientPayment As Double
consumption As String
consumptionInstruction As String
shape As String
bulkId As Long
serviceFullName As String
serviceShortName As String
serviceInterfaceName As String
serviceGenericCode As String
serviceNationalNumber As String
serviceDescription As String
serviceOrderGenericCode As String
serviceOrderNationalNumber As String
End Type
Public Type pzInfo
partnerName As String
partnerPhone As String
contractPartyName As String
noMedicalSystem As Long
licenseName As String
End Type
Public Type DeliverFetch
resCode As Long
resMessage As String
info As String
orderedDate As String
deliveredDate As String
samadCode As String
typeId As Long
totalAmount As Double
totalPatientPayment As Double
isVisitSimultaneous As Boolean
orderPartnerInfo As pzInfo
subscriptionDeliveredInfos As subInfos
End Type
پاسخ دریافتی :
Debug.Print Request.responseText
{
"resCode" : 1,
"resMessage" : "ÇØáÇÚÇÊ äÓÎå ÊÍæíá ÏÇÏå ÔÏå ÈÇ ãæÝÞíÊ æǘÔí ÔÏ.",
"info" : {
"partnerName" : "ÏÇÑæÎÇäå ãíÑÒÇÒÇÏå",
"partnerPhone" : "35415655",
"contractPartyName" : "ÇÍãÏ ãíÑÒÇÒÇÏå",
"orderedDate" : "1399/10/08 13:15:32",
"deliveredDate" : "1399/10/08 13:15:32",
"samadCode" : "8185332586714237",
"typeId" : 1,
"totalAmount" : 39000.0,
"totalPatientPayment" : 20100.0,
"isVisitSimultaneous" : false,
"orderPartnerInfo" : {
"partnerName" : "ÊÕæíÑÈÑÏÇÑí ÌÈÇÑí",
"partnerPhone" : "4135557768",
"contractPartyName" : "ÑÞíå ÌÈÇÑí",
"noMedicalSystem" : 80160,
"licenseName" : "ÊÇÓíÓ ÊÕæíÑÈÑÏÇÑí"
},
"subscriptionDeliveredInfos" : [ {
"numberOfDelivered" : 10.0,
"numberOfRequest" : 10.0,
"description" : null,
"amount" : 12000.0,
"patientPayment" : 12000.0,
"serviceFullName" : "ASA 80MG 30 TABLETS IN BOX|EC TAB(ÏÇÑæÓÇÒí Çãíä)",
"serviceShortName" : "01395|Â ÇÓ Â 80ãíáí Ñã ÌÚÈå 30 ÚÏÏí(-5512)",
"shape" : "T",
"serviceInterfaceName" : "01395|Â ÇÓ Â 80ãíáí Ñã ÌÚÈå 30 ÚÏÏí(-5512)",
"serviceGenericCode" : "01395",
"serviceNationalNumber" : "9085371114347003",
"serviceDescription" : "ASA (ACETYLSALICYLIC ACID) TABLET, DELAYED RELEASE ORAL 80 mg",
"consumption" : "Once a day",
"numberOfPeriod" : 1.0,
"serviceOrderGenericCode" : "01395",
"serviceOrderNationalNumber" : "9085371114347003"
}, {
"numberOfDelivered" : 15.0,
"numberOfRequest" : 20.0,
"description" : null,
"amount" : 27000.0,
"patientPayment" : 8100.0,
"serviceFullName" : "AMLOBER TABLET ORAL 5 MG(ǘÊææјæ)",
"serviceShortName" : "00070|ÂãáæÈÑ 5ãíáí Ñã(-3013)",
"shape" : "T",
"serviceInterfaceName" : "00070|ÂãáæÈÑ 5ãíáí Ñã(-3013)",
"serviceGenericCode" : "00070",
"serviceNationalNumber" : "6526243688105035",
"serviceDescription" : "AMLODIPINE BESYLATE TABLET ORAL 5 mg",
"consumption" : "Twice a day",
"numberOfPeriod" : 1.0,
"serviceOrderGenericCode" : "00070",
"serviceOrderNationalNumber" : "6526243688105035"
}, {
"numberOfDelivered" : 1.0,
"numberOfRequest" : 1.0,
"description" : null,
"amount" : 0.0,
"patientPayment" : 0.0,
"serviceFullName" : "ËÈÊ äÓÎå ˜ÇÛÐí ÏÇÑæÎÇäå",
"serviceShortName" : "ËÈÊ äÓÎå ˜ÇÛÐí ÏÇÑæÎÇäå",
"shape" : "O",
"serviceInterfaceName" : "ËÈÊ äÓÎå ˜ÇÛÐí ÏÇÑæÎÇäå",
"serviceGenericCode" : "9000900004",
"serviceNationalNumber" : "9000900004",
"serviceDescription" : "æíÒíÊ äÓÎå ˜ÇÛÐí",
"consumption" : "Every three hours",
"numberOfPeriod" : 1.0,
"serviceOrderGenericCode" : "9000900004",
"serviceOrderNationalNumber" : "9000900004"
} ],
"subscriptionDeliveredInfosWithNoReference" : [ ]
}
}
سلام آقای میرزازاده
بهتره فقط از یک parser استفاده کنین (همین دومی) ، بنابراین در کدتون ماژول قبلی رو کلا پاک کنین و تمام رفرنسها به اون رو به همین دومی تغییر بدین.
من بر مبنای همون مستندات ورژن 3 استراکچرهای مورد نیاز رو تعریف کردم:
{ "resCode":int,
"resMessage":String,
"info": {
"orderedDate":String,
"deliveredDate":String,
"samadCode":String,
"typeId":int,
"totalAmount":double,
"totalPatientPayment":double,
"isVisitSimultaneous":boolean
"orderPartnerInfo":{
"partnerName":String,
"partnerPhone":String,
"contractPartyName":String,
"noMedicalSystem":int,
"licenseName":String
},
"subscriptionDeliveredInfos":[
{
"numberOfDelivered": double,
"numberOfRequest": double,
"numberOfPeriod": double,
"description":String,
"amount":double,
"patientPayment":double,
"consumption":String,
"consumptionInstruction":String,
"shape":String,
"bulkId":int,
"serviceFullName":String,
"serviceShortName":String,
"serviceInterfaceName":String,
"serviceGenericCode":String,
"serviceNationalNumber":String,
"serviceDescription:String,
"serviceOrderGenericCode":String,
"serviceOrderNationalNumber:String
}
],
"subscriptionDeliveredInfosWithNoR
eference":
[{
"numberOfDelivered":int,
"numberOfRequest":int,
"numberOfPeriod":int,
"description":String,
"amount":double,
"patientPayment":double,
"consumption":String,
"consumptionInstruction":String,
"shape":String,
"bulkId":int,
"numberOfPeriod":int,
"serviceFullName":String,
"serviceShortName":String,
"serviceInterfaceName":String,
"serviceGenericCode":String,
"serviceNationalNumber":String,
"serviceDescription:String,
}]
}
}