وب سرویس

**ATA_TABRIZ** · یک شنبه 11 آبان 1399, 12:51 عصر

نوشته شده توسط mazoolagh

برنامه نمونه

با سلام و عرض ادب خدمت استاتید محترم

من برنامه فوق را تست کردم متاسفانه پیغام ( اطلاعات ارسالی غیر معتبر میباشد با کد 1946-) را داد در حالی که با همین یوزر پس در سایت خود بیمه سلامت اطلاعات را میفرستیم و جواب میگیریم

مجددا از لطف تمامی دوستان که زحمت کشیدید بی نهایت متشکرم

**amirzazadeh** · یک شنبه 11 آبان 1399, 13:30 عصر

نوشته شده توسط ATA_TABRIZ

با سلام و عرض ادب خدمت استاتید محترم

من برنامه فوق را تست کردم متاسفانه پیغام ( اطلاعات ارسالی غیر معتبر میباشد با کد 1946-) را داد در حالی که با همین یوزر پس در سایت خود بیمه سلامت اطلاعات را میفرستیم و جواب میگیریم

مجددا از لطف تمامی دوستان که زحمت کشیدید بی نهایت متشکرم

سلام
یوزر پسورد و ترمینال ای دی متفاوت از یوزر پسورد خود سایت هست شما باید با تکمیل فرم از اداره بیمه این اطلاعات رو دریافت کنید.قسمتی از آنها به ایمیل و قسمتی از اون به صورت پیامک ارسال میشه.
نمونه توکن دریافتی از برنامه:
{
"resCode" : 1,
"resMessage" : "توکن با موفقیت ایجاد شد",
"info" : {
"token" : "Wo2xs1IyKV6z/lqbVPR9m++IBU4="
}
}

**mazoolagh** · یک شنبه 11 آبان 1399, 13:58 عصر

نوشته شده توسط amirzazadeh

سلام
یوزر پسورد و ترمینال ای دی متفاوت از یوزر پسورد خود سایت هست شما باید با تکمیل فرم از اداره بیمه این اطلاعات رو دریافت کنید.قسمتی از آنها به ایمیل و قسمتی از اون به صورت پیامک ارسال میشه.
نمونه توکن دریافتی از برنامه:
{
"resCode" : 1,
"resMessage" : "توکن با موفقیت ایجاد شد",
"info" : {
"token" : "Wo2xs1IyKV6z/lqbVPR9m++IBU4="
}
}

سلام و با تشکر از راهنمایی ارزنده شما
لطفا با یوزر- پسورد - ترمینال آی دی معتبری که در اختیار دارین اون کد vb.net رو هم یکبار دیگه چک کنین.

**amirzazadeh** · یک شنبه 11 آبان 1399, 14:06 عصر

سلام و درود
کد vb.net متاسفانه همون خطا رو میده.
مستند نمونه براتون اپلود می کنم.
sampleRest.rar

**mazoolagh** · یک شنبه 11 آبان 1399, 14:13 عصر

نوشته شده توسط amirzazadeh

سلام و درود
کد vb.net متاسفانه همون خطا رو میده.

براتون امکان داره که اون ها رو برام بفرستید؟ البته اگر مایل باشید.
صد البته دلیل نفرستادنش هم قابل درک هست.

**amirzazadeh** · یک شنبه 11 آبان 1399, 14:18 عصر

به صورت خصوصی براتون ارسال شد.(به ایمیل شما با دامنه yahoo.com)

**mazoolagh** · یک شنبه 11 آبان 1399, 14:35 عصر

همین mazoolagh در yahoo
پیشاپیش ممنون

سر فرصت کد vb.net رو چک میکنم و در همون تاپیکی که ایجاد کردین خبر میدم.

**ATA_TABRIZ** · یک شنبه 11 آبان 1399, 17:38 عصر

نوشته شده توسط amirzazadeh

سلام
یوزر پسورد و ترمینال ای دی متفاوت از یوزر پسورد خود سایت هست شما باید با تکمیل فرم از اداره بیمه این اطلاعات رو دریافت کنید.قسمتی از آنها به ایمیل و قسمتی از اون به صورت پیامک ارسال میشه.
نمونه توکن دریافتی از برنامه:
{
"resCode" : 1,
"resMessage" : "توکن با موفقیت ایجاد شد",
"info" : {
"token" : "Wo2xs1IyKV6z/lqbVPR9m++IBU4="
}
}

جناب امیرزاده ضمن تشکر از راهنماییهای شما و دیگر دوستان مخصوصا جناب Mazoolagh
لطف میکنید فرم ونحوه ارتباط با بیمه سلامت را ارسال بفرمایید ضمنا این فرم برای نرم افزاری که در چند مرکز کار میکند معتبر است یا برای هر مرکز باید فرم جداگانه پر و یوزر پسورد گرفته شود
البته یوزر ای دی فکر کنم همان کد موسسه است که در سایت اعتبار سنجی وجود دارد و برای هر مرکز مخصوص آن میباشد
قبلا از مساعدت شما نهایت تشکر را دارم

**amirzazadeh** · یک شنبه 11 آبان 1399, 18:05 عصر

با سلام
به صورت پيام خصوصي ارسال شد.

**amirzazadeh** · دوشنبه 12 آبان 1399, 09:51 صبح

با سلام و عرض ادب
برای مرحله دوم که ایجاد نشست کاری هست من با بهره گیری از تجارب دوستان عزیز از این کد ها استفاده کردم ولی با وجود ارسال اطلاعات پیام خطای ذیل دریافت میشه:

{

  "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** · سه شنبه 13 آبان 1399, 10:01 صبح

نوشته شده توسط mazoolagh

حالا با استفاده از این json parser میتونیم اطلاعات پاسخ رو بیرون بکشیم:

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/v1/service/auth/token/fetch"

Const AuthJSON As String = "{""terminalId"": 123456,""userName"": ""test_username"",""password"": ""test_password""}"



Public Type DailyToken

    resCode As Long

    resMessage As String

    token As String

End Type



Public Function GetDailyToken() As DailyToken

Dim D As New Dictionary

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"

    .Send AuthJSON

    Set D = ParseJSON(.responseText, "")

End With



Dim i As Integer

For i = 0 To D.Count - 1

    Select Case D.Keys(i)

        Case ".resCode"

            GetDailyToken.resCode = D.Items(i)

        Case ".resMessage"

            GetDailyToken.resMessage = D.Items(i)

        Case ".info.token"

            GetDailyToken.token = D.Items(i)

    End Select

Next i

End Function

یک مورد بود که دقت نکرده بودم و اینجا اصلاح کردم.
در واقع token خودش در Info برمیگرده بنابراین باید بصورت زیر نوشته بشه:

Case ".info.token"

فایل نمونه پیوست رو اگر کسی دریافت کرده باید اصلاح بشه.

البته تا زمانی که اطلاعات واقعی رو (که جناب میرزازاده فرستادن) در دست نداشتم متوجه این مورد نشده بودم.

**mazoolagh** · سه شنبه 13 آبان 1399, 10:07 صبح

نوشته شده توسط amirzazadeh

با سلام و احترام
به منظور جلوگيري از تداخل تالارها تاپيك رو در تالار دات نت ايجاد كردم. بنابراين مبحث رو با رويكرد VBA اينجا ادامه ميديم و بحت مربوط به استفاده از vb.net رو در تالار مربوطه پيگيري بفرماييد.
لينك تاپك در تالار دات.نت
https://barnamenevis.org/showthread....�ه-سلامت

البته یک تاپیک دیگه هم در بخش وب سرویس ها ساخته شده که من تا دست کم یک هفته ازش خبر نداشتم!
https://barnamenevis.org/showthread....A7%D9%85%D8%AA
چون در این تاپیک پاسخ دیگه هم هست و در بخش مناسبتری هم آمده، اونجا پست میکنم.

**mazoolagh** · سه شنبه 13 آبان 1399, 10:47 صبح

نوشته شده توسط amirzazadeh

با سلام و عرض ادب
برای مرحله دوم که ایجاد نشست کاری هست من با بهره گیری از تجارب دوستان عزیز از این کد ها استفاده کردم ولی با وجود ارسال اطلاعات پیام خطای ذیل دریافت میشه:

{

  "resMessage" : "توکن نامعتبر می باشد.",

  "resCode" : -12111,

  "info" : null

}

ضمنا استاتوس دریافتی 400 هست.

سلام و روز خوش
لطفا در مورد این clientIPAddress و clientAgentinfo یک توضیح بدین که دقیقا چی هست؟

**amirzazadeh** · سه شنبه 13 آبان 1399, 12:43 عصر

با سلام و درود تبریک عید میلاد پیامبر

فایل بروز شده راهنما را براتون آپلود کردم

http://s17.picofile.com/file/8412711...D8%AA.rar.html

با توجه به راهنمای مذکور
clientIPAddress : همون ip valid کاربر هست که به نظر میاد برای ارتقای امنیت سیستم دریافت میشه.
مورد دوم برای من هم مبهم هست ولی با توجه به توضیحات فایل راهنما مربوط به ip مرورگر وب مورد استفاده هست(ie,mozilla,...)
باز هم ممنون به خاطر توجه شما به این تاپیک
......................

**mazoolagh** · سه شنبه 13 آبان 1399, 13:47 عصر

باید سر فرصت مطالعه کنم ببینم چی به چی هست.
فعلا که مشخص شد در 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 .

**ATA_TABRIZ** · چهارشنبه 14 آبان 1399, 14:39 عصر

سلام
خسته نباشد از توجه شما نهایت تشکر را دارم
من وقتی ماژول را به پروژه ام اضافه کردم این اررور را میده
Error.png

لطف میکنید علت را بفرمائید
ممنون از توجه شما

**amirzazadeh** · چهارشنبه 14 آبان 1399, 19:48 عصر

نوشته شده توسط ATA_TABRIZ

سلام
خسته نباشد از توجه شما نهایت تشکر را دارم
من وقتی ماژول را به پروژه ام اضافه کردم این اررور را میده
Error.png

لطف میکنید علت را بفرمائید
ممنون از توجه شما

سلام
احتمالا ماژول دوم (JSON Parser)كه وظيفه تفسير پاسخ رو بر عهده داره به برنامه اضافه نكرديد( در برنامه ضميمه شده توسط جناب mazoolagh اين ماژول موجود هست).
.......................
موفق باشيد

**ATA_TABRIZ** · پنج شنبه 15 آبان 1399, 17:32 عصر

سلام مجدداداز توجه شما ممنونم
جناب امیرزاده ماژول دوم را اضافه کرده بودم باز دوباره تست کردم همان اررور را داد
جالب بود یک دیتابیس جدید ایجاد کردم دوتا ماژول را ایمپورت کردم باز یک اررور دیگه داد Error.png

**amirzazadeh** · پنج شنبه 15 آبان 1399, 19:08 عصر

سلام
تصوير رفرنس هاي مورد نياز رو براتون اپلود كردم ببينيد همه رو تو برنامتون اضافه كرديد.

**ATA_TABRIZ** · جمعه 16 آبان 1399, 12:26 عصر

نوشته شده توسط amirzazadeh

سلام
تصوير رفرنس هاي مورد نياز رو براتون اپلود كردم ببينيد همه رو تو برنامتون اضافه كرديد.

سلام جناب amirzazadeh
ممنون از لطفتون
حل شد
تمام رفرنس وجود داشت فقط باید ترتیب قرار گرفتن رفرنس عوض میشد

بازم از توجه شما تشکر میکنم1.png

**amirzazadeh** · جمعه 16 آبان 1399, 22:34 عصر

نوشته شده توسط ATA_TABRIZ

سلام جناب amirzazadeh
ممنون از لطفتون
حل شد
تمام رفرنس وجود داشت فقط باید ترتیب قرار گرفتن رفرنس عوض میشد

بازم از توجه شما تشکر میکنم1.png

آیا دریافت توکن موفقیت آمیز بود؟

**amirzazadeh** · یک شنبه 18 آبان 1399, 00:12 صبح

با سلام و عرض ادب
با کمک دوستان عزیز و گرامی مرحله دوم هم به سرانجام رسید و ایجاد جلسه کاری (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 صرفا نمایشی بوده و هر مقداری رو قبول می کنند.
...............

**amirzazadeh** · یک شنبه 18 آبان 1399, 14:19 عصر

سلام و درود
برای ایجاد مرحله سوم که نشست شهروند هست مطابق مراحل قبلی کدها ارسال میشه:

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=

پیشنهادتون برای رفع این مشکل چیه؟
..........
سپاسگزارم

**amirzazadeh** · سه شنبه 20 آبان 1399, 14:10 عصر

سلام
با استفاده از این ماژول مشکل برطرف شد.

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))

.........................

**mazoolagh** · پنج شنبه 06 آذر 1399, 10:54 صبح

سلام و روز خوش
داستان این به کجا رسید؟
همه سرویس ها رو نوشتین و جواب گرفتین؟

**amirzazadeh** · پنج شنبه 06 آذر 1399, 13:45 عصر

سلام و درود فراوان
در حال کلنجار با سرویس های ذخیره نسخه هستم.
فقط در مورد تفسیر پاسخ در حالتیکه info به صورت آرایه دریافت میشه نحوه استخراج ارایه ها به چه شکلی خواهد بود؟

**mazoolagh** · شنبه 08 آذر 1399, 13:45 عصر

لطفا همین response رو در یک فایل text پیوست یا ایمیل کنین.
در ضمن مشخص کنین که مربوط به کدوم سرویس بوده.

**amirzazadeh** · شنبه 08 آذر 1399, 23:14 عصر

سلام . کد سرویس مورد نظر(جستجو 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

**amirzazadeh** · شنبه 08 آذر 1399, 23:36 عصر

این هم پاسخ دریافتی که برای یک کد ژنریک سه کد 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"

    }

  } ]

}

**mazoolagh** · یک شنبه 09 آذر 1399, 13:52 عصر

...... Time

**mazoolagh** · دوشنبه 10 آذر 1399, 12:00 عصر

یک parser دیگه (از همون آقای Tim Hall) هست که کاملتره و البته کدش هم مفصلتر - اینجا کپی نمیکنم کدش رو ولی در گیت هست:
https://github.com/VBA-tools/VBA-JSON

و البته در برنامه پیوست هم میتونین ببینین.

**mazoolagh** · دوشنبه 10 آذر 1399, 12:05 عصر

برای راحتی در برنامه پیوست 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

**mazoolagh** · دوشنبه 10 آذر 1399, 12:07 عصر

روش کار مشخص هست و بخصوص برای شما نیاز به توضیح بیشتری نیست.
10.PNG

**mazoolagh** · دوشنبه 10 آذر 1399, 12:09 عصر

برنامه نمونه:

**amirzazadeh** · دوشنبه 10 آذر 1399, 17:29 عصر

نوشته شده توسط mazoolagh

برنامه نمونه:

سپاس و درود بيكران
و ممنون به خاطر پاسخ كامل مبسوط و نمونه همراه .
..................................
پيروز و سربلند باشيد.

**amirzazadeh** · سه شنبه 11 آذر 1399, 13:52 عصر

نوشته شده توسط mazoolagh

برنامه نمونه:

با سلام و تشکر ویژه

کدها رو با برنامه خودم چک کردم .عالی و بی نقص عمل می کنند.

**amirzazadeh** · سه شنبه 09 دی 1399, 12:24 عصر

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

کدها مربوط به وب سرویس واکشی نسخه ارائه شده صفحه 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

**amirzazadeh** · سه شنبه 09 دی 1399, 14:02 عصر

سلام مجدد
با عرض قسمت معرفی رو جا انداخته بودم.

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

**amirzazadeh** · سه شنبه 09 دی 1399, 14:04 عصر

پاسخ دریافتی :

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" : [ ]

  }

}

**mazoolagh** · چهارشنبه 10 دی 1399, 10:34 صبح

سلام آقای میرزازاده
بهتره فقط از یک 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,

 }]

 }

}

نام تاپیک: وب سرویس

ابزار های تاپیک

نمایش

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

نقل قول: وب سرویس

تاپیک های مشابه

پذیرش کارآموز در زمینه برنامه نویس اندروید و برنامه نویس یونیتی

برنامه-نویس و معمار قهار J2EE/Java -- به «تیم سرویس های ابری» PersianGIG بپیوندید!

گفتگو: راست نویس,چپ نویس و وسط نویس در textarea

قوانین ایجاد تاپیک در تالار