Printable View
با سلام بنده قبلا با کمک اساتید محترم خصوصا جناب Mazoolag که خیلی لطف کردند و زحمت کشیدند توانستیم ارتباط با وب سرویس بیمه تامین اجتماعی را انجام دهیم حال با توجه به اینکه بیمه سلامت کشور اقدام به تهیه وب سرویس ارسال نسخ نموده است از اساتید محترم تقاضا دارد در صورت امکان راهنمایی نمایند تا بتوانیم نحوه ارتباط با این وب سرویس را نیز بدست آوریم فایل راهنما به پیوست میباشد
قبلا از مساعدت شما دوستان نهایت تشکر را دارم
ضمیمه 152272
سلامنقل قول:
نوشته شده توسط ATA_TABRIZ
اساتید نمیخوان کمک کنن
جناب Mazoolag کجایی ؟؟؟؟؟
سلام
آدرس وب سرويس لود نميشه.
http://tdtst.ihio.gov.ir/ws/ServiceApprove.asmx
ضمن تشکر از توجه شما ادرس های زیر جهت استحضار
در محيط تست:http://test.ihio.gov.ir/hdkcore/api/...onservice?wsdl
در محيط عملياتی:http://webapi.ihio.gov.ir/hdkcore/ap...onservice?wsdl
اصول کار که فرقی نمیکنه، شما باید یک request با فرمتی که براتون مشخص شده بفرستین و یک response دریافت و اون رو طبق فرمتی که بهتون داده شده تفسیر کنین.
تو پست های مربوط به تامین اجتماعی همه اینها بحث شد، کافی هست اسکلت کد رو نگه دارین و تغییرات رو در اون اعمال کنید.
اینجا شما بیشتر از یک سرویس دارین :
http://test.ihio.gov.ir/hdkcore/api/services/
شما فقط لینک یکی از سرویس ها رو فرستادین، برای هر سرویس مستنداتش ارائه میشه که request و response چگونه باید باشن.
یعنی فرمت تاریخ، اطلاعات نسخه، نوع سرویس ارائه شده به بیمار، ...
اینجا شما نیاز دارین مستندات کامل و دقیق 4 نوع tag استفاده شده رو داشته باشین:
operation = نوع عملیات سرویس
input = مقدار ارسالی به سرویس
output = مقدار برگشتی از سرویس
fault = خطا
بطور متعارف نمونه کد هم در مستنداتشون هست.
================
فکر کنم قبلا هم اشاره کردم، برای کار با وب سرویس ها اگر desktop app بسازین (مثلا با vb.net) خیلی بهتره و در ارسال و دریافت هم خیلی راحتین.
بعضی وقتها یک کمپوننت به شما میدن که به برنامه تون اضافه میکنین و فقط کافی هست مقادیر رو به تابع ارسال و نتایج رو بگیرین (وب سرویس ارسال پیامک اگر یادتون باشه).
دیتابیس رو میتونین همون اکسس نگه دارین اگر مایل هستین.
سلام
چيزي كه من متوجه شدم در مرحله بايد از وب سرويس توكن دريافت بشه كه اعتبار يكروزه داره . براي اينكار بايد از وب سرويس 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
سلام و درود
راهنماي كامل وب سرويس رو پيدا كردم.براي استفاده دوستان اپلود مي كنم.
https://yz.ihio.gov.ir/Portals/37/HD...-23-105319-563
با تشکر از جناب 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
با سلام
ضمن تشکر از توجه استادان محترم خصوصا جناب Amirzadeh , Mazoolagh بنده کد های شما تست کردم در سایت آزمایشی به قول آقای Amirzadeh ارورر 500 را میده و در سایت اصلی پیغام زیر را میاره
که من اصلا متوجه نشدم لذا در صورت امکان کمک کنید تا انشالله بتونیم ارتیابط با بیمه را برقرار نماییم
ERROR -2146697211The system cannot locate the resource specified.
سلامنقل قول:
نوشته شده توسط ATA_TABRIZ
جناب آقاي Mazoolagh به نكته مهمي اشاره كردند و اون ساختار تگها هست تا ما به اين ساختار دسترسي نداشته باشيم ارتباط با سرور ناممكن خواهد بود بنابراين سعي كنيد كه با ارتباط با كارشناسان IT سازمان بيمه سلامت اين اطلاعات رو به دست بياريد.
..........................
موفق باشيد
جناب آقای Amirzadeh خیلی متشکرم که توجه به مشکل بنده داریدنقل قول:
نوشته شده توسط amirzazadeh
عرض بشود خدمتتان که ساختار تگها عین تامین اجتماعی و بین المللی است در مرحله اول باید توکن دریافت گردد که که سه تا ورودی و یک خروجی دارد اگر از این مرحله نتیجه بگیریم بقیه داده ها نیز مشخص میباشد
مجددا از توجه شما و استاد Mazoolagh نهایت تشکر را دارم .
سلامنقل قول:
نوشته شده توسط ATA_TABRIZ
در خصوص ساختار xml نسخ حق با شماست ولي ساختار وب سرويس هر بيمه مخصوص به خودش هست كما اينكه در وب سرويس تامين احراز هويت با نام كاربري و پسورد (UserId و Password) انجام ميشه ولي بيمه سلامت از سه پارامتر كد موسسه نام كاربري و پسورد(pUserInstKey , pUserName,pPassword) استفاده ميكنه. بنابراين مجددا تاكيد مي كنم دريافت ساختار اجنتاب ناپذير هست.
ضمن تشکر از آقای amirzadeh از جناب Mazoolagh خواهشمندیم کدهای فوق را بررسی نمایندنقل قول:
نوشته شده توسط amirzazadeh
جناب Amirzadeh شما درست میفرمائید بیمه سلامت یه کم مسئله را پیچیده کرده ولی چاره ای نیست اونظور که من فهمیدم از سه تا سرویس استفاده میکنه که اولی به قول شما احراز هویت است لذا من فکر میکنم که اگر این قسمت ارتباط داده بشه و کد توکن دریافت گردد بقیه مثل تامین وابسته به tagهای دفترچه و غیره میباشد لذا از شما و جناب Mazoolagh خواهشمندم این کدهایی که شما زحمت کشیدین بررسی کنید تا بوسیله این کدها اگر موفق به دریافت توکن شویم بقیه را انشالله طی خوایم کردنقل قول:
نوشته شده توسط amirzazadeh
مجددا از لطف شما ممنونم
جناب ata_tabriz
من کدی رو که جناب میرزازاده زحمتش رو کشیده بودن یک نگاه انداختم، شما باید فرمتش رو از xml به json تغییر بدین.
برخلاف تامین اجتماعی که از فرمت xml استفاده میکرد، اینجا از json استفاده شده و این دو یکی نیستن.
اول باید content type رو به application/json تغییر بدین.
احتمالا باید پارامتر accept هم به header اضافه کنین با همین مقدار application/json.
بعد متن درخواست رو شبیه زیر استفاده کنین:
XM="{""terminalId"":123,""userName"":""test"",""pa ssword"":""test123""}"
دوباره تاکید میکنم VBA برای اینکار ابزار مناسبی نیست، بخصوص که اینجا شما سرویس های متنوعی دارین و یک گردش کار نسبتا پیچیده (در مقایسه با وب سرویس تامین اجتماعی).
با نگاه به مستنداتی که جناب میرزازاده زحمت کشیدن و پیدا کردن، بنظر میاد این وب سرویس برخلاف وب سرویس تامین اجتماعی توسط یک تیم حرفه ای و کاربلد طراحی شده و جدای از موارد فنی یک گردش کار هم هست که باید اول اون رو بدونین.
بهتره یک windows application بنویسین که دست کم مشکل ساخت request و تفسیر response رو نداشته باشین و مطمئن باشین که اگر مشکلی هست به گردش کار برمیگرده.
من یک نمونه با 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 ایجاد کنین و این مبحث رو اونجا ادامه بدیم تا بتونیم از دانش و تجربه دیگران هم استفاده کنیم.
با سلام و احترام
به منظور جلوگيري از تداخل تالارها تاپيك رو در تالار دات نت ايجاد كردم. بنابراين مبحث رو با رويكرد VBA اينجا ادامه ميديم و بحت مربوط به استفاده از vb.net رو در تالار مربوطه پيگيري بفرماييد.
لينك تاپك در تالار دات.نت
https://barnamenevis.org/showthread....ه-سلامت
سلام آقای Amirzadeh, جناب Mazoolagh
باز این تایپک قدمهایی جهت حل مشکل برداشته شد در قسمت vb هیچکس توجهی نکرد !!!!!
سلام و وقت به خيرنقل قول:
نوشته شده توسط ATA_TABRIZ
تو تالار وب سرويس ها نمونه با vb.net اراىه شده كه ارسال پارامترها رو انجام ميده ولي چون يوزر پسورد واقعي نداريم توكن دريافت نمي كنيم.
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 رو دانلود کردم ولی به رفرنس های اکسس اضافه نمیشه.
سلام
اکسس برای اینکار مناسب نیست، بهتر هست از vb.net و دیتابیس sqlite استفاده نمایید.
البته همونجا یک تاپیک دیگه در همسایگی شما بود با مضمون مشابه (وب سرویس ارسال پیامک) که اون هم بی جواب مونده!نقل قول:
نوشته شده توسط ATA_TABRIZ
پس احتمالا موضوع بی توجهی نبوده.
سلام و روز خوشنقل قول:
نوشته شده توسط 336699
لطف بفرمایید در همون بخش vb.net که جناب میرزازاده تاپیک مستقل برای همین موضوع ایجاد کردن (لینک تاپیک هم رو چند پست بالاتر گذاشتن) راهنمایی بفرمایید.
در مورد این که vb.net مناسبتر هست قبلا اشاره شد و نوع دیتابیس هم اصلا اهمیتی در این کار نداره.
مرحله اول مهم نیست که User/pass واقعی داشته باشیم، همین که پروسه ارسال و دریافت پیغام خطا انجام بشه کافی هست.نقل قول:
نوشته شده توسط amirzazadeh
بفرمایید که شما با کدی که پیوست کردین جواب گرفتین؟
سلامنقل قول:
نوشته شده توسط mazoolagh
در اون بخش وی بی نمونه کد ارسال کردم که پاسخ از سرور هم دریافت میکنه(همین کدهای وی وبی دات نت که چند پست بالاتر هستند)
الان ظاهرا چند پست آخر اون بخش کلا ناپدید شده
در مورد دیتابیس هم اگه قرار باشه برنامه با وی بی دانت نوشته بشه بهتر هست از sql یا sqlite استفاده بشه و دیتابیس اکسس مناسب نیست.
با سپاس از دوست گرامي جناب 336699 بله به صورت كامل ارسال و دريافت صورت مي گيره.نقل قول:
نوشته شده توسط mazoolagh
دلیل اینکه پیشنهاد کردم از vb.net استفاده کنیم راحتی کار با استفاده از service reference بود و گرنه اگر قرار به استفاده از رفرنس و helper و کدنویسی باشه در اکسس هم اینکار شدنی هست و پیچیدگی بیشتری هم نداره.نقل قول:
نوشته شده توسط mazoolagh
بر خلاف response های xml که در اکسس براحتی قابل parse کردن هستن (نمونه اش رو در وب سرویس ارسال پیامک آوردم)، پاسخ های json نیاز به parser بیرونی دارن.
در هر صورت برای ارسال و گرفتن پاسخ نیازی به اونها نداریم و کار راحتی هست ولی برای تفسیر پاسخ داستان فرق میکنه.
این مورد هم قبلا اشاره کرده بودم که اگر دقت میشد مشکل تابحال حل شده بود.نقل قول:
نوشته شده توسط 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 خواهیم داشت.
من در پروژه های قدیمی در اکسس مستقیما از خود مفسر جاوااسکریپت (از طریق اضافه کردن رفرنس scripting runtime در دسترس هست) برای parse عبارتهای json استفاده میکردم.
ولی برای این مورد یک کد سبک و جمع و جور پیدا کردم و چند تغییر جزئی در اون دادم و فکر میکنم کفایت هست (دست کم تا اینجا).
کد رو در پست بعد میگذارم و اطلاعات بیشتر رو میتونین در لینک زیر پیدا کنین:
https://medium.com/swlh/excel-vba-pa...y-c2213f4d8e7a
'-------------------------------------------------------------------'
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
حالا با استفاده از این 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
روش استفاده:
Sub TEST()
Dim x As DailyToken
x = GetDailyToken()
Debug.Print "resCode=" + CStr(x.resCode) + vbCrLf + "resMessage=" + x.resMessage + vbCrLf + "token=" + x.token
End Sub
خروجی کد بالا:
ضمیمه 152376
برنامه نمونه
سلام
با سپاس و درود فراوان
عالی و بدون نقص :تشویق::تشویق::تشویق:
دست مریزاد.
.....................
موفق و پیروز باشید