وب سرويس

[ATA_TABRIZ]

سلام دوستان
من اين سوالم را چند ماه پيش مطرح كردم متاسفانه نتونستم از دوستان كمك بگيرم خودم هم تا الان نتونستم حلش بكنم اگه از دوستان كسي در اين مورد اطلاعاتي داره لطفا كمك كنه

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


یه فایل کمکی گذاشته تو سایت که بخش اولش به شرح ذیل میباشد


2 اجزا سرویس تایید نسخ پاراکلینیک

2.1 اجزای سرویس

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

2.1.1 نحوه دسترسی به سرویس

جهت دسترسی به وب سرویس می توانید با نام کاربری و رمز عبور تعریف شده در سایت معاونتدرمان از آدرس URL ذیل استفاده نمایید:

http://www.darman.sso.ir/Webservice/...ebService.asmx (http://www.darman.sso.ir/Webservice/ApplyParNoteWebService.asmx)

2.1.2 کلاس استفاده شده جهت کار با سرویس

جهت استفاده از وب سرویس از کلاس ApplyParNoteWebService باید Instance ساختهشود.

2 - متد استفاده شده جهت دسترسی به سرویس و پارامترهای ارسالی به آن:

از متد save_request برای ارسال اطلاعات نسخه استفاده می شود.

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


P1 : نام کاربری (نام کاربری سایت تایید نسخه)
P2 : کلمه ی عبور (کلمه ی عبور سایت تایید نسخه)

sBletSerial : شماره سریال 18 رقمی (کنترل صحت اطالعات بیمار و همچنیناستحقاق دفترچه بیمار از سریال وارد شده صورت می پذیرد و در صورت نادرستبودن اطالعات خطای مربوطه نمایش داده می شود.)

اگه نیاز باشه بقیه پارامترها را واستون ارسال میکنم

اگه به این ادرس مراجعه فرمائید (http://www.darman.sso.ir/Webservice/ApplyParNoteWebService.asmx) ا÷اپکیشینهای زیر موجود میباشد




Save_Diagnose_par (http://www.darman.sso.ir/Webservice/ApplyParNoteWebService.asmx?op=Save_Diagnose_par)
Apply Par Note Save Diagnose
Save_Request (http://www.darman.sso.ir/Webservice/ApplyParNoteWebService.asmx?op=Save_Request)
Apply Par Note Save Request
Save_Session_physio (http://www.darman.sso.ir/Webservice/ApplyParNoteWebService.asmx?op=Save_Session_physio )
Apply Par Note Save Session




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

قبلا از لطف و توجه شما خیلی تشکر میکنم

[ATA_TABRIZ]

از دوستان و استادان محترم كسي نيست به ما كمك كنه

[e601]

سلام
وب سرویس شما از پروتکل soap استفاده میکنه و مطمئنا ارائه دهندگان این وب سرویس یکسری مستندات به شما دادند که برای بررسی بیشتر به اون مستندات نیازه.
البته من در اکسس تا حالا از وب سرویس استفاده نکردم ولی انشالله با کمک هم حلش میکنیم. اگر تمایل داشتید مستندات رو برام ایمیل کنید.

راستی آدرس وب سرویس شما اون چیزی که در پست اول گفتید نیست ولی گفتم شاید خودتون نخواستید آدرس اصلی عمومی بشه، منم آدرس درستی که پیدا کردم رو اینجا نمینویسم. ولی لینک دسترسی به وب سرویس، اون لینک معرفی شده در پست اول نیست...

[ATA_TABRIZ]

سلام
وب سرویس شما از پروتکل soap استفاده میکنه و مطمئنا ارائه دهندگان این وب سرویس یکسری مستندات به شما دادند که برای بررسی بیشتر به اون مستندات نیازه.
البته من در اکسس تا حالا از وب سرویس استفاده نکردم ولی انشالله با کمک هم حلش میکنیم. اگر تمایل داشتید مستندات رو برام ایمیل کنید.

راستی آدرس وب سرویس شما اون چیزی که در پست اول گفتید نیست ولی گفتم شاید خودتون نخواستید آدرس اصلی عمومی بشه، منم آدرس درستی که پیدا کردم رو اینجا نمینویسم. ولی لینک دسترسی به وب سرویس، اون لینک معرفی شده در پست اول نیست...

سلام از توجه شما بسيار ممنونم
من يه فايل pdf در مورد در اين مورد دارم كه اگه آدرس ايميتون را برام لطف كنيد بفرستيد حتما در اختيار شما قرار ميدهم
بازم از بذل توجه شما بسيار ممنونم

[e601]

خواهش میکنم. من ایمیلم رو براتون پ خ کردم ولی ایمیلی برای من نیومد...

[mehdi_fiz]

سلام دوست عزیز
من ارسال پیامک با وب سرویس انجام دادم ولی الان دسترسی به فایلش ندارم
از آدرس های زیر هم می تونید کمک بگیرید.
https://msdn.microsoft.com/en-us/library/aa730836(v=vs.80).aspx
http://www.freevbcode.com/ShowCode.asp?ID=7611
موفق باشید

[ATA_TABRIZ]

سلام دوست عزیز
من ارسال پیامک با وب سرویس انجام دادم ولی الان دسترسی به فایلش ندارم
از آدرس های زیر هم می تونید کمک بگیرید.
https://msdn.microsoft.com/en-us/library/aa730836(v=vs.80).aspx
http://www.freevbcode.com/ShowCode.asp?ID=7611
موفق باشید

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

[ATA_TABRIZ]

از دوستان اگه كسي اطلاعات بيشتري در اين مورد داره كمكمان كند اين مورد در آينده مورد نياز خيلي ها خواهد بود

[e601]

سلام
دوست عزیز من فایل مستنداتی که فرستادید رو نگاه کردم. واقعیتش رو بخواهید اتصال این وب سرویس به نرم افزار اکسس کار بسیار طاقت فرسایی هست که شاید بیش از یک هفته تمرکز تمام وقت + یوزر نیم و پسورد + اطلاعات نسخه ها جهت تست نیاز داره که متاسفانه بنده وقتش رو اصلا ندارم و بابت این موضوع عذرخواهی میکنم.
راهی که من به شما پیشنهاد میکنم اینه که با یک برنامه نویس vb net یا C#‎‎‎ تماس بگیرید و ازش بخواید این وب سرویس رو بر اساس اطلاعاتی که شما در برنامه تون وارد میکنید پیاده سازی کنه. به بیان ساده تر شما اطلاعات رو در نرم افزار فعلی اکسس خودتون طبق روال معمول ثبت میکنید و اون شخص یک برنامه exe جداگانه برای شما مینویسه تا اطلاعات رو از دیتابیس شما بخونه و در سرور ذخیره کنه.
این بهترین و سریع ترین گزینه ای هست که به ذهن من میرسه.
موفق باشید...

[ATA_TABRIZ]

سلام
دوست عزیز من فایل مستنداتی که فرستادید رو نگاه کردم. واقعیتش رو بخواهید اتصال این وب سرویس به نرم افزار اکسس کار بسیار طاقت فرسایی هست که شاید بیش از یک هفته تمرکز تمام وقت + یوزر نیم و پسورد + اطلاعات نسخه ها جهت تست نیاز داره که متاسفانه بنده وقتش رو اصلا ندارم و بابت این موضوع عذرخواهی میکنم.
راهی که من به شما پیشنهاد میکنم اینه که با یک برنامه نویس vb net یا C#‎‎‎‎ تماس بگیرید و ازش بخواید این وب سرویس رو بر اساس اطلاعاتی که شما در برنامه تون وارد میکنید پیاده سازی کنه. به بیان ساده تر شما اطلاعات رو در نرم افزار فعلی اکسس خودتون طبق روال معمول ثبت میکنید و اون شخص یک برنامه exe جداگانه برای شما مینویسه تا اطلاعات رو از دیتابیس شما بخونه و در سرور ذخیره کنه.
این بهترین و سریع ترین گزینه ای هست که به ذهن من میرسه.
موفق باشید...

از توجه شما به مشكل بنده بسيار ممنونم

[mazoolagh]

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

قبل از هر چیز باید رفرنس MSXML2.XMLHTTP60 رو اضافه کنین. ممکنه برای شما بجای ورژن 6 ورژن 4 باشه

اول باید درخواست رو به همون فرمتی که بهتون معرفی شده بصورت یک استرینگ بسازین.
برای شما فرمت درخواست و پاسخ در آدرس زیر مشخص شده
http://darman.tamin.ir/Webservice/ApplyParNoteWebService.asmx?op=Save_Request


DIM XM AS STRING
XM="<?xml version=""1.0"" encoding=""utf-8""?>"
XM=XM+"....."
.....
.....
.....
XM=XM+"</soap12:Envelope>"


و حالا ارسال درخواست

CONST WSURL AS STRING="http://darman.tamin.ir/Webservice/ApplyParNoteWebService.asmx"
DIM XML_HTTP AS NEW MSXML2.XMLHTTP60
XML_HTTP.OPEN "POST", WSURL, FALSE
XML_HTTP.SETREQUESTHEADER "HOST", "DARMAN.TAMIN.IR"
XML_HTTP.SETREQUESTHEADER "CONTENT-TYPE", "application/soap+xml; charset=utf-8"
XML_HTTP.SETREQUESTHEADER "SOAPACTION", "http://tempuri.org/Save_Request"
XML_HTTP.SEND XM


اگر همه چیز روبراه باشه وضعیت ابجکت ما 200 خواهد بود یعنی OK


DIM XML_DOC AS NEW MSXML2.DOMDOCUMENT60
IF XML_HTTP.STATUS= 200 THEN
XML_DOC.LOADXML XML_HTTP.RESPONSETEXT
....
'پردازش XML_DOC برای استخراج نتایج
....
ELSE
....
'پردازش خطا
....
ENDIF

[ATA_TABRIZ]

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

قبل از هر چیز باید رفرنس MSXML2.XMLHTTP60 رو اضافه کنین. ممکنه برای شما بجای ورژن 6 ورژن 4 باشه

اول باید درخواست رو به همون فرمتی که بهتون معرفی شده بصورت یک استرینگ بسازین.
برای شما فرمت درخواست و پاسخ در آدرس زیر مشخص شده
http://darman.tamin.ir/Webservice/ApplyParNoteWebService.asmx?op=Save_Request


DIM XM AS STRING
XM="<?xml version=""1.0"" encoding=""utf-8""?>"
XM=XM+"....."
.....
.....
.....
XM=XM+"</soap12:Envelope>"


و حالا ارسال درخواست

CONST WSURL AS STRING="http://darman.tamin.ir/Webservice/ApplyParNoteWebService.asmx"
DIM XML_HTTP AS NEW MSXML2.XMLHTTP60
XML_HTTP.OPEN "POST", WSURL, FALSE
XML_HTTP.SETREQUESTHEADER "HOST", "DARMAN.TAMIN.IR"
XML_HTTP.SETREQUESTHEADER "CONTENT-TYPE", "application/soap+xml; charset=utf-8"
XML_HTTP.SETREQUESTHEADER "SOAPACTION", "http://tempuri.org/Save_Request"
XML_HTTP.SEND XM


اگر همه چیز روبراه باشه وضعیت ابجکت ما 200 خواهد بود یعنی OK


DIM XML_DOC AS NEW MSXML2.DOMDOCUMENT60
IF XML_HTTP.STATUS= 200 THEN
XML_DOC.LOADXML XML_HTTP.RESPONSETEXT
....
'پردازش XML_DOC برای استخراج نتایج
....
ELSE
....
'پردازش خطا
....
ENDIF


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

1-رفرنس MSXML2.XMLHTTP60 مورد نظر در کدو م ورژن هستش من برنامه را با 2003 نوشتم باید ارتقا بدم به 2010
2- باید فرمت استرینقم را بصورت xml درست کنم یا همون فرمتی که در آدرس مورد نظر ارائه شده
3- ضمنا این مراحل را برای یه رویداد مثلا کلیک یه دگمه باید تعریف کنم یا ؟

قبلا از توجه شما و وقتی که میگذارید خیلی ممنونم

[mazoolagh]

۱- ورژن ۲۰۰۳ و حتی ۲۰۰۷ واقعا از رده خارج محسوب میشه. ۲۰۱۰ خوبه چون روی xp‌هم نصب میشه


۲- کل درخواست رو بصورت استرینگ بسازین. من از روی همون فرمت زیر که مربوط به متد save_request خط اول و آخرش رو گذاشته بودم. مابقیش رو خودتون باید با توجه به مستنداتی که دارین قرار بدین

<?xml version="1.0" encoding="utf-8"?>
<soap:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/">
<soap:Body>
<Save_Request xmlns="http://tempuri.org/">
<P1>string</P1>
<P2>string</P2>
<sBletSerial>string</sBletSerial>
<sPrescDate>string</sPrescDate>
<sDOCID>string</sDOCID>
<sDOC_SPEC>string</sDOC_SPEC>
<sDOC_FNAME>string</sDOC_FNAME>
<sDOC_LNAME>string</sDOC_LNAME>
<sDOC_TYPE>string</sDOC_TYPE>
<sParType>string</sParType>
<sCust_Service_type>string</sCust_Service_type>
<sBastari>string</sBastari>
<sParList>xmlxml</sParList>
<sParListJson>string</sParListJson>
<sLabGrpCode>string</sLabGrpCode>
<sFirstDiagnoseCode>string</sFirstDiagnoseCode>
<sLabDiagnoseCode>string</sLabDiagnoseCode>
<sLabDiagnoseComment>string</sLabDiagnoseComment>
<sTotalSession>string</sTotalSession>
<sOrganNo>string</sOrganNo>
<sPhysioDiagnoseCode>string</sPhysioDiagnoseCode>
<sPhysioDiagnoseComment>string</sPhysioDiagnoseComment>
<sDarmanPhysio>string</sDarmanPhysio>
<sDarmanDoc>string</sDarmanDoc>
<s2K>string</s2K>
<sDocFani_ID>string</sDocFani_ID>
<ErrorMessage>string</ErrorMessage>
<RequestId>long</RequestId>
</Save_Request>
</soap:Body>
</soap:Envelope>

۳- روش متداول این هست که یک فانکشن پابلیک مینویسن که شماره ID رکوردی که قرار هست اطلاعتش ارسال بشه رو میگیره و مقدار برگشتی این تابع نتیجه عملیات ارسال هست.
اونچه که متد SAVE_REQUEST نشون میده اینه که سه مقدار برمیگرده. به کد زیر دقت کنین.

<?xml version="1.0" encoding="utf-8"?>
<soap:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/">
<soap:Body>
<Save_RequestResponse xmlns="http://tempuri.org/">
<Save_RequestResult>int</Save_RequestResult>
<ErrorMessage>string</ErrorMessage>
<RequestId>long</RequestId>
</Save_RequestResponse>
</soap:Body>
</soap:Envelope>

بهتر هست اول یک TYPE تعریف کنین. چیزی شبیه زیر:
PUBLIC TYPE REQUEST_RESPONSE
REQUEST_RESULT AS INTEGER
ERROR_MESSAGE AS STRING
REQUEST_ID AS LONG
END TYPE

حالا تابعتون میتونه چیزی شبیه این باشه:

PUBLIC FUNCTION SAVE_REQUEST(ID AS LONG) AS REQUEST_RESPONSE
DIM RR AS REQUEST_RESPONSE
....
'عملیات ارسال و دریافت
....
RR.REQUEST_RESULT=....
RR.ERROR_MESSAGE=....
RR.REQUEST_ID=....
SAVE_REQUEST=RR
END FUNCTION


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

[ATA_TABRIZ]

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

[naderigh]

مشکل شما در حصوص این وب سرویس حل شد اگر امکان دارد اقداماتی که انجام دادید را اعلام نمائید

[ATA_TABRIZ]

سلام جناب آقای مهندس Mazoolagh
من بعد مدتها و با استفاده از راهنماییهای شما توانستم ارسال اطلاعات را در اکسس به وب سرویس تامین را انجام دهم ولی نتونستم پیغامهای ارسالی و ارروها را دریافت کنم
یعنی قسمتهای آخر دستورات شما را نتونستم اجرا کنم ( طبق فرموده شما یه استرینق درست کردم و با دستوراتی که نوشته بودید ارسال کردم مراحال هیچ خطایی نمیده فقط چون جواب را نمیتونم بگیرم نمیتونم اشمالات را رفع نمایم در خود سایت اگه بفرستیم پیغام خطای مربوطه را میاره و یا اگه ثبت بشه کد رهگیری میده)
PUBLIC FUNCTION SAVE_REQUEST(ID AS LONG) AS REQUEST_RESPONSE
DIM RR AS REQUEST_RESPONSE
....
'عملیات ارسال و دریافت
....

RR.REQUEST_RESULT=....
RR.ERROR_MESSAGE=....
RR.REQUEST_ID=....
SAVE_REQUEST=RR

بجای نقاط .... چی باید بزاریم اگه لطف کنید راهنمایی کنید ممنون میشم

البته من به شکل زیر نوشتم اررور 500 را یمده

Dim XM As String


XM = "<soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/""><P1></P1><P2></P2><sBletSerial>137684953428001104</sBletSerial><sPrescDate>1396/01/23</sPrescDate><sDOCID>95274</sDOCID><sDOC_FNAME></sDOC_FNAME><sParType>04</sParType><sCust_Service_type>4020</sCust_Service_type><sBastari>0</sBastari><sParList></sParList><sParListJson>[{""TAREFCODE"":701655,""Num"":1""}]</sParListJson></Save_Request></soap12:Body></soap12:Envelope>"


Const WSURL As String = "https://darman.tamin.ir/Webservice/ApplyParNoteWebService.asmx"
Dim XML_HTTP As New MSXML2.XMLHTTP60
XML_HTTP.Open "POST", WSURL, False
XML_HTTP.setRequestHeader "HOST", "DARMAN.TAMIN.IR"
XML_HTTP.setRequestHeader "CONTENT-TYPE", "application/soap+xml; charset=utf-8"
XML_HTTP.setRequestHeader "SOAPACTION", "https://tempuri.org/Save_Request"
XML_HTTP.send XM


Dim XML_DOC As New MSXML2.DOMDocument60


If XML_HTTP.Status = 200 Then
XML_DOC.loadXML XML_HTTP.responseText




'
Else
'


'
End If

[mazoolagh]

بعد از خط زیر:
XML_DOC.LOADXML XML_HTTP.RESPONSETEXT
نتیجه در XML_DOC هست که باید خودتون تفسیرش کنین.
بعنوان مثال گره <RequestId>...</RequestId> رو پیدا کنین و مقدار درونش رو بخونین و در RR.REQUEST_ID بریزین.

راه های مختلفی هست:


توابع درونی مثل LEFT, RIGHT, MID, INSTR و ...
استفاده از REGULAR EXPRESSION
امکانات خود MSXML برای خوندن گره ها

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



در مورد ارور 500 :
کلا ارور های 5XX مربوط به سمت سرور میشه و خلاصه اش اینه که درخواست قابل پردازش نبوده. هر چند که ظاهر کار یعنی خطا از سمت شما نیست ولی بعضی درخواستها که درست ساخته نشده باشن هم با این خطا روبرو میشن و من هم شک ام به همین هست.
درخواست رو دقیقا به همون فرمت که گذاشتم بسازین جواب میگیرین چون فیدبک داشتم از کسانی که با همین کد جواب گرفتن.

[ATA_TABRIZ]

جناب آقای Mazoolagh واقعا از توجه شما خیلی ممنونم
با توجه به رهنمودهای شما من کدهای String ام را به شکل زیر ساماندهی کردم

Dim XM As String


XM = "<?xml version=""1.0"" encoding=""utf-8""?>"
XM = XM & "<soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">"
XM = XM & "<soap:Body>"
XM = XM & "<Save_Request xmlns=""http://tempuri.org/"">"
XM = XM & "<P1>0140000023059</P1>"
XM = XM & "<P2>n1379091012</P2>"
XM = XM & "<sBletSerial>137684953428001104</sBletSerial>"
XM = XM & "<sPrescDate>1396/01/23</sPrescDate>"
XM = XM & "<sDOCID>95274</sDOCID>"
XM = XM & "<sDOC_SPEC></sDOC_SPEC>"
XM = XM & "<sDOC_FNAME></sDOC_FNAME>"
XM = XM & "<sDOC_LNAME></sDOC_LNAME>"
XM = XM & "<sDOC_TYPE></sDOC_TYPE>"
XM = XM & "<sParType>04</sParType>"
XM = XM & "<sCust_Service_type>4020</sCust_Service_type>"
XM = XM & "<sBastari>0</sBastari>"
XM = XM & "<sParList></sParList>"
XM = XM & "<sParListJson>[{""TAREFCODE"":701655,""Num"":1""}]</sParListJson>"
XM = XM & "<sLabGrpCode></sLabGrpCode>"
XM = XM & "<sFirstDiagnoseCode></sFirstDiagnoseCode>"
XM = XM & "<sLabDiagnoseCode></sLabDiagnoseCode>"
XM = XM & "<sLabDiagnoseComment></sLabDiagnoseComment>"
XM = XM & "<sTotalSession></sTotalSession>"
XM = XM & "<sOrganNo></sOrganNo>"
XM = XM & "<sDarmanDoc></sDarmanDoc>"
XM = XM & "<s2K>0</s2K>"
XM = XM & "<sDocFani_ID></sDocFani_ID>"
XM = XM & "<ErrorMessage></ErrorMessage>"
XM = XM & "<RequestId></RequestId>"
XM = XM & "</Save_Request>"
XM = XM & "</soap:Body>"
XM = XM & "</soap:Envelope>"
الان تو XML_HTTP.Status ارورر 415 را میده من به کدها آشنایی ندارم اگه جایی هست که جدول این کدها را داشته راهنمایی بفرمایید من مطالعه کنم ضمنا این اطلاعات را ما میتوانیم از خود سایت تامین اجتماعی به صورت دستی وارد کنیم که اونجا بر اساس ارور موجود پیغام مورد نظر را میدهد که دراین XML در تق ErrorMessage گنجانده شده من کد ارتباط با گره فوق را نمیدونم
اگه لطف کنید راهنمایی بفرمایید خیلی ممنون میشم قبلا از مساعدت شما نهایت تشکر را دارم

[mazoolagh]

من به کدها آشنایی ندارم اگه جایی هست که جدول این کدها را داشته راهنمایی بفرمایید
عبارت http status codes رو گوگل کنین.

البته نیازی ندارین!
شما فقط باید کد 200 رو چک کنین (OK) مابقی هرچی هست باید دوباره سعی کنین

[mazoolagh]

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

اما بعد،
قطعا در ساخت و ارسال اشتباه دارین چون با همون کدی که در ابتدا گذاشتم جواب میگیرین:
144986

و اگر شماره دفترچه نادرست بدم:
144987

و اگر کد درخواست نادرست بدم:
144988

[mazoolagh]

دقیقا از کد زیر استفاده کنین:
Option Compare Database
Option Explicit
'--------------------------
Const WSURL As String = "http://darman.tamin.ir/Webservice/ApplyParNoteWebService.asmx"
Const SVCJSON As String = "{""TAREFCODE"":""@TC"", ""Num"":""@NUM""}"
'--------------------------
Public Type Request_Response
Request_Result As Integer
ERROR_MESSAGE As String
REQUEST_ID As Long
End Type
'--------------------------
Public Function WS_TE( _
ByVal sBletSerial As String, _
ByVal sPrescDate As String, _
ByVal sDOCID As String, _
ByVal sDOC_SPEC As String, _
ByVal sParType As String, _
ByVal sCust_Service_type As String, _
ByVal TCs As String, _
ByVal NUMs As String) As Request_Response
On Error GoTo ERR_HNDLR
Dim RR As Request_Response
RR.ERROR_MESSAGE = ""
RR.REQUEST_ID = -1
RR.Request_Result = 4
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 + "<Save_Request xmlns=""http://tempuri.org/"">"
XM = XM + "<P1>0140000023059</P1>"
XM = XM + "<P2>n1379091012</P2>"
XM = XM + "<sBletSerial>" + sBletSerial + "</sBletSerial>"
XM = XM + "<sPrescDate>" + sPrescDate + "</sPrescDate>"
XM = XM + "<sDOCID>" + sDOCID + "</sDOCID>"
XM = XM + "<sDOC_SPEC>" + sDOC_SPEC + "</sDOC_SPEC>"
XM = XM + "<sDOC_FNAME></sDOC_FNAME>"
XM = XM + "<sDOC_LNAME></sDOC_LNAME>"
XM = XM + "<sDOC_TYPE></sDOC_TYPE>"
XM = XM + "<sParType>" + sParType + "</sParType>"
XM = XM + "<sCust_Service_type>" + sCust_Service_type + "</sCust_Service_type>"
XM = XM + "<sBastari>0</sBastari>"
'XM = XM + "<sParList></sParList>"
XM = XM + "<sParListJson>" + PARLIST_JSON(TCs, NUMs) + "</sParListJson>"
XM = XM + "<sLabGrpCode></sLabGrpCode>"
XM = XM + "<sFirstDiagnoseCode></sFirstDiagnoseCode>"
XM = XM + "<sLabDiagnoseCode></sLabDiagnoseCode>"
XM = XM + "<sLabDiagnoseComment></sLabDiagnoseComment>"
XM = XM + "<sTotalSession></sTotalSession>"
XM = XM + "<sOrganNo></sOrganNo>"
XM = XM + "<sPhysioDiagnoseCode></sPhysioDiagnoseCode>"
XM = XM + "<sPhysioDiagnoseComment></sPhysioDiagnoseComment>"
XM = XM + "<sDarmanPhysio></sDarmanPhysio>"
XM = XM + "<sDarmanDoc></sDarmanDoc>"
XM = XM + "<s2K>0</s2K>"
XM = XM + "<sDocFani_ID></sDocFani_ID>"
'XM = XM + "<ErrorMessage></ErrorMessage>"
'XM = XM + "<RequestId>-1</RequestId>"
XM = XM + "</Save_Request>"
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", "DARMAN.TAMIN.IR"
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 "RequestId"
RR.REQUEST_ID = XNL(i).Text
Case "ErrorMessage"
RR.ERROR_MESSAGE = XNL(i).Text
Case "Save_RequestResult"
RR.Request_Result = XNL(i).Text
End Select
Next
Else
RR.ERROR_MESSAGE = CStr(XML_HTTP.Status) + XML_HTTP.StatusText
End If
WS_TE = RR
Exit Function
ERR_HNDLR:
RR.ERROR_MESSAGE = "ERROR " + CStr(Err.Number) + vbCrLf + Err.Description
WS_TE = RR
End Function



Function PARLIST_JSON(ByVal TCs As String, NUMs As String) As String
Dim JSON() As String
Dim T() As String
Dim N() As String
T = Split(TCs, ",")
N = Split(NUMs, ",")
Dim i, k As Integer
k = UBound(T)
ReDim Preserve JSON(k)
For i = 0 To k
JSON(i) = Replace(SVCJSON, "@TC", T(i))
JSON(i) = Replace(JSON(i), "@NUM", N(i))
Next
PARLIST_JSON = "[" + Join(JSON, ",") + "]"
End Function

[mazoolagh]

روش تست:
Sub TEST()
Dim X As Request_Response
X = WS_TE("137684953428001104", "1396/01/23", "95274", "", "04", "4020", "701655", "1")
MsgBox ("REQUEST_ID=" + Trim(X.REQUEST_ID) + vbCrLf + "REQUEST_RESULT=" + Trim(X.Request_Result) + vbCrLf + "ERROR_MESSAGE=" + X.ERROR_MESSAGE)
End Sub

[mazoolagh]

این هم خود برنامه

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

[ATA_TABRIZ]

سلام جناب mazoolagh
واقعا از توجه و لطف بی نهایت شما نسبت به مشکل بنده خیلی خیلی ممنونم من موارد فوق را تست کردم در چند مورد جواب بسیار عالی بود ولی بعدا برای هر نسخه که ارسال کردم خطای زیر راداد

145005

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

[ATA_TABRIZ]

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

[mazoolagh]

خوشحالم که مشکلتون حل شده

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

بعنوان مثال:
با توجه به اینکه شماره نظام پزشکی یکتا هست از نظر منطقی واقعا دلیلی نیست که هم شماره نظام و هم کد تخصص ارسال بشه چون تمام اطلاعات نزد سازمان هست

[ATA_TABRIZ]

سلام دوستان
باتشکر از راهنمایی های جناب Mazoolagh فرم نهایی که تونستم اطلاعات نسخه ها را براحتی ارسال و نتیجه را دریافت کنم به شکل زیر میباشد الیته من اطلاعات این فرم را از فرم دیگه که پذیرش در آن صورت میگیرد انتقال میدم و دوستان هر جور که دلشان خواست یمتونند این فرم را به صورت دستی یا از یه فرم دیگه پر کنند
فقط یه سوال از آقای Mazoolagh
اگه بخواهیم یه پارامتر دیگه به این قسمت (مثلا مقدار 2K را)اضافه کنیم باید نوع متغییر را در فانکشن WS_TE اضافه کنیم و در قسمت ساب TEST اضافه کنیم ؟؟
مجددا از راهنمایی ها و توجه فوق العاده تون نهایت تشکر را دارم

[mazoolagh]

اگه بخواهیم یه پارامتر دیگه به این قسمت (مثلا مقدار 2K را)اضافه کنیم باید نوع متغییر را در فانکشن WS_TE اضافه کنیم و در قسمت ساب TEST اضافه کنیم ؟؟


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

تابع فرضی زیر رو در نظر بگیرین:

FUNCTION F1(OPTIONAL BYVAL A AS INTEGER=8 , OPTIONAL BYVAL B AS STRING="QQQ")
F1=TRIM(10*A)+B
END FUNCTION


خروجی تابع در نمونه های زیر رفتار پارامترهای optional و همینطور مقداردهی پیش فرض default value رو نشون میده:

F1(5,"VBA") == 50VBA
F1(,"VBA") == 80VBA
F1(5) == 50QQQ
F1() == 80QQQ

[ATA_TABRIZ]

با سلام خدمت سرور گرامی Mazoolagh با تشکر از راهنمایی های شما که همیشه دعا گو هستیم به استحضار میرساند با تئجه به اینکه تامنی اجتماعی از وب سرویس و آدرس جدید جهت ورود اطلاعات استفاده میکند بنده با توجه به مطالب گذشته که شما لطف کرده و برایمون اموزش داده بودید تنظمایت را انجام دادم ولی نتیجه پیغامی ارور iNTERNALL SERVER ERROR 500 : 4 میباشد لذا خواهشمندم با توجه به تنظیمات که به ضصورت ذیل انجام گردیده در صورت امکان بنده را راهنمایی فرمایید
آدرس جدید (http://darmanws.tamin.ir/paraclinicwebservice.asmx)
قبلا از لطف شما نهایت تشکر را دارم


Const WSURL As String = "http://darmanws.tamin.ir/paraclinicwebservice.asmx"
Const SVCJSON As String = "{""TAREFCODE"":""@TC"", ""Num"":""@NUM""}"
'--------------------------






Public Type Request_Response
Request_Result As Integer
ERROR_MESSAGE As String
REQUEST_ID As Long
End Type
Public Function WS_TE( _
ByVal sBletSerial As String, _
ByVal sPrescDate As String, _
ByVal sDOCID As String, _
ByVal sDOC_SPEC As String, _
ByVal sParType As String, _
ByVal sCust_Service_type As String, _
ByVal TCs As String, _
ByVal NUMs As String) As Request_Response


On Error GoTo ERR_HNDLR


Dim RR As Request_Response
RR.ERROR_MESSAGE = ""
RR.REQUEST_ID = -1
RR.Request_Result = 4






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 + "<Save_Request xmlns=""http://tempuri.org/"">"
XM = XM + "<ParaUInfo>"
XM = XM + "<UserID>0140000025020</UserID>"
XM = XM + "<Password>m1234567</Password>"
XM = XM + "</ParaUInfo>"


XM = XM + "<DocInfo>"
XM = XM + "<DOCID>" + sDOCID + "</DOCID>"
XM = XM + "<DOC_SPEC>" + sDOC_SPEC + "</DOC_SPEC>"
XM = XM + "<DOC_FNAME></DOC_FNAME>"
XM = XM + "<DOC_LNAME></DOC_LNAME>"
XM = XM + "<DOC_TYPE></DOC_TYPE>"
XM = XM + "</DocInfo>"


XM = XM + "<PrcInfo>"
XM = XM + "<BletSerial>" + sBletSerial + "</BletSerial>"
XM = XM + "<Mobile>091405785092</Mobile>"
XM = XM + "<PrescDate>" + sPrescDate + "</PrescDate>"
XM = XM + "<ParType>" + sParType + "</ParType>"
XM = XM + "<Cust_Service_type>" + sCust_Service_type + "</Cust_Service_type>"
XM = XM + "<Bastari>0</Bastari>"
XM = XM + "<FirstDiagnoseCode></FirstDiagnoseCode>"
XM = XM + "<Is2K>0</Is2K>"
XM = XM + "<DocFani_ID></DocFani_ID>"
XM = XM + "</PrcInfo>"


XM = XM + "<LabPrscInfo>"
XM = XM + "<LabDiagnoseCode></LabDiagnoseCode>"
XM = XM + "<LabDiagnoseComment></LabDiagnoseComment>"
XM = XM + "<LabGrpCode></LabGrpCode>"
XM = XM + "</LabPrscInfo>"


XM = XM + "<PhyPrscInfo>"
XM = XM + "<TotalSession></TotalSession>"
XM = XM + "<OrganNo></OrganNo>"
XM = XM + "<PhysioDiagnoseCode></PhysioDiagnoseCode>"
XM = XM + "<PhysioDiagnoseComment></PhysioDiagnoseComment>"
XM = XM + "<DarmanPhysio></DarmanPhysio>"
XM = XM + "<DarmanDoc></DarmanDoc>"
XM = XM + "</PhyPrscInfo>"




XM = XM + "<PrescDInfo>"
XM = XM + "<PrescDInfo>"
XM = XM + "<TAREFCODE>701715</TAREFCODE>"
XM = XM + "<Num>1</Num>"
XM = XM + "</PrescDInfo>"
' <PrescDInfo>
' <TAREFCODE>string</TAREFCODE>
' <Num>int</Num>
' </PrescDInfo>
XM = XM + "</PrescDInfo>"


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








'XM = XM + "<sParListJson>" + PARLIST_JSON(TCs, NUMs) + "</sParListJson>"






Dim XML_HTTP As New MSXML2.XMLHTTP60
XML_HTTP.Open "POST", WSURL, False
XML_HTTP.setRequestHeader "HOST", "DARMANWS.TAMIN.IR"
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


'Forms!paziresh!ADDRESS = "ÊÓÊ"


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 "RequestId"
RR.REQUEST_ID = XNL(I).Text
Case "ErrorMessage"
RR.ERROR_MESSAGE = XNL(I).Text
Case "Save_RequestResult"
RR.Request_Result = XNL(I).Text
End Select
Next
Else
RR.ERROR_MESSAGE = CStr(XML_HTTP.Status) + XML_HTTP.StatusText
End If


WS_TE = RR
Set XML_HTTP = Nothing


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




End Function
Function PARLIST_JSON(ByVal TCs As String, NUMs As String) As String
Dim JSON() As String
Dim T() As String
Dim N() As String
T = Split(TCs, ",")
N = Split(NUMs, ",")
Dim I, K As Integer
K = UBound(T)
ReDim Preserve JSON(K)
For I = 0 To K
JSON(I) = Replace(SVCJSON, "@TC", T(I))
JSON(I) = Replace(JSON(I), "@NUM", N(I))
Next
PARLIST_JSON = "[" + Join(JSON, ",") + "]"
End Function


Sub TEST()
Dim X As Request_Response
X = WS_TE(Forms!SENDWEB!NUM_D, Forms!SENDWEB!DATE_D, Forms!SENDWEB!N_DOCTER, "", Forms!SENDWEB!Text146, Forms!SENDWEB!Text142, Forms!SENDWEB!Text171, Forms!SENDWEB!Text173)
'X = WS_TE("149028680227802602", "1396/01/30", "43571", "", "04", "4020", "701715,701655", "1,2")
'MsgBox ("˜Ï ÑåíÑí=" + Trim(X.REQUEST_ID) + vbCrLf + "REQUEST_RESULT=" + Trim(X.Request_Result) + vbCrLf + "ERROR_MESSAGE=" + X.ERROR_MESSAGE)


Forms!SENDWEB!Label175.Caption = Trim(X.ERROR_MESSAGE) & " ; " & Trim(X.Request_Result)


If Val(Forms!SENDWEB!Tracking_number) = 0 Then
If Trim(X.REQUEST_ID) > 0 Then
Forms!SENDWEB!Tracking_number = Trim(X.REQUEST_ID)
Forms!SENDWEB!DATE_INSERT = Today_persian_Date$()
Forms!SENDWEB!User = Forms!Main!Text26
Forms!SENDWEB!TIM = Time()
Forms!SENDWEB!Label175.Caption = Trim(X.ERROR_MESSAGE) & "!!!ÚãáíÇÊ ÈÇ ãæÝÞíÊ ÇäÌÇ㠐ÑÏíÏ!!!"
End If
End If
End Sub

[mazoolagh]

سلام دوست تبریزی

1- چک کردم - آدرس قبلی هنوز برقرار هست و کار میکنه.
تا زمانی که کد جدید رو جواب نگرفتین از همون آدرس قبلی استفاده کنین، اینکه تا کی این حالت هست رو باید از خود پشتیبانی تامین اجتماعی بپرسین.

2- خطای 500 در کل یعنی اشکال سمت سرور هست - ولی گاهی هم بخاطر این پیش میاد که فرمت اطلاعات ارسالی با اونچه که برای وب سرویس تعریف شده نمیخونه.
اینجا هم مشکل همین هست چون فرمت درخواست (و همینطور پاسخ) تغییر کرده. دو آدرس زیر رو مقایسه کنین:
http://darman.tamin.ir/Webservice/ApplyParNoteWebService.asmx?op=Save_Request
http://darmanws.tamin.ir/paraclinicwebservice.asmx?op=Save_Request

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

موفق باشید.

[ATA_TABRIZ]

سلام دوست تبریزی

1- چک کردم - آدرس قبلی هنوز برقرار هست و کار میکنه.
تا زمانی که کد جدید رو جواب نگرفتین از همون آدرس قبلی استفاده کنین، اینکه تا کی این حالت هست رو باید از خود پشتیبانی تامین اجتماعی بپرسین.

2- خطای 500 در کل یعنی اشکال سمت سرور هست - ولی گاهی هم بخاطر این پیش میاد که فرمت اطلاعات ارسالی با اونچه که برای وب سرویس تعریف شده نمیخونه.
اینجا هم مشکل همین هست چون فرمت درخواست (و همینطور پاسخ) تغییر کرده. دو آدرس زیر رو مقایسه کنین:
http://darman.tamin.ir/Webservice/ApplyParNoteWebService.asmx?op=Save_Request
http://darmanws.tamin.ir/paraclinicwebservice.asmx?op=Save_Request

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

موفق باشید.

ضمن تشکر از توجه شما دوست عزیز
بنده با توجه به قالب بندی جدید تغییرات لازم را به به شکل ذیل انجام دادم
ولی باتوجه به اینکه نمیدونم ایراد از قالب بندی بنده است یا از سرور و نحوه تستش را نمیدونم لذا از شما دوست عزیز درخواست راهنمایی داشتم
وب سرویس قبلی همچنان کار میکند ولی نگرانی بنده از موقعی که اون قطع بشه

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




Const WSURL As String = "http://darmanws.tamin.ir/paraclinicwebservice.asmx"
Const SVCJSON As String = "{""TAREFCODE"":""@TC"", ""Num"":""@NUM""}"
'--------------------------






Public Type Request_Response
R_Code As Integer
ERROR_MESSAGE As String
REQUEST_ID As Long
End Type
Public Function WS_TE( _
ByVal sBletSerial As String, _
ByVal sPrescDate As String, _
ByVal sDOCID As String, _
ByVal sDOC_SPEC As String, _
ByVal sParType As String, _
ByVal sCust_Service_type As String, _
ByVal TCs As String, _
ByVal NUMs As String) As Request_Response


On Error GoTo ERR_HNDLR


Dim RR As Request_Response
RR.ERROR_MESSAGE = ""
RR.REQUEST_ID = -1
'RR.Request_Result = 4
RR.R_Code = 4






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 + "<Save_Request xmlns=""http://tempuri.org/"">"
XM = XM + "<ParaUInfo>"
XM = XM + "<UserID>0140000025020</UserID>"
XM = XM + "<Password>k2728220K</Password>"
XM = XM + "</ParaUInfo>"
XM = XM + "<DocInfo>"
XM = XM + "<DOCID>" + sDOCID + "</DOCID>"
XM = XM + "<DOC_SPEC>" + sDOC_SPEC + "</DOC_SPEC>"
XM = XM + "<DOC_FNAME></DOC_FNAME>"
XM = XM + "<DOC_LNAME></DOC_LNAME>"
XM = XM + "<DOC_TYPE></DOC_TYPE>"
XM = XM + "</DocInfo>"
XM = XM + "<PrcInfo>"
XM = XM + "<BletSerial>" + sBletSerial + "</BletSerial>"
XM = XM + "<Mobile>091405785092</Mobile>"
XM = XM + "<PrescDate>" + sPrescDate + "</PrescDate>"
XM = XM + "<ParType>" + sParType + "</ParType>"
XM = XM + "<Cust_Service_type>" + sCust_Service_type + "</Cust_Service_type>"
XM = XM + "<Bastari>0</Bastari>"
XM = XM + "<FirstDiagnoseCode></FirstDiagnoseCode>"
XM = XM + "<Is2K>0</Is2K>"
XM = XM + "<DocFani_ID></DocFani_ID>"
XM = XM + "</PrcInfo>"
XM = XM + "<LabPrscInfo>"
XM = XM + "<LabDiagnoseCode></LabDiagnoseCode>"
XM = XM + "<LabDiagnoseComment></LabDiagnoseComment>"
XM = XM + "<LabGrpCode></LabGrpCode>"
XM = XM + "</LabPrscInfo>"
XM = XM + "<PhyPrscInfo>"
XM = XM + "<TotalSession></TotalSession>"
XM = XM + "<OrganNo></OrganNo>"
XM = XM + "<PhysioDiagnoseCode></PhysioDiagnoseCode>"
XM = XM + "<PhysioDiagnoseComment></PhysioDiagnoseComment>"
XM = XM + "<DarmanPhysio></DarmanPhysio>"
XM = XM + "<DarmanDoc></DarmanDoc>"
XM = XM + "</PhyPrscInfo>"
XM = XM + "<PrescDInfo>"
XM = XM + "<PrescDInfo>"
XM = XM + "<TAREFCODE>701715</TAREFCODE>"
XM = XM + "<Num>1</Num>"
XM = XM + "</PrescDInfo>"
XM = XM + "<PrescDInfo>"
XM = XM + "<TAREFCODE></TAREFCODE>"
XM = XM + "<Num></Num>"
XM = XM + "</PrescDInfo>"
XM = XM + "</PrescDInfo>"
XM = XM + "</Save_Request>"
XM = XM + "</soap12:Body>"
XM = XM + "</soap12:Envelope>"








'XM = XM + "<sParListJson>" + PARLIST_JSON(TCs, NUMs) + "</sParListJson>"






Dim XML_HTTP As New MSXML2.XMLHTTP60
XML_HTTP.Open "POST", WSURL, False
XML_HTTP.setRequestHeader "HOST", "DARMANWS.TAMIN.IR"
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


'Forms!paziresh!ADDRESS = "ÊÓÊ"


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 "RequestId"
RR.REQUEST_ID = XNL(I).Text
Case "ErrorMessage"
RR.ERROR_MESSAGE = XNL(I).Text
Case "RCode"
RR.R_Code = XNL(I).Text
End Select
Next
Else
RR.ERROR_MESSAGE = CStr(XML_HTTP.Status) + XML_HTTP.StatusText
End If


WS_TE = RR
Set XML_HTTP = Nothing


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




End Function
Function PARLIST_JSON(ByVal TCs As String, NUMs As String) As String
Dim JSON() As String
Dim T() As String
Dim N() As String
T = Split(TCs, ",")
N = Split(NUMs, ",")
Dim I, K As Integer
K = UBound(T)
ReDim Preserve JSON(K)
For I = 0 To K
JSON(I) = Replace(SVCJSON, "@TC", T(I))
JSON(I) = Replace(JSON(I), "@NUM", N(I))
Next
PARLIST_JSON = "[" + Join(JSON, ",") + "]"
End Function


Sub TEST()
Dim X As Request_Response
X = WS_TE(Forms!SENDWEB!NUM_D, Forms!SENDWEB!DATE_D, Forms!SENDWEB!N_DOCTER, "", Forms!SENDWEB!Text146, Forms!SENDWEB!Text142, Forms!SENDWEB!Text171, Forms!SENDWEB!Text173)
'X = WS_TE("149028680227802602", "1396/01/30", "43571", "", "04", "4020", "701715,701655", "1,2")
'MsgBox ("˜Ï ÑåíÑí=" + Trim(X.REQUEST_ID) + vbCrLf + "RCode=" + Trim(X.RCode) + vbCrLf + "ERROR_MESSAGE=" + X.ERROR_MESSAGE)


Forms!SENDWEB!Label175.Caption = Trim(X.ERROR_MESSAGE) & " ; " & Trim(X.R_Code)


If Val(Forms!SENDWEB!Tracking_number) = 0 Then
If Trim(X.REQUEST_ID) > 0 Then
Forms!SENDWEB!Tracking_number = Trim(X.REQUEST_ID)
Forms!SENDWEB!DATE_INSERT = Today_persian_Date$()
Forms!SENDWEB!User = Forms!Main!Text26
Forms!SENDWEB!TIM = Time()
Forms!SENDWEB!Label175.Caption = Trim(X.ERROR_MESSAGE) & "!!!ÚãáíÇÊ ÈÇ ãæÝÞíÊ ÇäÌÇ㠐ÑÏíÏ!!!"
End If
End If
End Sub

[ATA_TABRIZ]

آقای Mazoolagبه دادم برس سایت قطع شده من هنوز به نتیحه نرسیدم

[amirzazadeh]

سلام
من كد هاتون رو كمي دستكاري كردم و خوشبختانه جواب داد شما هم تست كنيد ونتيجه رو اعلام كنيد:


Public Function WS_TE( _
ByVal sBletSerial As String, _
ByVal sPrescDate As String, _
ByVal sDOCID As String, _
ByVal sDOC_SPEC As String, _
ByVal sParType As String, _
ByVal sCust_Service_type As String, _
ByVal TCs As String, _
ByVal NUMs As Integer) As Request_Response


On Error GoTo ERR_HNDLR


Dim RR As Request_Response
RR.ERROR_MESSAGE = ""
RR.REQUEST_ID = -1
'RR.Request_Result = 4
RR.R_Code = 4






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 + "<Save_Request xmlns=""http://tempuri.org/"">"
XM = XM + "<ParaUInfo>"
XM = XM + "<UserID>0140000025020</UserID>"
XM = XM + "<Password>k2728220K</Password>"
XM = XM + "</ParaUInfo>"

XM = XM + "<DocInfo>"
XM = XM + "<DOCID>" + sDOCID + "</DOCID>"
XM = XM + "<DOC_SPEC></DOC_SPEC>"
XM = XM + "<DOC_FNAME></DOC_FNAME>"
XM = XM + "<DOC_LNAME></DOC_LNAME>"
XM = XM + "<DOC_TYPE></DOC_TYPE>"
XM = XM + "</DocInfo>"

XM = XM + "<PrcInfo>"
XM = XM + "<BletSerial>" + sBletSerial + "</BletSerial>"
XM = XM + "<Mobile>09140578505</Mobile>"
XM = XM + "<PrescDate>" + sPrescDate + "</PrescDate>"
XM = XM + "<ParType>" + sParType + "</ParType>"
XM = XM + "<Cust_Service_type>" + sCust_Service_type + "</Cust_Service_type>"
XM = XM + "<Bastari>0</Bastari>"
XM = XM + "<FirstDiagnoseCode></FirstDiagnoseCode>"
XM = XM + "<Is2K>0</Is2K>"
XM = XM + "<DocFani_ID></DocFani_ID>"
XM = XM + "</PrcInfo>"

XM = XM + "<LabPrscInfo>"
XM = XM + "<LabDiagnoseCode></LabDiagnoseCode>"
XM = XM + "<LabDiagnoseComment></LabDiagnoseComment>"
XM = XM + "<LabGrpCode></LabGrpCode>"
XM = XM + "</LabPrscInfo>"

XM = XM + "<PhyPrscInfo>"
XM = XM + "<TotalSession>1</TotalSession>"
XM = XM + "<OrganNo>1</OrganNo>"
XM = XM + "<PhysioDiagnoseCode></PhysioDiagnoseCode>"
XM = XM + "<PhysioDiagnoseComment></PhysioDiagnoseComment>"
XM = XM + "<DarmanPhysio></DarmanPhysio>"
XM = XM + "<DarmanDoc></DarmanDoc>"
XM = XM + "</PhyPrscInfo>"

XM = XM + "<PrescDInfo>"
XM = XM + "<PrescDInfo>"
XM = XM + "<TAREFCODE>701715</TAREFCODE>"
XM = XM + "<Num>1</Num>"
XM = XM + "</PrescDInfo>"

' XM = XM + "<PrescDInfo>"
' XM = XM + "<TAREFCODE>701715</TAREFCODE>"
' XM = XM + "<Num>1</Num>"
' XM = XM + "</PrescDInfo>"

XM = XM + "</PrescDInfo>"

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








'XM = XM + "<sParListJson>" + PARLIST_JSON(TCs, NUMs) + "</sParListJson>"






Dim XML_HTTP As New MSXML2.XMLHTTP60
XML_HTTP.Open "POST", WSURL, False
XML_HTTP.setRequestHeader "HOST", "DARMANWS.TAMIN.IR"
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


'Forms!paziresh!ADDRESS = "E?E"


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 "RequestId"
RR.REQUEST_ID = XNL(I).Text
Case "ErrorMessage"
RR.ERROR_MESSAGE = XNL(I).Text
Case "RCode"
RR.R_Code = XNL(I).Text
End Select
Next
Else
RR.ERROR_MESSAGE = CStr(XML_HTTP.Status) + XML_HTTP.StatusText
End If


WS_TE = RR
Set XML_HTTP = Nothing


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




End Function

البته توجه داشته باشيد كه من به جاي تعداد جلسات و شماره ارگان 1 رو وارد كردم ولي شما قاعدتا بايد اين پارامترها رو در فانكشن ws اضافه كنيد و از طريق فرم مقدار دهي كنيد كه اين مورد رو بهتر از من مي دونيد.

[ATA_TABRIZ]

سلام جناب amirzazadeh (http://barnamenevis.org/member.php?47888-amirzazadeh)
از توجه شما بسیار متشکرم
میشه کجا ایراد داشت که host را باز نمیکرد
مجددا از لطف شما بی نهایت تشکر میکنم