وب سرویس

[ATA_TABRIZ]

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

152272

[ATA_TABRIZ]

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

152272

سلام
اساتید نمیخوان کمک کنن
جناب Mazoolag کجایی ؟؟؟؟؟

[amirzazadeh]

سلام
آدرس وب سرويس لود نميشه.
http://tdtst.ihio.gov.ir/ws/ServiceApprove.asmx

[ATA_TABRIZ]

ضمن تشکر از توجه شما ادرس های زیر جهت استحضار
در محيط تست:http://test.ihio.gov.ir/hdkcore/api/services/authenticationservice?wsdl
در محيط عملياتی:http://webapi.ihio.gov.ir/hdkcore/api/services/authenticationservice?wsdl

[mazoolagh]

اصول کار که فرقی نمیکنه، شما باید یک request با فرمتی که براتون مشخص شده بفرستین و یک response دریافت و اون رو طبق فرمتی که بهتون داده شده تفسیر کنین.
تو پست های مربوط به تامین اجتماعی همه اینها بحث شد، کافی هست اسکلت کد رو نگه دارین و تغییرات رو در اون اعمال کنید.

اینجا شما بیشتر از یک سرویس دارین :
http://test.ihio.gov.ir/hdkcore/api/services/

شما فقط لینک یکی از سرویس ها رو فرستادین، برای هر سرویس مستنداتش ارائه میشه که request و response چگونه باید باشن.
یعنی فرمت تاریخ، اطلاعات نسخه، نوع سرویس ارائه شده به بیمار، ...
اینجا شما نیاز دارین مستندات کامل و دقیق 4 نوع tag استفاده شده رو داشته باشین:
operation = نوع عملیات سرویس
input = مقدار ارسالی به سرویس
output = مقدار برگشتی از سرویس
fault = خطا

بطور متعارف نمونه کد هم در مستنداتشون هست.

================
فکر کنم قبلا هم اشاره کردم، برای کار با وب سرویس ها اگر desktop app بسازین (مثلا با vb.net) خیلی بهتره و در ارسال و دریافت هم خیلی راحتین.
بعضی وقتها یک کمپوننت به شما میدن که به برنامه تون اضافه میکنین و فقط کافی هست مقادیر رو به تابع ارسال و نتایج رو بگیرین (وب سرویس ارسال پیامک اگر یادتون باشه).
دیتابیس رو میتونین همون اکسس نگه دارین اگر مایل هستین.

[amirzazadeh]

سلام
چيزي كه من متوجه شدم در مرحله بايد از وب سرويس توكن دريافت بشه كه اعتبار يكروزه داره . براي اينكار بايد از وب سرويس getTOKEN استفاده بشه كه سه تا پارامتر كد موسسه نام كاربر و پسورد رو دريافت و كدي ارسال مي كنه.
براي شروع من كدهاي جناب mazoolagh كمي تغيير دادم ولي تست نشده هست و احتمالا خطا خواهد داشت. لطفا تست بكنيد و نتيجه رو اعلام كنيد.

Option Compare Database

Option Explicit


Const WSURL As String = "http://test.ihio.gov.ir/hdkcore/services/authenticationservice?wsdl"


'--------------------------




Public Type Request_Response


TOKEN_ID As String
ERROR_MESSAGE As String
End Type
'--------------------------


Public Function getTOKEN( _
ByVal pUserInstKey As String, _
ByVal pUserName As String, _
ByVal pPassword As String) As Request_Response




On Error GoTo ERR_HNDLR




Dim RR As Request_Response
RR.TOKEN_ID = ""
RR.ERROR_MESSAGE = ""




Dim XM As String




XM = "<?xml version=""1.0"" encoding=""utf-8""?>"
XM = XM + "<soap12:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap12=""http://www.w3.org/2003/05/soap-envelope"">"
XM = XM + "<soap12:Body>"
XM = XM + "<getTOKEN xmlns=""http://tempuri.org/"">"




XM = XM + "<pUserInstKey>" + pUserInstKey + "</pUserInstKey>"
XM = XM + "<pUserName>" + pUserName + "</pUserName>"
XM = XM + "<pPassword>" + pPassword + "</pPassword>"




XM = XM + "</getTOKEN>"
XM = XM + "</soap12:Body>"
XM = XM + "</soap12:Envelope>"




Dim XML_HTTP As New MSXML2.XMLHTTP60
XML_HTTP.Open "POST", WSURL, False
XML_HTTP.setRequestHeader "HOST", "http://test.ihio.gov.ir/hdkcore/api/services/"
XML_HTTP.setRequestHeader "CONTENT-TYPE", "application/soap+xml; charset=utf-8"
XML_HTTP.setRequestHeader "SOAPACTION", "http://tempuri.org/Save_Request"
XML_HTTP.send XM




Dim XML_DOC As New MSXML2.DOMDocument60
Dim XNL As MSXML2.IXMLDOMNodeList
Dim I As Integer






If XML_HTTP.Status = 200 Then
XML_DOC.loadXML XML_HTTP.responseText
Set XNL = XML_DOC.getElementsByTagName("*")
For I = 0 To XNL.length - 1
Select Case XNL(I).nodeName
Case "TOKEN_Id"
RR.TOKEN_ID = XNL(I).Text
Case "ErrorMessage"
RR.ERROR_MESSAGE = XNL(I).Text


End Select
Next
Else
RR.ERROR_MESSAGE = CStr(XML_HTTP.Status) + XML_HTTP.StatusText
End If




getTOKEN = RR
Set XML_HTTP = Nothing




Exit Function
ERR_HNDLR:
RR.ERROR_MESSAGE = "ERROR " + CStr(Err.number) + vbCrLf + Err.Description
getTOKEN = RR




End Function

[amirzazadeh]

سلام و درود
راهنماي كامل وب سرويس رو پيدا كردم.براي استفاده دوستان اپلود مي كنم.
https://yz.ihio.gov.ir/Portals/37/HDK_ERX_WebServiceUserGuide_V_0.995.pdf?ver=1399-02-23-105319-563

[atf1379]

سلام و درود
راهنماي كامل وب سرويس رو پيدا كردم.براي استفاده دوستان اپلود مي كنم.
https://yz.ihio.gov.ir/Portals/37/HDK_ERX_WebServiceUserGuide_V_0.995.pdf?ver=1399-02-23-105319-563

با تشکر از جناب amirzazadeh (https://barnamenevis.org/member.php?47888-amirzazadeh)

[amirzazadeh]

سلام
با استفاده از راهنماي پست 7 کدها رو بازنويسي کردم ولي هنوز مشکل داره.با آدرس "http://test.ihio.gov.ir/hdkcore/services/authenticationservice?wsdl" استاتوس 500 دريافت ميشه و با آدرس "http://http://test.ihio.gov.ir/erx-core/v1/service/auth/token/fetch" عدم دسترسي صادر ميشه.
اين هم کد بازنويسي شده:

Option Compare Database

Option Explicit


Const WSURL As String = "http://test.ihio.gov.ir/hdkcore/services/authenticationservice?wsdl"
'Const WSURL As String = "http://http://test.ihio.gov.ir/erx-core/v1/service/auth/token/fetch"

'--------------------------

Public Type Request_Response

resCode As Integer
token As String
resMessage As String
End Type
'--------------------------


Public Function getTOKEN( _
ByVal terminalId As String, _
ByVal userName As String, _
ByVal Password As String) As Request_Response


On Error GoTo ERR_HNDLR


Dim RR As Request_Response
RR.token = ""
RR.resCode = -1
RR.resMessage = ""


Dim XM As String


XM = "<?xml version=""1.0"" encoding=""utf-8""?>"
XM = XM + "<soap12:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap12=""http://www.w3.org/2003/05/soap-envelope"">"
XM = XM + "<soap12:Body>"
XM = XM + "<getTOKEN xmlns=""http://tempuri.org/"">"


XM = XM + "<terminalId>" + terminalId + "</terminalId>"
XM = XM + "<userName>" + userName + "</userName>"
XM = XM + "<password>" + Password + "</password>"


XM = XM + "</getTOKEN>"
XM = XM + "</soap12:Body>"
XM = XM + "</soap12:Envelope>"


Dim XML_HTTP As New MSXML2.XMLHTTP60
XML_HTTP.Open "POST", WSURL, False
XML_HTTP.setRequestHeader "HOST", "http://test.ihio.gov.ir/hdkcore/services/authenticationservice?wsdl"
XML_HTTP.setRequestHeader "CONTENT-TYPE", "application/soap+xml; charset=utf-8"
XML_HTTP.setRequestHeader "SOAPACTION", "http://tempuri.org/Save_Request"
XML_HTTP.send XM



Dim XML_DOC As New MSXML2.DOMDocument60
Dim XNL As MSXML2.IXMLDOMNodeList
Dim I As Integer


If XML_HTTP.Status = 200 Then
XML_DOC.LoadXML XML_HTTP.responseText
Set XNL = XML_DOC.getElementsByTagName("*")
For I = 0 To XNL.Length - 1
Select Case XNL(I).nodeName
Case "token"
RR.token = XNL(I).Text
Case "resmessage"
RR.resMessage = XNL(I).Text
Case "resCode"
RR.resCode = XNL(I).Text
End Select
Next
Else
RR.resMessage = CStr(XML_HTTP.Status) + XML_HTTP.StatusText
End If


getTOKEN = RR
Set XML_HTTP = Nothing

Exit Function
ERR_HNDLR:
RR.resMessage = "ERROR " + CStr(Err.Number) + vbCrLf + Err.Description
getTOKEN = RR

End Function

[ATA_TABRIZ]

با سلام
ضمن تشکر از توجه استادان محترم خصوصا جناب Amirzadeh , Mazoolagh بنده کد های شما تست کردم در سایت آزمایشی به قول آقای Amirzadeh ارورر 500 را میده و در سایت اصلی پیغام زیر را میاره
که من اصلا متوجه نشدم لذا در صورت امکان کمک کنید تا انشالله بتونیم ارتیابط با بیمه را برقرار نماییم
ERROR -2146697211The system cannot locate the resource specified.

[amirzazadeh]

با سلام
ضمن تشکر از توجه استادان محترم خصوصا جناب Amirzadeh , Mazoolagh بنده کد های شما تست کردم در سایت آزمایشی به قول آقای Amirzadeh ارورر 500 را میده و در سایت اصلی پیغام زیر را میاره
که من اصلا متوجه نشدم لذا در صورت امکان کمک کنید تا انشالله بتونیم ارتیابط با بیمه را برقرار نماییم
ERROR -2146697211The system cannot locate the resource specified.
سلام
جناب آقاي Mazoolagh به نكته مهمي اشاره كردند و اون ساختار تگها هست تا ما به اين ساختار دسترسي نداشته باشيم ارتباط با سرور ناممكن خواهد بود بنابراين سعي كنيد كه با ارتباط با كارشناسان IT سازمان بيمه سلامت اين اطلاعات رو به دست بياريد.
..........................
موفق باشيد

[ATA_TABRIZ]

سلام
جناب آقاي Mazoolagh به نكته مهمي اشاره كردند و اون ساختار تگها هست تا ما به اين ساختار دسترسي نداشته باشيم ارتباط با سرور ناممكن خواهد بود بنابراين سعي كنيد كه با ارتباط با كارشناسان IT سازمان بيمه سلامت اين اطلاعات رو به دست بياريد.
..........................
موفق باشيد

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

[amirzazadeh]

جناب آقای Amirzadeh خیلی متشکرم که توجه به مشکل بنده دارید
عرض بشود خدمتتان که ساختار تگها عین تامین اجتماعی و بین المللی است در مرحله اول باید توکن دریافت گردد که که سه تا ورودی و یک خروجی دارد اگر از این مرحله نتیجه بگیریم بقیه داده ها نیز مشخص میباشد
مجددا از توجه شما و استاد Mazoolagh نهایت تشکر را دارم .
سلام
در خصوص ساختار xml نسخ حق با شماست ولي ساختار وب سرويس هر بيمه مخصوص به خودش هست كما اينكه در وب سرويس تامين احراز هويت با نام كاربري و پسورد (UserId و Password) انجام ميشه ولي بيمه سلامت از سه پارامتر كد موسسه نام كاربري و پسورد(pUserInstKey , pUserName,pPassword) استفاده ميكنه. بنابراين مجددا تاكيد مي كنم دريافت ساختار اجنتاب ناپذير هست.

[ATA_TABRIZ]

سلام
در خصوص ساختار xml نسخ حق با شماست ولي ساختار وب سرويس هر بيمه مخصوص به خودش هست كما اينكه در وب سرويس تامين احراز هويت با نام كاربري و پسورد (UserId و Password) انجام ميشه ولي بيمه سلامت از سه پارامتر كد موسسه نام كاربري و پسورد(pUserInstKey , pUserName,pPassword) استفاده ميكنه. بنابراين مجددا تاكيد مي كنم دريافت ساختار اجنتاب ناپذير هست.

ضمن تشکر از آقای amirzadeh از جناب Mazoolagh خواهشمندیم کدهای فوق را بررسی نمایند

[ATA_TABRIZ]

سلام
در خصوص ساختار xml نسخ حق با شماست ولي ساختار وب سرويس هر بيمه مخصوص به خودش هست كما اينكه در وب سرويس تامين احراز هويت با نام كاربري و پسورد (UserId و Password) انجام ميشه ولي بيمه سلامت از سه پارامتر كد موسسه نام كاربري و پسورد(pUserInstKey , pUserName,pPassword) استفاده ميكنه. بنابراين مجددا تاكيد مي كنم دريافت ساختار اجنتاب ناپذير هست.

جناب Amirzadeh شما درست میفرمائید بیمه سلامت یه کم مسئله را پیچیده کرده ولی چاره ای نیست اونظور که من فهمیدم از سه تا سرویس استفاده میکنه که اولی به قول شما احراز هویت است لذا من فکر میکنم که اگر این قسمت ارتباط داده بشه و کد توکن دریافت گردد بقیه مثل تامین وابسته به tagهای دفترچه و غیره میباشد لذا از شما و جناب Mazoolagh خواهشمندم این کدهایی که شما زحمت کشیدین بررسی کنید تا بوسیله این کدها اگر موفق به دریافت توکن شویم بقیه را انشالله طی خوایم کرد
مجددا از لطف شما ممنونم

[mazoolagh]

جناب ata_tabriz
من کدی رو که جناب میرزازاده زحمتش رو کشیده بودن یک نگاه انداختم، شما باید فرمتش رو از xml به json تغییر بدین.
برخلاف تامین اجتماعی که از فرمت xml استفاده میکرد، اینجا از json استفاده شده و این دو یکی نیستن.

اول باید content type رو به application/json تغییر بدین.
احتمالا باید پارامتر accept هم به header اضافه کنین با همین مقدار application/json.

بعد متن درخواست رو شبیه زیر استفاده کنین:
XM="{""terminalId"":123,""userName"":""test"",""password"":""test123""}"

[mazoolagh]

دوباره تاکید میکنم VBA برای اینکار ابزار مناسبی نیست، بخصوص که اینجا شما سرویس های متنوعی دارین و یک گردش کار نسبتا پیچیده (در مقایسه با وب سرویس تامین اجتماعی).

با نگاه به مستنداتی که جناب میرزازاده زحمت کشیدن و پیدا کردن، بنظر میاد این وب سرویس برخلاف وب سرویس تامین اجتماعی توسط یک تیم حرفه ای و کاربلد طراحی شده و جدای از موارد فنی یک گردش کار هم هست که باید اول اون رو بدونین.

بهتره یک windows application بنویسین که دست کم مشکل ساخت request و تفسیر response رو نداشته باشین و مطمئن باشین که اگر مشکلی هست به گردش کار برمیگرده.

[mazoolagh]

من یک نمونه با VB.NET میگذارم تا متوجه بشین چقدر کار ساده هست اونجا.

اول یک SERVICE REFRENCE به پروژه اضافه میکنیم:
152335
اگر دقت کنید لیست تمام عملیات این سرویس خودکار ساختمه میشه و مثل یک تابع آماده میتونین از اون استفاده کنین.

یک کد نمونه شبیه زیر هست:
Dim asc As New HDKAuthenticationServiceClient
Dim w As New dtoAuthenticationInfoWrapper
w = asc.fetchAgentDailyToken(terminalId:=123, userName:="test", password:="test123")
Dim Token As String = w.generatedToken

[amirzazadeh]

من یک نمونه با VB.NET میگذارم تا متوجه بشین چقدر کار ساده هست اونجا.

اول یک SERVICE REFRENCE به پروژه اضافه میکنیم:
152335
اگر دقت کنید لیست تمام عملیات این سرویس خودکار ساختمه میشه و مثل یک تابع آماده میتونین از اون استفاده کنین.

یک کد نمونه شبیه زیر هست:
Dim asc As New HDKAuthenticationServiceClient
Dim w As New dtoAuthenticationInfoWrapper
w = asc.fetchAgentDailyToken(terminalId:=123, userName:="test", password:="test123")
Dim Token As String = w.generatedToken

http://s17.picofile.com/file/8411202092/error
با سلام و احترام
با تشکر از کمک های ارزنده شما طبق راهنمایی وب سرویس رو به رفرنس ها اد کردم و کدهای نمونه رو اضافه و اجرا کردم که متاسفانه در مرحله اجرا متوقف شد.ممنون میشم بررسی بفرمایید.

[mazoolagh]

سلام و روز خوش
یک احتمال قوی این هست که کد نمونه ای که گذاشتم نادرست باشه (خودم چک نکردم) یعنی به شکل درست از تابع استفاده نکردم هرچند که ظاهرا درست باشه و موقع کامپایل خطا نگیره.
قطعا شما namespace مناسب رو import کردین در غیر اینصورت کد اصلا اجرا نمیشد و خطا موقع کامپایل پیش میامد.

احتمال هرچند ضعیفتر این هست که کدهای ساخته شده توسط visual studio مشکل داشته باشن و لازم باشه که اونها رو ویرایش کرد.

میخواستم از شما خواهش کنم اگر براتون امکان داره یک تاپیک در بخش vb.net ایجاد کنین و این مبحث رو اونجا ادامه بدیم تا بتونیم از دانش و تجربه دیگران هم استفاده کنیم.

[amirzazadeh]

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

[ATA_TABRIZ]

سلام آقای Amirzadeh, جناب Mazoolagh
باز این تایپک قدمهایی جهت حل مشکل برداشته شد در قسمت vb هیچکس توجهی نکرد !!!!!

[amirzazadeh]

سلام آقای Amirzadeh, جناب Mazoolagh
باز این تایپک قدمهایی جهت حل مشکل برداشته شد در قسمت vb هیچکس توجهی نکرد !!!!!

سلام و وقت به خير
تو تالار وب سرويس ها نمونه با vb.net اراىه شده كه ارسال پارامترها رو انجام ميده ولي چون يوزر پسورد واقعي نداريم توكن دريافت نمي كنيم.

[amirzazadeh]

Imports RestSharp

Public Class Form1

Private Async Function FetchAgentDailyToken() As Task(Of String)
Dim Result As String = String.Empty
Await Task.Run(Sub()
Try
Dim rest_client As IRestClient = New RestClient()
Dim rest_request As IRestRequest = New RestRequest("http://webapi.ihio.gov.ir/erx-core/v1/service/auth/token/fetch", Method.POST)
rest_request.AddJsonBody("{""terminalId"": 123,""userName"": ""123"",""password"": ""123abc""}")
Dim rest_response As IRestResponse = rest_client.Execute(rest_request)
Result = rest_response.Content
Catch ex As Exception
End Try
End Sub)
Return Result
End Function

Private Async Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim test As String = Await FetchAgentDailyToken()
MsgBox(test)
End Sub
End Class


کدهای استفاده شده رو براتون ارسال کردم . همینطور که تو سطر اول کدها ملاحظه می کنید از restsharp استفاده شده، من این dll رو دانلود کردم ولی به رفرنس های اکسس اضافه نمیشه.

[336699]

سلام
اکسس برای اینکار مناسب نیست، بهتر هست از vb.net و دیتابیس sqlite استفاده نمایید.

[mazoolagh]

سلام آقای Amirzadeh, جناب Mazoolagh
باز این تایپک قدمهایی جهت حل مشکل برداشته شد در قسمت vb هیچکس توجهی نکرد !!!!!

البته همونجا یک تاپیک دیگه در همسایگی شما بود با مضمون مشابه (وب سرویس ارسال پیامک) که اون هم بی جواب مونده!
پس احتمالا موضوع بی توجهی نبوده.

[mazoolagh]

سلام
اکسس برای اینکار مناسب نیست، بهتر هست از vb.net و دیتابیس sqlite استفاده نمایید.

سلام و روز خوش
لطف بفرمایید در همون بخش vb.net که جناب میرزازاده تاپیک مستقل برای همین موضوع ایجاد کردن (لینک تاپیک هم رو چند پست بالاتر گذاشتن) راهنمایی بفرمایید.
در مورد این که vb.net مناسبتر هست قبلا اشاره شد و نوع دیتابیس هم اصلا اهمیتی در این کار نداره.

[mazoolagh]

سلام و وقت به خير
تو تالار وب سرويس ها نمونه با vb.net اراىه شده كه ارسال پارامترها رو انجام ميده ولي چون يوزر پسورد واقعي نداريم توكن دريافت نمي كنيم.

مرحله اول مهم نیست که User/pass واقعی داشته باشیم، همین که پروسه ارسال و دریافت پیغام خطا انجام بشه کافی هست.
بفرمایید که شما با کدی که پیوست کردین جواب گرفتین؟

[336699]

سلام و روز خوش
لطف بفرمایید در همون بخش vb.net که جناب میرزازاده تاپیک مستقل برای همین موضوع ایجاد کردن (لینک تاپیک هم رو چند پست بالاتر گذاشتن) راهنمایی بفرمایید.
در مورد این که vb.net مناسبتر هست قبلا اشاره شد و نوع دیتابیس هم اصلا اهمیتی در این کار نداره.
سلام
در اون بخش وی بی نمونه کد ارسال کردم که پاسخ از سرور هم دریافت میکنه(همین کدهای وی وبی دات نت که چند پست بالاتر هستند)
الان ظاهرا چند پست آخر اون بخش کلا ناپدید شده

در مورد دیتابیس هم اگه قرار باشه برنامه با وی بی دانت نوشته بشه بهتر هست از sql یا sqlite استفاده بشه و دیتابیس اکسس مناسب نیست.

[amirzazadeh]

مرحله اول مهم نیست که User/pass واقعی داشته باشیم، همین که پروسه ارسال و دریافت پیغام خطا انجام بشه کافی هست.
بفرمایید که شما با کدی که پیوست کردین جواب گرفتین؟
با سپاس از دوست گرامي جناب 336699 بله به صورت كامل ارسال و دريافت صورت مي گيره.

[mazoolagh]

من یک نمونه با VB.NET میگذارم تا متوجه بشین چقدر کار ساده هست اونجا.

اول یک SERVICE REFRENCE به پروژه اضافه میکنیم:
152335
اگر دقت کنید لیست تمام عملیات این سرویس خودکار ساختمه میشه و مثل یک تابع آماده میتونین از اون استفاده کنین.

یک کد نمونه شبیه زیر هست:
Dim asc As New HDKAuthenticationServiceClient
Dim w As New dtoAuthenticationInfoWrapper
w = asc.fetchAgentDailyToken(terminalId:=123, userName:="test", password:="test123")
Dim Token As String = w.generatedToken

دلیل اینکه پیشنهاد کردم از vb.net استفاده کنیم راحتی کار با استفاده از service reference بود و گرنه اگر قرار به استفاده از رفرنس و helper و کدنویسی باشه در اکسس هم اینکار شدنی هست و پیچیدگی بیشتری هم نداره.
بر خلاف response های xml که در اکسس براحتی قابل parse کردن هستن (نمونه اش رو در وب سرویس ارسال پیامک آوردم)، پاسخ های json نیاز به parser بیرونی دارن.
در هر صورت برای ارسال و گرفتن پاسخ نیازی به اونها نداریم و کار راحتی هست ولی برای تفسیر پاسخ داستان فرق میکنه.

[mazoolagh]

جناب ata_tabriz
من کدی رو که جناب میرزازاده زحمتش رو کشیده بودن یک نگاه انداختم، شما باید فرمتش رو از xml به json تغییر بدین.
برخلاف تامین اجتماعی که از فرمت xml استفاده میکرد، اینجا از json استفاده شده و این دو یکی نیستن.

اول باید content type رو به application/json تغییر بدین.
احتمالا باید پارامتر accept هم به header اضافه کنین با همین مقدار application/json.

بعد متن درخواست رو شبیه زیر استفاده کنین:
XM="{""terminalId"":123,""userName"":""test"",""password"":""test123""}"

این مورد هم قبلا اشاره کرده بودم که اگر دقت میشد مشکل تابحال حل شده بود.

[mazoolagh]

همین چند خط زیر برای ارسال درخواست کافی هست:
Const WSURL As String = "http://webapi.ihio.gov.ir/erx-core/v1/service/auth/token/fetch"
Const AuthJSON As String = "{""terminalId"": 123456,""userName"": ""test_username"",""password"": ""test_password""}"

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
End With

و پاسخ خام رو در responseText خواهیم داشت.

[mazoolagh]

من در پروژه های قدیمی در اکسس مستقیما از خود مفسر جاوااسکریپت (از طریق اضافه کردن رفرنس scripting runtime در دسترس هست) برای parse عبارتهای json استفاده میکردم.
ولی برای این مورد یک کد سبک و جمع و جور پیدا کردم و چند تغییر جزئی در اون دادم و فکر میکنم کفایت هست (دست کم تا اینجا).

کد رو در پست بعد میگذارم و اطلاعات بیشتر رو میتونین در لینک زیر پیدا کنین:
https://medium.com/swlh/excel-vba-parse-json-easily-c2213f4d8e7a

[mazoolagh]

'-------------------------------------------------------------------'
VBA JSON Parser
'-------------------------------------------------------------------
Option Explicit
Private p As Integer, token, dic

Function ParseJSON(json As String, Optional key As String = "obj") As Dictionary
p = 1
token = Tokenize(json)
Set dic = New Dictionary
If token(p) = "{" Then ParseObj key Else ParseArr key
Set ParseJSON = dic
End Function

Function ParseObj(key As String)
Do: p = p + 1
Select Case token(p)
Case "]"
Case "[": ParseArr key
Case "{": ParseObj key
Case "{"
If token(p + 1) = "}" Then
p = p + 1
dic.Add key, "null"
Else
ParseObj key
End If

Case "}": key = ReducePath(key): Exit Do
Case ":": key = key & "." & token(p - 1)
Case ",": key = ReducePath(key)
Case Else: If token(p + 1) <> ":" Then dic.Add key, token(p)
End Select
Loop
End Function

Function ParseArr(key As String)
Dim e As Integer
Do: p = p + 1
Select Case token(p)
Case "}"
Case "{": ParseObj key & ArrayID(Val(e))
Case "[": ParseArr key
Case "]": Exit Do
Case ":": key = key & ArrayID(Val(e))
Case ",": e = e + 1
Case Else: dic.Add key & ArrayID(Val(e)), token(p)
End Select
Loop
End Function
'-------------------------------------------------------------------
' Support Functions
'-------------------------------------------------------------------
Function Tokenize(s As String)
Const Pattern = """(([^""\\]|\\.)*)""|[+\-]?(?:0|[1-9]\d*)(?:\.\d*)?(?:[eE][+\-]?\d+)?|\w+|[^\s""']+?"
Tokenize = RExtract(s, Pattern, True)
End Function

Function RExtract(s As String, Pattern, Optional bGroup1Bias As Boolean, Optional bGlobal As Boolean = True)
Dim c As Integer, m, n, v
With CreateObject("vbscript.regexp")
.Global = bGlobal
.MultiLine = False
.IgnoreCase = True
.Pattern = Pattern
If .TEST(s) Then
Set m = .Execute(s)
ReDim v(1 To m.Count)
For Each n In m
c = c + 1
v(c) = n.Value
If bGroup1Bias Then If Len(n.submatches(0)) Or n.Value = """""" Then v(c) = n.submatches(0)
Next
End If
End With
RExtract = v
End Function

Function ArrayID(e As String) As String
ArrayID = "(" & e & ")"
End Function

Function ReducePath(key As String) As String
If InStr(key, ".") Then ReducePath = Left(key, InStrRev(key, ".") - 1) Else ReducePath = key
End Function

[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

[mazoolagh]

روش استفاده:

Sub TEST()
Dim x As DailyToken
x = GetDailyToken()
Debug.Print "resCode=" + CStr(x.resCode) + vbCrLf + "resMessage=" + x.resMessage + vbCrLf + "token=" + x.token
End Sub

[mazoolagh]

خروجی کد بالا:

152376

[mazoolagh]

برنامه نمونه

[amirzazadeh]

سلام
با سپاس و درود فراوان
عالی و بدون نقص :تشویق::تشویق::تشویق:
دست مریزاد.
.....................
موفق و پیروز باشید

[ATA_TABRIZ]

برنامه نمونه

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

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

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

[amirzazadeh]

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

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

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

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

[mazoolagh]

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

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

[amirzazadeh]

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

[mazoolagh]

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

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

[amirzazadeh]

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

[mazoolagh]

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

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

[ATA_TABRIZ]

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

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

[amirzazadeh]

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

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

حالا با استفاده از این 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]

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


البته یک تاپیک دیگه هم در بخش وب سرویس ها ساخته شده که من تا دست کم یک هفته ازش خبر نداشتم!
https://barnamenevis.org/showthread.php?562977-%D9%88%D8%A8-%D8%B3%D8%B1%D9%88%D9%8A%D8%B3-%D8%A8%D9%8A%D9%85%D9%87-%D8%B3%D9%84%D8%A7%D9%85%D8%AA
چون در این تاپیک پاسخ دیگه هم هست و در بخش مناسبتری هم آمده، اونجا پست میکنم.

[mazoolagh]

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

{
"resMessage" : "توکن نامعتبر می باشد.",
"resCode" : -12111,
"info" : null
}
ضمنا استاتوس دریافتی 400 هست.


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

[amirzazadeh]

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

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

http://s17.picofile.com/file/8412711326/%D9%85%D8%B3%D8%AA%D9%86%D8%AF%D8%A7%D8%AA.rar.htm l (http://s17.picofile.com/file/8412711326/%D9%85%D8%B3%D8%AA%D9%86%D8%AF%D8%A7%D8%AA.rar.htm l)


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

[mazoolagh]

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

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

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

[amirzazadeh]

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

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

[ATA_TABRIZ]

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

[amirzazadeh]

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

[ATA_TABRIZ]

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

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


بازم از توجه شما تشکر میکنم152404

[amirzazadeh]

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


بازم از توجه شما تشکر میکنم152404

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

[amirzazadeh]

با سلام و عرض ادب
با کمک دوستان عزیز و گرامی مرحله دوم هم به سرانجام رسید و ایجاد جلسه کاری (session) تکمیل گردید:

{
"resCode" : 1,
"resMessage" : "عملیات با موفقیت انجام شد",
"info" : {
"sessionId" : "95cc39043e2475fcbc9b30834cf528c148952fÐÑ6Ò8Ô?1 52Ù11Ô09d3835edda6a493f680e4d5298de95505ebadaf51 c938cbd6328c54ae893abd705c8fcb6888037b5946d65f402d 48a35be3b13460c4e9fe15b1c26caeaaa6c862f64fa4cdeb28 7b3966f8cb794dd923146c731866b95db13621899509e80a2f 68fd47d37f4147513782d4d49d3208e158bea4d754eÒÑÓ? ÖeÚÒÓÐÐ5114d23cdee67ed4b43e7d15b1df4efe85d71 dÒ?ÐÖ?c4ÐÒÚ1Ô?9ÕÚ4ÙØ54?e1da25202d83f327 97725d50482abff4998905f58b7094d7e6fe582ac4c8dacc90 4011afd2f35382345bcdd35ceb61ff2450bff2386a3be18fc9 1ee575cd8aba23a4b727b3374d32a73022f046add5f5e23d3a 26639744990990173b27f1b0a4e416394c59032d36cd58dd11 9c1ea447e4e3d8593e44b71804159142d252bf2ce419948c4f 26d382bb00d52bd0acf30a32f8307e738f4a736e57e2e5a918 e14097940a2bceb620009d75aaaaab36959544c61e71588f59 36eb13b46e6beb734bfcd0f18b40ab0ba811073a2b01291905 576a2b0d8ea97b16f9f71f32a9100c3c3a7d011efd87800d1c a5084751277df56b2c550aad14b5a17023df4ef2a70f0ac96e cf2f47fe3bd859bc511ce5c91db0f9f48c308d11d600ee44be 6d43",


همانطور که دوست گرانقدر جناب mazoolagh اشاره کرده بودند دو هدر مربوط به ip صرفا نمایشی بوده و هر مقداری رو قبول می کنند.
...............

[amirzazadeh]

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


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Ô?1 52Ù11Ô09d3835edda6a493f680e4d5298de95505ebadaf51 c938cbd6328c54ae893abd705c8fcb6888037b5946d65f402d 48a35be3b13460c4e9fe15b1c26caeaaa6c862f64fa4cdeb28 7b3966f8cb794dd923146c731866b95db13621899509e80a2f 68fd47d37f4147513782d4d49d3208e158bea4d754eÒÑÓ? ÖeÚÒÓÐÐ5114d23cdee67ed4b43e7d15b1df4efe85d71 dÒ?ÐÖ?c4ÐÒÚ1Ô?9ÕÚ4ÙØ54?e1da25202d83f327 97725d50482abff4998905f58b7094d7e6fe582ac4c8dacc90 4011afd2f35382345bcdd35ceb61ff2450bff2386a3be18fc9 1ee575cd8aba23a4b727b3374d32a73022f046add5f5e23d3a 26639744990990173b27f1b0a4e416394c59032d36cd58dd11 9c1ea447e4e3d8593e44b71804159142d252bf2ce419948c4f 26d382bb00d52bd0acf30a32f8307e738f4a736e57e2e5a918 e14097940a2bceb620009d75aaaaab36959544c61e71588f59 36eb13b46e6beb734bfcd0f18b40ab0ba811073a2b01291905 576a2b0d8ea97b16f9f71f32a9100c3c3a7d011efd87800d1c a5084751277df56b2c550aad14b5a17023df4ef2c001fa417e 34ab0cfb714562d3ae18cfad1477264dc84cb4935732409101 889e"",""nationalNumber"": ""1502161206""}"
Const terminalId As Long = 173162
Const token As String = "d448f575db31a44ea15fd57c41483f908456ce5814abece799 9d0884abfc8e364059b0b31bc305a014c8e42c72f96f62c05a bf51b44cded6a7f07c8c78089c9e22bfc41e7c2b5a86689a83 6fab446cd2"
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]

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

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]

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

[amirzazadeh]

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

[mazoolagh]

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

[amirzazadeh]

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

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

...... Time

[mazoolagh]

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

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

[mazoolagh]

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

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

[mazoolagh]

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

[amirzazadeh]

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

[amirzazadeh]

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

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

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

[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

[amirzazadeh]

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

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]

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


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]

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

[mazoolagh]

Public Type DeliveredFetch_orderPartnerInfo
partnerName As String
partnerPhone As String
contractPartyName As String
noMedicalSystem As Long
licenseName As String
End Type


Public Type DeliveredFetch_subscriptionDeliveredInfo
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 DeliveredFetch_Info
orderedDate As String
deliveredDate As String
samadCode As String
typeId As Long
totalAmount As Double
totalPatientPayment As Double
isVisitSimultaneous As Boolean
orderPartnerInfo As DeliveredFetch_orderPartnerInfo
subscriptionDeliveredInfos() As DeliveredFetch_subscriptionDeliveredInfo
subscriptionDeliveredInfosWithNoReference() As DeliveredFetch_subscriptionDeliveredInfo
End Type


Public Type DeliveredFetch
resCode As Long
resMessage As String
Info As DeliveredFetch_Info
End Type

[mazoolagh]

Public Function FetchPrescriptionDelivered(response As String) As DeliveredFetch
Dim R As Object
Set R = ParseJson(response)


FetchPrescriptionDelivered.resCode = R("resCode")
FetchPrescriptionDelivered.resMessage = R("resMessage")


Dim x, y As Object
Set x = R("info")
Dim Info As DeliveredFetch_Info
Dim i As Integer
With Info
.orderedDate = x("orderedDate")
.deliveredDate = x("deliveredDate")
.samadCode = x("samadCode")
.typeId = x("typeId")
.totalAmount = x("totalAmount")
.totalPatientPayment = x("totalPatientPayment")
.isVisitSimultaneous = x("isVisitSimultaneous")
.orderPartnerInfo.partnerName = x("orderPartnerInfo")("partnerName")
.orderPartnerInfo.partnerPhone = x("orderPartnerInfo")("partnerPhone")
.orderPartnerInfo.contractPartyName = x("orderPartnerInfo")("contractPartyName")
.orderPartnerInfo.noMedicalSystem = x("orderPartnerInfo")("noMedicalSystem")
.orderPartnerInfo.licenseName = x("orderPartnerInfo")("licenseName")
Dim Infos() As DeliveredFetch_subscriptionDeliveredInfo
ReDim Infos(1 To x("subscriptionDeliveredInfos").Count)
For i = 1 To UBound(Infos)
Set y = x("subscriptionDeliveredInfos")(i)
With Infos(i)
.numberOfDelivered = y("numberOfDelivered")
.numberOfRequest = y("numberOfRequest")
.numberOfPeriod = y("numberOfPeriod")
.description = Nz(y("description"), "")
.amount = y("amount")
.patientPayment = y("patientPayment")
.consumption = y("consumption")
.consumptionInstruction = y("consumptionInstruction")
.shape = y("shape")
.bulkId = y("bulkId")
.serviceFullName = y("serviceFullName")
.serviceShortName = y("serviceShortName")
.serviceInterfaceName = y("serviceInterfaceName")
.serviceGenericCode = y("serviceGenericCode")
.serviceNationalNumber = y("serviceNationalNumber")
.serviceDescription = y("serviceDescription")
.serviceOrderGenericCode = y("serviceOrderGenericCode")
.serviceOrderNationalNumber = y("serviceOrderNationalNumber")
End With
Next
.subscriptionDeliveredInfos = Infos
End With
FetchPrescriptionDelivered.Info = Info
End Function

[mazoolagh]

همون response رو که فرستادین در یک فایل به نام b.json ریختم و کد رو تست کردم:
Sub test()
Dim df As DeliveredFetch
df = FetchPrescriptionDelivered(ReadTextFile(CurrentPro ject.Path & "\b.json"))
Debug.Print UBound(df.Info.subscriptionDeliveredInfos)
End Sub


Function ReadTextFile(FilePath As String) As String
Dim T As TextStream
With New FileSystemObject
Set T = .OpenTextFile(FilePath, ForReading)
ReadTextFile = T.ReadAll
End With
T.Close
Set T = Nothing
End Function

[mazoolagh]

152797

152798

[mazoolagh]

برنامه نمونه:
فقط یادتون باشه کد subscriptionDeliveredInfos رو برای subscriptionDeliveredInfosWithNoReference هم بنویسین (اگر لازم هست)

[amirzazadeh]

برنامه نمونه:
فقط یادتون باشه کد subscriptionDeliveredInfos رو برای subscriptionDeliveredInfosWithNoReference هم بنویسین (اگر لازم هست)

سلام و درود فراوان
با تشکر بررسی میکنم و نتیجه رو اعلام می کنم.

[mazoolagh]

سلام و درود فراوان
با تشکر بررسی میکنم و نتیجه رو اعلام می کنم.

سلام دوباره و روز شما خوش
اون تاپیک در بخش وب سرویس گویا هیچ کس پاسخی در این مدت نداده و این عجیب هست!
کاش خودتون زمان میگذاشتید براش چون بمراتب کدنویسی و نگهداریش خیلی ساده تر هست.
خودم هم وقت کنم دوباره میرم سروقتش ، فقط بفرمایید که user/pass همون هست که بود؟

[amirzazadeh]

سلام دوباره و روز شما خوش
اون تاپیک در بخش وب سرویس گویا هیچ کس پاسخی در این مدت نداده و این عجیب هست!
کاش خودتون زمان میگذاشتید براش چون بمراتب کدنویسی و نگهداریش خیلی ساده تر هست.
خودم هم وقت کنم دوباره میرم سروقتش ، فقط بفرمایید که user/pass همون هست که بود؟

سلام و وقت به خیر
یوزر و پسورد تست، همون هست که براتون ارسال کردم. در خصوص تاپیک بخش وب سرویس هم انشاالله با کمک شما و سایر دوستان کارو پیش می بریم.
..............................
پیروز و سربلند باشید

[amirzazadeh]

سلام و وقت به خیر جناب mazoolagh
ضمن تشکر و قدردانی ویژه، همونطور که انتظار می رفت کدهای ارسالی شما عالی و کامل نتایج رو برمی گردونند.
..........................
ارادتمند میرزازاده

[atf1379]

سلام
میگم این تاپیک چقدر تخصصی و خصوصی بود ؟:لبخند:

[mazoolagh]

سلام
میگم این تاپیک چقدر تخصصی و خصوصی بود ؟:لبخند:

سلام و روز خوش
تاپیک کاملا تخصصی و حرفه ای هست،
ولی اصلا خصوصی نیست!
برعکس هر کسی که با سیستم های بیمارستانی و پذیرش و ... کار میکنه حتی اگر از اکسس استفاده نکنه میتونه از این تاپیک استفاده کنه.
همینجور کار با وب سرویس (ارسال درخواست، دریافت پاسخ و تفسیر اون و ...) رو که کاملا عمومی و فراگیر هست پوشش میده.

تاپیک زمانی خصوصی هست که یک نفر یک مورد کاملا منحصر بفردی رو مطرح کنه که فقط نیاز خودش هست و کسی که پاسخ میده فقط هدفش پاسخگویی هست (به هر قیمت) بدون آوردن کدها و توضیح در انجمن.
هر تاپیکی که موضوعش شبیه اینها باشه خصوصی محسوب میشه:
- من یک دکمه دارم، یک کت براش بدوزین!
- من به اصول و روش های استاندارد و کار اصولی اعتقادی ندارم ولی خواسته من این است (برای من یک دستشویی اوپن وسط پذیرایی بسازین)!
- من دانش پایه و اولیه نرم افزار و سیستم ها و ... ندارم ولی باید اینجور که من میگم کار کنید (با فرقون و بیل و کلنگ برج بسازین)!

[yeganehaym]

سلام. چطوری میشه API بیمه سلامت رو درخواست داد. ما هر چی از خودشون میپرسیم نمیدونن.

[amirzazadeh]

سلام. چطوری میشه API بیمه سلامت رو درخواست داد. ما هر چی از خودشون میپرسیم نمیدونن.
سلام یه ایمیل به این آدرس بفرستید.asa@ihio.gov.irآزمایشگاه سازمان الکترونیک بیمه سلامت ایران
آدرس: شهرک غرب - خیابان فلامک شمالی - ساختمان آریو - ورودی A - سازمان بیمه سلامت ایران - طبقه پنجم - آزمایشگاه و مرکز پایش سازمان الکترونیک بیمه سلامت ایران - تلفن: 02196881606