درخواست راهنمایی جهت ارسال sms با وب سرويس

[mohammadsaleh]

سلام دوستان و اساتید گرامی
شرکت پارس گرین برای ارسال پیامک با استفاده از وب سرویس برای همه زبانهای برنامه نویسی بجز اکسس راهکار همراه با مثال ارائه کرده است
با استفاده از DLL این شرکت و وارد کردن ان در ویژوال استودیو براحتی با کد مربوط پیامک ارسال می شود. من سعی کردم کلاس های این فایل را با استفاده از اکسس 2003 به اکسس وارد کنم. در فرم برنامه می توان کلاس های مختلف برنامه را صدا و دستور مورد نظر را اجرا کرد
در هر صورت به جز دستور wsm_GetCredit که اعتبار باقی مانده را نشان می دهم موفق نشدم دستور دیگری را اجرا کنم.
مهمترین گزینه کار با وب سرویس امضا دیجیتال شرکت می باشد که هریک از کاربران عضو آن را در سایت تولید و در نرم افزار استفاده می کنند

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

با تشکر فراوان

[mazoolagh]

برای کار با وب سرویس نیازی به کمپوننت نیست،
شما کافی هست از متد http post استفاده کنین.

قبلا مفصل و با کد نمونه در تاپیک زیر بحث شده در موردش:
https://barnamenevis.org/showthread.php?524097-وب-سرويس

همینجور اینجا هم پرسش مشابه داشتیم:
https://barnamenevis.org/showthread.php?524895-ارسال-sms-از-اکسس-با-API-webservis

مطمئنم شما وقت بگذارین تاپیک وب سرویس رو با دقت بخونین جواب گرفتین، ولی اگر موردی بود مطرح کنین.
نگران اسم امضای دیجیتال هم نباشید؛ در واقع همون token هست که بیشتر وب سرویس های پولی یا رایگان ولی با محدودیت دارن و مشابه user/pass هست.

[mohammadsaleh]

ضمن تشکر از حسن توجه شما. سعیم رو می کنم
بله در مورد امضا نگرانی ندارم چون به هر تعداد بخوام میتونم بسازم
فقط یک سئوال رفرنس MSSOAP30 هم برای استفاده از این روش لازمه به برنامه اضافه بشه یا نه
اینطور که متوجه شدم برای مثلا ارسال پیام از کدهای آدرس زیر استفاده و به جای STRING درون کد پارامترهای خود را میدهیم
البته برای من که واقعا تو این زمینه کار نکردم کمی مفاهیمش ثقیله
https://login.parsgreen.com/Api/SendSMS.asmx?op=SendGroupSMS


SOAP 1.1

The following is a sample SOAP 1.1 request and response. The placeholders shown need to be replaced with actual values.

POST /Api/SendSMS.asmx HTTP/1.1Host: login.parsgreen.com
Content-Type: text/xml; charset=utf-8
Content-Length: length
SOAPAction: "http://ParsGreen.com/SendGroupSMS"

<?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>
<SendGroupSMS xmlns="http://ParsGreen.com/">
<signature>string</signature>
<from>string</from>
<to>
<string>string</string>
<string>string</string>
</to>
<text>string</text>
<isFlash>boolean</isFlash>
<udh>string</udh>
<success>int</success>
<retStr>
<string>string</string>
<string>string</string>
</retStr>
</SendGroupSMS>
</soap:Body> </soap:Envelope>

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


امضا دیجیتال جهت تست: 443E70C8-1DFD-499B-B80D-98318765BC57

[mazoolagh]

ارسال sms به نسبت ارسال نسخه تامین اجتماعی که بحثش شده به مراتب ساده تر هست،
هم تعداد پارامترها کمتر هست و هم اینکه برخلاف تامین اجتماعی هم بهتر مستند شده و هم توسط برنامه نویسای بهتری نوشته شده!

شما به هیچ رفرنسی به جز ms xml نیاز ندارین.

پست 11 در همون تاپیک وب سرویس کلید کار هست
https://barnamenevis.org/showthread.php?524097-وب-سرويس&p=2326057&viewfull=1#post2326057

[mohammadsaleh]

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

'POST /Api/SendSMS.asmx HTTP/1.1
'Host: login.parsgreen.com
'Content-Type: text/xml; charset=utf-8
'Content -length: length
'SOAPAction: "http://ParsGreen.com/SendGroupSmsSimple"
'
'<?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>
' <SendGroupSmsSimple xmlns="http://ParsGreen.com/">
' <signature>string</signature>
' <from>string</from>
' <to>
' <string>string</string>
' <string>string</string>
' </to>
' <text>string</text>
' <isFlash>boolean</isFlash>
' <udh>string</udh>
' </SendGroupSmsSimple>
' </soap:Body>
'</soap:Envelope>




Dim XM As String


XM = "<?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>" & _
"<SendGroupSmsSimple xmlns=""http://ParsGreen.com/"">" & _
"<signature>""995428DA-14EB-4512-859D-B4E66948A672""</signature>" & _
"<from>""10002156713700""</from>" & _
"<to>" & _
"<string>""09120000000""</string>" & _
"<string>""09120000000""</string>" & _
"</to>" & _
"<text>""salam""</text>" & _
"<isFlash>" & False & "</isFlash>" & _
"<udh>"" ""</udh>" & _
"</SendGroupSmsSimple>" & _
"</soap:Body>" & _
"</soap:Envelope>"


Const WSURL As String = "https://login.parsgreen.com/Api/SendSMS.asmx"
Dim XML_HTTP As New MSXML2.XMLHTTP60
XML_HTTP.Open "POST", WSURL, False
XML_HTTP.setRequestHeader "HOST", "login.parsgreen.com"
XML_HTTP.setRequestHeader "CONTENT-TYPE", "text/xml; charset=utf-8" '"application/soap+xml; charset=utf-8"
XML_HTTP.setRequestHeader "SOAPACTION", "http://ParsGreen.com/SendGroupSmsSimple"
XML_HTTP.send XM

امضا، شماره فرستنده واقعی هستند. برای تست شماره خودتان را جایگزین بفرمایید

[mazoolagh]

1- "" هایی که دو طرف پارامترها گذاشتین بردارین - نباید باشه!

2- در آدرس زیر فرمت تمام عملیات api رو براتون آورده:
https://login.parsgreen.com/Api/SendSMS.asmx

3- برای ارسال پیامک تکی فرمت به این شکل هست:
https://login.parsgreen.com/Api/SendSMS.asmx?op=Send
طبق این راهنما، soapaction نیاز ندارین.

[mazoolagh]

4- طبق راهنمای ارسال زیر، با اطلاعاتی که دادین پیامک ارسال نمیشه و پاسخ not send برمیگرده:
https://login.parsgreen.com/Files/HttpService-TechnicalDocumentation.pdf

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

[mazoolagh]

5- یک برنامه نمونه براتون آماده میکنم، کدهای طولانی اینجا درست نمایش داده نمیشن.
تست کنین و خبر بدین.

[mohammadsaleh]

باتشکر از زحمات شما
البته من با متد HTTP میتونم با کد زیر ارسال کنم( تست بفرمایید)
اما هدفم اینه که یا از کلاسهایی که در فایل ضمیمه گذاشته بودم و یا از روش ارسال SOAP استفاده کنم
البته با توجه به اینکه در هر دو روش HTTP و SOAP آوردن کدها در جاهای مختلفه سخته اگر بشه با اون یک تابع عمومی درست کرد عالی میشه که متاسفانه من تو این موضوع ضعف دارم


Dim Token As String
Dim Url As String
Dim i As Integer
Dim xmlDoc As New MSXML2.DOMDocument60
Dim HttpReq As New MSXML2.ServerXMLHTTP60
Dim Emza, az, Be, Payam As String
Emza = "443E70C8-1DFD-499B-B80D-98318765BC57"
az = "10002156713700"
Be = "0912000,0939000"
Payam = "سلام"
Url = "http://login.parsgreen.com/UrlService/sendsms.ashx?FROM=" & az & "&TO=" & Be & "&TEXT=" & Payam & "&signature=" & Emza & ""
HttpReq.Open "GET", Url, False
HttpReq.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
HttpReq.send
Token = HttpReq.responseText
MsgBox Token

[mohammadsaleh]

فقط یک نکته ای رو یاداور بشم
لطفا به شماره ای ارسال کنید که پیامک تبلیغاتی اون مسدود نباشه

[mohammadsaleh]

استاد سلام
پیامهای تست شما وارد سامانه شده از آنجاییکه این سامانه پیامهای سفید(پیامهای تایید شده با فرمت خاص شرکت ارسال کننده) را ارسال می کند لطفا از پیامی که به شماره ارسالی فرستادم جهت تست استفاده بفرمایید

[mazoolagh]

سلام و روز خوش

1- signature رو از پست هاتون حذف کنین یا از پنل کاربری تغییرش بدین (اگر میشه)!

2- روی نمونه پیوست چک کنین و خبر بدین
کد اصلی چک شده ولی من تغییرات جزئی دادم و بعدش تست نشده

3- این کد فقط متد ارسال تکی sendsms رو در برمیگیره، برای بقیه متدها از همین الگو بگیرین.

4- یک راهنما در آدرس زیر هست:
https://www.parsgreen.com/content/files/Doc/sms/Web-Service/SOAP-TechnicalDocumentation.pdf

اون رو باید بخونین و کدهای برگشت (retstr,return value) رو از روی اون تفسیر کنین.
در کد پیوست این مقادیر بصورت status,refrence,mobile, sendresult برمیگردن.

[mazoolagh]

Option Compare Database
Option Explicit
Public Const WSURL = "https://login.parsgreen.com/Api/SendSMS.asmx"
Public Const Signature = "...."
Public Const XML = _
"<?xml version='1.0' encoding='utf-8'?>" & _
"<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'>" & _
"<soap12:Body><Send xmlns='http://ParsGreen.com/'>" & _
"<signature>@S</signature>" & _
"<toMobile>@M</toMobile>" & _
"<smsBody>@T</smsBody>" & _
"<retStr></retStr></Send></soap12:Body></soap12:Envelope>"
Public Type SendResponse
SendResult As Integer
Mobile As String
Status As String
Refrence As String
http_status As Integer
http_status_text As String
End Type

[mazoolagh]

Public Function SendSMS(Mobile As String, Text As String) As SendResponse
Dim X As String
X = Replace(XML, "@S", Signature)
X = Replace(X, "@M", Mobile)
X = Replace(X, "@T", Text)
With New XMLHTTP60
.Open "POST", WSURL, False
.setRequestHeader "HOST", "login.parsgreen.com"
.setRequestHeader "CONTENT-TYPE", "application/soap+xml; charset=utf-8"
.Send X
SendSMS.http_status = .Status
SendSMS.http_status_text = .statusText
If .Status = 200 Then
Dim Doc As New DOMDocument60
Doc.SetProperty "SelectionNamespaces", "xmlns:pg='http://ParsGreen.com/'"
Doc.loadXML .responseText
SendSMS.SendResult = Doc.selectSingleNode("//pg:SendResult").Text
Dim retStr As Variant
retStr = Split(Doc.selectSingleNode("//pg:retStr").Text, ";")
SendSMS.Mobile = retStr(0)
SendSMS.Status = retStr(1)
SendSMS.Refrence = retStr(2)
End If
End With
End Function

[mohammadsaleh]

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

[mazoolagh]

نظر لطف شماست،
خوشحالم جواب گرفتین.

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

و خواهش میکنم پس از این به نهایتا یک "آقا" در خطاب بسنده کنین.

[mohammadsaleh]

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

[mazoolagh]

اگر زیاد با ارسال گروهی سر و کار ندارین (چه از نظر فاصله زمانی، چه اندازه گروه و ...) شاید ارزش نداشته باشه براش کد بنویسین.
میتونین همین کد رو تو حلقه استفاده کنین، چون در هر صورت در همون کد جدید هم ناچار به استفاده از حلقه هستین.

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

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

حالا در تابع ارسال گروهی میتونین کد پیام و یک رکوردست (یا array یا ....) رو بعنوان پارامتر بفرستین و تابع باید نتایج ارسال رو در جدول سابقه بنویسه.

برای تابع گروهی باید از لینک زیر استفاده کنین:
https://login.parsgreen.com/Api/SendSMS.asmx?op=SendGroupSMS

[mazoolagh]

منظورتون از "کدهای وبی" رو متوجه نشدم که dom structure هست
یا http post و ...
یا خود وب سرویس.

واقعیتش اینه که بهترین و سریعترین راه یادگیری کلاس حضوری هست بنظرم!

[mohammadsaleh]

سلام. منظورم همین نحوه پارامتر دهی در کدهای XML , HTTP POST , DOM STRUCTURE هست
من سعی کردم مثل شما ابتدا بیام ثوابت رو تعریف کنم:


Public Const WSURL = "https://login.parsgreen.com/Api/SendSMS.asmx"
Public Const Signature = "0000"
Public Const from = "10006713700"
Public Const isFlash = False
Public Const udh = ""
Public Const success = 0



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



Public Const XML = _
"<?xml version='1.0' encoding='utf-8'?>" & _
"<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'>" & _
"<soap12:Body><SendGroupSMS xmlns='http://ParsGreen.com/'>" & _
"<signature>@S</signature>" & _
"<from>@F</from>" & _
"<to>" & _
"<string>@M</string>" & _
"</to>" & _
"<text>@T</text>" & _
"<isFlash>@IS</isFlash>" & _
"<udh>@U</udh>" & _
"<success>@SC</success>" & _
"<retStr></retStr></SendGroupSMS></soap12:Body></soap12:Envelope>"






Public Type SendGroupSMSResponse
SendGroupSMSResult As Integer
to As String
Status As String
Refrence As String
http_status As Integer
http_status_text As String
End Type



تابع ارسال را هم به شکل زیر نوشتم:



Public Function SendGroupSMS(Text As String) As SendGroupSMSResponse
Dim X As String
X = Replace(XML, "@S", Signature)
X = Replace(X, "@F", from)
X = Replace(X, "@M", to)
X = Replace(X, "@T", Text)
X = Replace(X, "@IS", isFlash)
X = Replace(X, "@U", udh)
X = Replace(X, "@SC", success)


With New XMLHTTP60


.Open "POST", WSURL, False
.setRequestHeader "HOST", "login.parsgreen.com"
.setRequestHeader "CONTENT-TYPE", "application/soap+xml; charset=utf-8"
.Send X

SendGroupSMS.http_status = .Status
SendGroupSMS.http_status_text = .statusText
If .Status = 200 Then
Dim Doc As New DOMDocument60
Doc.SetProperty "SelectionNamespaces", "xmlns:pg='http://ParsGreen.com/'"
Doc.loadXML .responseText
SendGroupSMS.SendGroupSMSResult = Doc.selectSingleNode("//pg:SendGroupSMSResult").Text
Dim retStr As Variant
retStr = Split(Doc.selectSingleNode("//pg:retStr").Text, ";")
SendGroupSMS.Mobile = retStr(0)
SendGroupSMS.Status = retStr(1)
SendGroupSMS.Refrence = retStr(2)
End If
End With
End Function



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


<to>
<string>string</string>
<string>string</string>
</to>


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

X = Replace(X, "@M", to)

به هرصورت خیلی به نظرم پیچیده اومد.چند روز هم دارم کلنجار میرم و یه مقدار اصول کلی xml رو هم خوندم ولی با کدهای قشنگی که شما زدید کلی راه باید برم تا اونها را درک کنم. این رو میدونم که برای یادگیری باید تلاش کرد تا همه جوانب را یاد گرفت. ولی ازتون درخواست می کنم محبت کنید زحمت این بخش رو هم بکشید مثل قبلی.
در مورد پارامترهای isflash, success,udh مقادیر false,0,null داخل کد چه جوری باید نوشته بشه. یا اصلا لازمه چیزی نوشته بشه یا همون طور خالی بمونه

توی کد .NET مثل زیرنوشته:


int cnt = 0;
string _apikey ="D0C42A2D-6862-49B4-819E-FBD29A762978";
int ret = new PARSGREEN.API.SMS.Send.SendSMS().SendGroupSMS(_api key, "", number, "salam", false, "", ref cnt, ref txt);



ملاحظه می کنید که تلاش زیاد کردم ولی هنوز در جا میزنم.

[mazoolagh]

1- برای ارسال گروهی باید در request ، در تگ to بازای هر شماره یک تگ string با مقدار شماره بفرستین.
حالا یا باید کل محتوای درون تگ to رو قبلا بسازین و بعنوان پارامتر به تابع پاس کنین
یا
شماره ها رو به شکلی (رکوردست، ارایه، کالکشن، ...) به تابع پاس کنین و درون تابع این مجموعه رو بسازین.

2- همینجور در response ، بازای هر شماره ای که در to آوردین، یک تگ string در تگ retstr برمیگرده،
بنابراین دیگه مثل قبل فقط با متد selectsinglenode بتنهایی نمیشه جواب گرفت.


یک نمونه براتون آماده میکنم تا روش کار رو متوجه بشین.

[mohammadsaleh]

سلام جناب mazoolagh (https://barnamenevis.org/member.php?9893-mazoolagh)
منتظر زحمت شما هستم

[mazoolagh]

سلام
کد زیر رو تست کنین و خبرش رو بدین.
فرض بر این هست که :
1- ساختار جدول ها رو مثل همین که گفتم ساختین
2- لیست شماره ها بصورت رکوردست به تابع منتقل میشه
فرضا select * from persons where
3- نتیجه برای هر شماره در جدول سابقه نوشته میشه (در خود تابع) ولی چیزی برنمیگرده - این نتیجه مثل همون ارسال تکی هست.
4- تابع فقط مقدار کلی success رو همراه با وضعیت http برمیگردونه

[mazoolagh]

Private Const WSURL = "https://login.parsgreen.com/Api/SendSMS.asmx"
Private Const Signature = "...."
Private Const Sender = "...."
Private Const XML = _
"<?xml version='1.0' encoding='utf-8'?>" & _
"<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'>" & _
"<soap12:Body><SendGroupSMS xmlns='http://ParsGreen.com/'>" & _
"<signature>@SGN</signature>" & _
"<from>@SDR</from>" & _
"<to>@M</to>" & _
"<text>@T</text>" & _
"<isFlash>false</isFlash>" & _
"<udh></udh>" & _
"<success></success>" & _
"<retStr></retStr></SendGroupSMS ></soap12:Body></soap12:Envelope>"

[mazoolagh]

Public Type SendGroupSMSResponse
SendGroupSMSResult As Integer
success As Integer
http_status As Integer
http_status_text As String
End Type

[mazoolagh]

Public Function SendGroupSMS(Mobiles As Recordset, MessageID As Long) As SendGroupSMSResponse
Dim SendTime As Date
Dim X As String
X = Replace(XML, "@SGN", Signature)
X = Replace(X, "@SDR", Sender)
X = Replace(X, "@T", DLookup("Message", "Messages", "MessageID=" & MessageID))
Dim M As String
Do Until Mobiles.EOF
M = M + "<string>" & Mobiles!Mobile & "</string>"
Mobiles.MoveNext
Loop
X = Replace(X, "@M", M)
With New XMLHTTP60
.Open "POST", WSURL, False
.setRequestHeader "HOST", "login.parsgreen.com"
.setRequestHeader "CONTENT-TYPE", "application/soap+xml; charset=utf-8"
.Send X
SendTime = Now
SendGroupSMS.http_status = .Status
SendGroupSMS.http_status_text = .statusText
If .Status = 200 Then
Dim Doc As New DOMDocument60
Doc.SetProperty "SelectionNamespaces", "xmlns:pg='http://ParsGreen.com/'"
Doc.loadXML .responseText
SendGroupSMS.SendGroupSMSResult = Doc.selectSingleNode("//pg:SendGroupSMSResult").Text
SendGroupSMS.success = Doc.selectSingleNode("//pg:success").Text
Dim node As MSXML2.IXMLDOMNode
Dim a As Variant
Dim s As String
Const sql = "INSERT INTO History (Mobile,MessageID,Status,Refrence,SendTime) VALUES ('@MN',@MID,@S,@R,#@T#)"
For Each node In Doc.selectSingleNode("//pg:retStr").childNodes
a = Split(node.Text, ";")
s = Replace(sql, "@MN", a(0))
s = Replace(s, "@MID", MessageID)
s = Replace(s, "@T", SendTime)
s = Replace(s, "@S", a(1))
s = Replace(s, "@R", a(2))
DoCmd.RunSQL s
Next
End If
End With
End Function

[mohammadsaleh]

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

Dim db As DAO.Database
Set db = CurrentDb
Dim RS As Recordset
Dim strSql As String
strSql = "SELECT Mobile FROM tblMobiles"
Set RS = db.OpenRecordset(strSql, dbOpenDynaset)
SendGroupSMS RS, 1


151785

[mazoolagh]

این کد رو فقط کامپایل کردم ولی اجرا نکردم، بنابراین ممکنه ایراد منطقی ویا اجرایی داشته باشه.

اگر 3-4 شماره واقعی برای من ایمیل کنین، کد رو در عمل تست میکنم ببینم اشکال کجاست.

به mazoolagh در yahoo بفرستین.

[mohammadsaleh]

سلام
ارسال کردم

[mazoolagh]

مشکل در ساخت رشته شماره ها و بدلیل بی دقتی من بود!
در ضمن شماره پیگیری رو به string تغییر دادم.

جدول نمونه history دو ارسال گروهی اخیر هم هست که میتونین بررسی کنین.

[mazoolagh]

Private Const WSURL = "https://login.parsgreen.com/Api/SendSMS.asmx"
Private Const Signature = "----"
Private Const Sender = "...."

Private Const XM = "<?xml version='1.0' encoding='utf-8'?>" & _
"<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'>" & _
"<soap12:Body><SendGroupSMS xmlns='http://ParsGreen.com/'>" & _
"<signature>@SGN</signature>" & _
"<from>@SDR</from>" & _
"<to><string>@M</string></to>" & _
"<text>@T</text>" & _
"<isFlash>false</isFlash>" & _
"<udh></udh>" & _
"<retStr></retStr>" & _
"</SendGroupSMS></soap12:Body></soap12:Envelope>"


Public Type SendGroupSMSResponse
SendGroupSMSResult As Integer
success As Integer
http_status As Integer
http_status_text As String
End Type

[mazoolagh]

Public Function SendGroupSMS(Mobiles As Recordset, MessageID As Long) As SendGroupSMSResponse
Dim SendTime As Date
Dim X As String
X = Replace(XM, "@SGN", Signature)
X = Replace(X, "@SDR", Sender)
X = Replace(X, "@T", DLookup("Message", "Messages", "MessageID=" & MessageID))
Dim M As String
Do Until Mobiles.EOF
M = IIf(M = "", Mobiles!Mobile, M + vbCrLf + Mobiles!Mobile)
Mobiles.MoveNext
Loop
X = Replace(X, "@M", M)
With New XMLHTTP60
.Open "POST", WSURL, False
.setRequestHeader "HOST", "login.parsgreen.com"
.setRequestHeader "CONTENT-TYPE", "application/soap+xml; charset=utf-8"
.Send X
SendTime = Now
SendGroupSMS.http_status = .Status
SendGroupSMS.http_status_text = .statusText
If .Status = 200 Then
Dim Doc As New DOMDocument60
Doc.SetProperty "SelectionNamespaces", "xmlns:pg='http://ParsGreen.com/'"
Doc.loadXML .responseText
SendGroupSMS.SendGroupSMSResult = Doc.selectSingleNode("//pg:SendGroupSMSResult").Text
SendGroupSMS.success = Doc.selectSingleNode("//pg:success").Text
Dim node As MSXML2.IXMLDOMNode
Dim a As Variant
Dim s As String
Const sql = "INSERT INTO History (Mobile,MessageID,Status,Refrence,SendTime) VALUES ('@MN',@MID,@S,'@R',#@T#)"
For Each node In Doc.selectSingleNode("//pg:retStr").childNodes
a = Split(node.Text, ";")
s = Replace(sql, "@MN", a(0))
s = Replace(s, "@MID", MessageID)
s = Replace(s, "@T", SendTime)
s = Replace(s, "@S", a(1))
s = Replace(s, "@R", a(2))
DoCmd.RunSQL s
Next
End If
End With
End Function

[mazoolagh]

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

Sub test()
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("select mobile from persons where personid>0")
Dim response As SendGroupSMSResponse
response = SendGroupSMS(rs, 1)
rs.Close
Set rs = Nothing
End Sub

[mazoolagh]

در ضمن قرار بود از مدیر بخش درخواست تغییر نام تاپیک به یک عنوان مربوط و مناسب با موضوع رو بدین.

[mohammadsaleh]

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

[mohammadsaleh]

سلام خدمت اساتید و دوستان عزیز به ویژه جناب
mazoolagh عزیز
یکی از قابلیتهای استفاده از این وب سرویس ارسال پیام نظیر به نظیر ( پیام اختصاصی برای هر شماره ) به صورت یکجا می باشد
من کدها رو با استفاده از کدهای قبلی که جناب
mazoolagh زحمت اون رو کشیدند در متد SendGroupSMSP2P استفاده کردم ولی نمیدونم چرا پیامها رو به جای ارسال به هریک از شماره به صورت یکجا به همه شماره ها میفرسته
کدهایی که نوشتم اینهاست:

'------------ send GroupSms P2P ---------------------


Private Const GroupSMSP2pXML = "<?xml version='1.0' encoding='utf-8'?>" & _
"<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'>" & _
"<soap12:Body><SendGroupSMSP2P xmlns='http://ParsGreen.com/'>" & _
"<signature>@SGN</signature>" & _
"<from>@SDR</from>" & _
"<to><string>@M</string></to>" & _
"<texts><string>@T</string></texts>" & _
"<isFlash>false</isFlash>" & _
"<udh></udh>" & _
"<status></status>" & _
"<retStr></retStr>" & _
"</SendGroupSMSP2P></soap12:Body></soap12:Envelope>"


Private Type SendGroupSMSP2PResponse
SendGroupSMSP2PResult As Integer
' status As Integer
success As Integer
http_status As Integer
http_status_text As String
End Type




Private Function SendGroupSMSP2P(Mobiles As Recordset) As SendGroupSMSP2PResponse
Dim SendTime As Date
Dim X As String
Dim Msg As String
Dim M As String


X = Replace(GroupSMSP2pXML, "@SGN", Signature)
X = Replace(X, "@SDR", Sender)


Do Until Mobiles.EOF
Msg = IIf(Msg = "", Mobiles!Message, Msg + vbCrLf + Mobiles!Message)
M = IIf(M = "", Mobiles!Mobile, M + vbCrLf + Mobiles!Mobile)


Mobiles.MoveNext
Loop
X = Replace(X, "@T", Msg)
X = Replace(X, "@M", M)




With New XMLHTTP60
.Open "POST", WSURL, False
.setRequestHeader "HOST", "login.parsgreen.com"
.setRequestHeader "CONTENT-TYPE", "application/soap+xml; charset=utf-8"
.Send X
SendTime = CStr(Now)
SendGroupSMSP2P.http_status = .Status
SendGroupSMSP2P.http_status_text = .statusText
If .Status = 200 Then
Dim Doc As New DOMDocument60
Doc.SetProperty "SelectionNamespaces", "xmlns:pg='http://ParsGreen.com/'"
Doc.loadXML .responseText
SendGroupSMSP2P.SendGroupSMSP2PResult = Doc.selectSingleNode("//pg:SendGroupSMSP2PResult").Text
SendGroupSMSP2P.success = Doc.selectSingleNode("//pg:success").Text
Dim node As MSXML2.IXMLDOMNode
Dim a As Variant
Dim s As String
' Const sql = "INSERT INTO History (Mobile,MessageID,Status,Refrence,SendTime) VALUES ('@MN',@MID,@S,'@R','@T')"
Const sql = "INSERT INTO History (Mobile,Status,Refrence,SendTime) VALUES ('@MN',@S,'@R','@T')"

For Each node In Doc.selectSingleNode("//pg:retStr").childNodes

MsgBox node.Text
a = Split(node.Text, "#")
s = Replace(sql, "@MN", a(0))
' s = Replace(s, "@MID", MessageID)
s = Replace(s, "@T", SendTime)
s = Replace(s, "@S", a(1))
s = Replace(s, "@R", a(2))
DoCmd.RunSQL s
Next
End If


End With
End Function


Private Sub Command0_Click()


Dim db As DAO.Database
Set db = CurrentDb
Dim RS As Recordset
Dim strSql As String
strSql = "SELECT Message, Mobile FROM tblMobilesMSG"
Set RS = db.OpenRecordset(strSql, dbOpenDynaset)
SendGroupSMSP2P RS
Me.List2.Requery
End Sub

[atf1379]

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

[mohammadsaleh]

سلام فایل و کدها در پستهای قبلی وجود داره

[mazoolagh]

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

برای اطمینان قبل از ارسال X محتوای اون رو چک کنین.

قبل از اون با ارسال از طریق پنل یا یک برنامه دات نت مطمئن بشین که این رفتار by design نیست و مستندات درست هست.

[mazoolagh]

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

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

[mohammadsaleh]

ممنون جناب
mazoolagh

به نظرم مطابق راهنمای فنی اش باید درست باشه
151819

با این حال تلاش می کنم ببینم چی میشه

آدرس وب سرویس: https://login.parsgreen.com/Api/SendSMS.asmx?op=SendGroupSMSP2P

[mohammadsaleh]

آدرس راهنمای فنی وب سرویس: https://www.parsgreen.com/Content/files/Doc/sms/Web-Service/SOAP-TechnicalDocumentation.pdf

[mazoolagh]

مستندات رو که خوندم - بدون اون که نمیشه به اینجا رسید.

شما از طریق پنل یا کمپوننت دات نت تست کردین نتیجه چی هست؟

در هر صورت یک تست روی همون 4 شماره براتون فرستادم، چک کنین و خبر بدین.

[mohammadsaleh]

با انتقال عبارت string از xml به loop کار انجام شد. با سپاس مجدد از جناب mazoolagh (https://barnamenevis.org/member.php?9893-mazoolagh)




"<to>@M</to>" & _
"<texts>@T</texts>" & _

Do Until Mobiles.EOF
Msg = IIf(Msg = "", "<string>" + Mobiles!Message + "</string>", Msg + "<string>" + Mobiles!Message + "</string>")
M = IIf(M = "", "<string>" + Mobiles!Mobile + "</string>", M + vbCrLf + "<string>" + Mobiles!Mobile + "</string>")
Mobiles.MoveNext
Loop

[mazoolagh]

1- جواب ندادین که تست آخری که براتون رو 4 شماره فرستاده بودم نتیجه اش چی بود؟
همچنین نتیجه ارسال با کمپوننت دات نت خودشون رو هم میخواستم بدونم - که اون رو هم خبر ندادین!

2- ظاهرا رفتار این وب سرویس در بعضی متدها متفاوت با مستنداتش هست!
اگر یادتون باشه در sendgroupsms هم همین قضیه بود ولی برعکس - یعنی مجموعه شماره ها کلا باید یک node بود (برخلاف مستندات)
و به همین دلیل هم شما ابتدا همین شیوه رو روی این متد هم پیاده کردین (منطقی هم هست)
اما در این متد هر شماره باید یک نود باشه (و هر پیام)

به هر حال خوشحالم که به این سرویس مسلط شدین.

[mohammadsaleh]

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

[mazoolagh]

من فایل xml رو که برای تست ساختم (و ok هم بوده) اینجا پیوست کردم.
همونجور که میبینین شماره ها (و پیام ها) کلا یک node هستن و فقط با CRLF از هم جدا شدن،
خلاصه اینکه کد اولیه شما هم باید کار میکرد!
یکبار دیگه خروجی همون کد رو با دقت بررسی کنین.
البته این که اینجا آوردم soap 1.1 هست ولی نباید تاثیری داشته باشه.

<?xml version="1.0" encoding="utf-8"?>
<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<soap:Body><SendGroupSMSP2P xmlns="http://ParsGreen.com/">
<signature>----</signature>
<from>----</from>
<to>
<string>09123933059
09393933059
09122973369
09129009265</string>
</to>
<texts>
<string>p2p msg1 for 09123933059
p2p msg2 for 09393933059
p2p msg3 for 09122973369
p2p msg4 for 09129009265</string>
</texts>
<isFlash>false</isFlash>
<udh />
</SendGroupSMSP2P>
</soap:Body>
</soap:Envelope>

[mazoolagh]

در مورد تفسیر response مشخص کنین کجا مشکل دارین تا راهنمایی کنم.

[mohammadsaleh]

در مورد تفسیر نتایج p2p یه تابع ساده ساختم و از اون در تفسیر نتیجه استفاده کردم


Private Function StatusSMS(Responce As String) As String

Select Case Responce


Case Is = 0
StatusSMS = "موفق"
Case Is = 1
StatusSMS = "ناموفق"
Case Is = 2
StatusSMS = "خطا"
Case Is = 3
StatusSMS = "بلک ليست"
End Select

End Function

DoCmd.SetWarnings False
For Each node In Doc.selectSingleNode("//pg:retStr").childNodes
A = Split(node.Text, "#")
S = Replace(Sql, "@MN", Mid(A(0), 1, 11))
S = Replace(S, "@T", SendTime)
S = Replace(S, "@S", StatusSMS(CInt(Mid(A(0), 13, 1))))
S = Replace(S, "@R", Mid(A(0), 15, 50))
DoCmd.RunSQL S
Next






در ادامه راهنمایی ارزنده شما و نیز قابلیتهای جالب این وب سرویس امروز کار رو ارسال کد پیامکی که یکی از ارکان اصلی تاییدیه کارهای پیامکی در بسیاری از وب سایتها و استارت آپ ها ست رو شروع کردم. کد اولیه رو از وب سرویس مربوطه (http://login.parsgreen.com/Api/SendSMS.asmx?op=SendOtp) به شکل زیر نوشتم

Private Const SendOtpXML = "<?xml version='1.0' encoding='utf-8'?>" & _
"<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'>" & _
"<soap12:Body><SendOtp xmlns='http://ParsGreen.com/'>" & _
"<signature>@SGN</signature>" & _
"<mobile>@M</mobile>" & _
"<Lang>fa</Lang>" & _
"<otpType>1</otpType>" & _
"<patternId>3</patternId>" & _
"</SendOtp></soap12:Body></soap12:Envelope>"



Private Type SendOtpResponse
SendOtpResult As Integer
OtpCode As String
http_status As Integer
http_status_text As String
End Type




Private Function SendOtp(Mobile As String) As SendOtpResponse


Dim X As String
X = Replace(X, "@M", Mobile)
X = SendOtpXML


With New XMLHTTP60
.Open "POST", WSURL, False
.setRequestHeader "HOST", "login.parsgreen.com"
.setRequestHeader "CONTENT-TYPE", "application/soap+xml; charset=utf-8"
.send X
SendOtp.http_status = .status
SendOtp.http_status_text = .statusText
If .status = 200 Then
Dim Doc As New DOMDocument60
Doc.SetProperty "SelectionNamespaces", "xmlns:pg='http://ParsGreen.com/'"
Doc.loadXML .responseText
SendOtp.SendOtpResult = Doc.selectSingleNode("//pg:SendOtpResult").Text
' .......



End If
End With
End Function




که ظاهرا نیاز به کمی چکش کاری داره و راهنمایی شماره داره. البته ظاهر کد به نظر درست می آد اما ارسال کد انجام نمیشه

[mazoolagh]

سر فرصت کد "رمز یکبار مصرف" رو نگاه میکنم

[mohammadsaleh]

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

[mohammadsaleh]

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

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




Public Const GetCreditXml = "<?xml version=1.0' encoding='utf-8'?>" & _
"<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'>" & _
"<soap12:Body>" & _
"<GetCredit xmlns='http://ParsGreen.com/'>" & _
"<signature>@SGN</signature>" & _
"</GetCredit>" & _
"</soap12:Body>" & _
"</soap12:Envelope>"

Public Type GetCreditResponse
GetCreditResult As Double
http_status As Integer
http_status_text As String
End Type



2- مورد دوم مربوط به خواندن پیامهای صندوق دریافتی و ارسالی در سامانه می باشد. آدرس وب سرویس http://sms.parsgreen.ir/Api/MsgService.asmx می باشد.
البته در برنامه نوشته شده با VB.NET دیتاست بازگردانده شده در دیتاگرید ریخته می شود. اما در اکسس سردر نیاوردم چه باید کرد.

3- در مورد رمز یکبار مصرف البته از یک روش ابتکاری ارسال سریال تولیدی به تعداد ارقام مشخص استفاده کردم. اما روش برنامه پیشنهادی خود سایت برام لاینحل باقی مونده. البته فعلا نیازی به اون ندارم

[mazoolagh]

سلام و روز خوش
عجالتا یک signature و سه-چهار تا شماره موبایل ایمیل کنین.

[mohammadsaleh]

سلام خداقوت
ارسال کردم

[mazoolagh]

1- مانده اعتبار: این بمراتب خیلی ساده تر از موارد قبلی است!
فقط یک signature ارسال میکنید و response هم فقط یک مقدار برمیگردونه که با توجه به کدهای قبلی خیلی راحت پیاده میشه.
فکر کنم مشکل شما در کدنویسی نیست، بلکه در کار با داکیومنت های xml است.
اگر بخواهید بر همین مبنا پیش برین (یعنی استفاده از اکسس به جای برنامه دسکتاپ برای ارسال و دریافت) بدون تسلط به xml و ... کارتون خیلی سخت میشه.
شما میتونین دیتابیس رو همین اکسس نگه دارین، ولی اگر یک برنامه با vb.net بنویسین پیاده سازی هر متد فقط چند دقیقه زمان میبره بدون این که درگیر ساختار request و response بشین.
گذشته از این، نگهداری و توسعه کدها هم بسیار ساده تر و سریعتر هست.

با این وجود، تا زمانی که امکانش باشه، از راهنمایی و نمونه کد دریغ نمیکنم.

[mazoolagh]

مثل قبل برای ساخت request و تفسیر response از خود مستندات متد getcredit وب سرویس کمک میگیریم:
https://login.parsgreen.com/api/ProfileService.asmx?op=GetCredit

REQUEST
POST /api/ProfileService.asmx HTTP/1.1
Host: login.parsgreen.com
Content-Type: application/soap+xml; charset=utf-8
Content-Length: length

<?xml version="1.0" encoding="utf-8"?>
<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">
<soap12:Body>
<GetCredit xmlns="http://ParsGreen.com/">
<signature>string</signature>
</GetCredit>
</soap12:Body>
</soap12:Envelope>


RESPONSE
HTTP/1.1 200 OK
Content-Type: application/soap+xml; charset=utf-8
Content-Length: length


<?xml version="1.0" encoding="utf-8"?>
<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">
<soap12:Body>
<GetCreditResponse xmlns="http://ParsGreen.com/">
<GetCreditResult>double</GetCreditResult>
</GetCreditResponse>
</soap12:Body>
</soap12:Envelope>

[mazoolagh]

Option Compare Database
Option Explicit


Private Const WSURL = "https://login.parsgreen.com/Api/ProfileService.asmx"
Private Const Signature = "..."
Private Const XM = "<?xml version='1.0' encoding='utf-8'?>" & _
"<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'>" & _
"<soap12:Body>" & _
"<GetCredit xmlns='http://ParsGreen.com/'>" & _
"<signature>@SGN</signature>" & _
"</GetCredit>" & _
"</soap12:Body>" & _
"</soap12:Envelope>"


Public Type GetCreditResponse
GetCreditResult As Double
http_status As Integer
http_status_text As String
End Type


Public Function GetCredit() As GetCreditResponse
Dim X As String
X = Replace(XM, "@SGN", Signature)
With New XMLHTTP60
.Open "POST", WSURL, False
.setRequestHeader "HOST", "login.parsgreen.com"
.setRequestHeader "CONTENT-TYPE", "application/soap+xml; charset=utf-8"
.Send X
GetCredit.http_status = .Status
GetCredit.http_status_text = .statusText
If .Status = 200 Then
Dim Doc As New DOMDocument60
Doc.SetProperty "SelectionNamespaces", "xmlns:pg='http://ParsGreen.com/'"
Doc.loadXML .responseText
GetCredit.GetCreditResult = Doc.selectSingleNode("//pg:GetCreditResult").Text
End If
End With
End Function

[mazoolagh]

روش استفاده:
153281

[mazoolagh]

2- خواندن پیامهای صندوق دریافتی و ارسالی:
ساختار response در این متد شامل schema برای تعریف فیلدهای یک دیتاست هست، بنابراین لازم هست با این مبحث هم آشنا باشین.
سر فرصت میخونم مستندات رو و راهنمایی میکنم.

[mohammadsaleh]

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

[mazoolagh]

پیش از هر کار باید یک جدول (مثلا به اسم Messages) برای نگهداری نتایج بسازیم.
گرچه الزامی نیست، ولی برای راحتی کدنویسی اسامی فیلدهای این جدول رو دقیقا از روی ساختار پاسخ برمیداریم:
153290

[mazoolagh]

از آدرس زیر ساختار request و response رو پیدا میکنیم:
https://login.parsgreen.com/api/msgservice.asmx?op=GetMessage

REQUEST
POST /api/msgservice.asmx HTTP/1.1
Host: login.parsgreen.com
Content-Type: application/soap+xml; charset=utf-8
Content-Length: length


<?xml version="1.0" encoding="utf-8"?>
<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">
<soap12:Body>
<GetMessage xmlns="http://ParsGreen.com/">
<signature>string</signature>
<location>int</location>
<isRead>boolean</isRead>
</GetMessage>
</soap12:Body>
</soap12:Envelope>


RESPONSE
HTTP/1.1 200 OK
Content-Type: application/soap+xml; charset=utf-8
Content-Length: length


<?xml version="1.0" encoding="utf-8"?>
<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">
<soap12:Body>
<GetMessageResponse xmlns="http://ParsGreen.com/">
<GetMessageResult>
<xsd:schema>schema</xsd:schema>xml</GetMessageResult>
</GetMessageResponse>
</soap12:Body>
</soap12:Envelope>

[mazoolagh]

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

[mazoolagh]

برای تفسیر response و استخراج نتایج، یک نمونه از اون رو بررسی میکنیم.
پاسخ واقعی شامل 100 رکورد بوده که در اینجا فقط 2 رکورد اون رو پیوست میکنم و همین کافی هست.

<?xml version="1.0" encoding="utf-8"?>
<soap:Envelope xmlns:soap="http://www.w3.org/2003/05/soap-envelope"
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xmlns:xsd="http://www.w3.org/2001/XMLSchema">
<soap:Body>
<GetMessageResponse xmlns="http://ParsGreen.com/">
<GetMessageResult>
<xs:schema id="Msg"
xmlns=""
xmlns:xs="http://www.w3.org/2001/XMLSchema"
xmlns:msdata="urn:schemas-microsoft-com:xml-msdata">
<xs:element name="Msg"
msdata:IsDataSet="true"
msdata:UseCurrentLocale="true">
<xs:complexType>
<xs:choice minOccurs="0"
maxOccurs="unbounded">
<xs:element name="TBLMessages">
<xs:complexType>
<xs:sequence>
<xs:element name="MsgIdEncrypt"
type="xs:string"
minOccurs="0"/>
<xs:element name="Body"
type="xs:string"
minOccurs="0"/>
<xs:element name="Udh"
type="xs:string"
minOccurs="0"/>
<xs:element name="SendDate"
type="xs:dateTime"
minOccurs="0"/>
<xs:element name="Sender"
type="xs:string"
minOccurs="0"/>
<xs:element name="Receiver"
type="xs:string"
minOccurs="0"/>
<xs:element name="Parts"
type="xs:int"
minOccurs="0"/>
<xs:element name="IsFlash"
type="xs:boolean"
minOccurs="0"/>
<xs:element name="IsRead"
type="xs:boolean"
minOccurs="0"/>
<xs:element name="IsUnicode"
type="xs:boolean"
minOccurs="0"/>
<xs:element name="Credit"
type="xs:double"
minOccurs="0"/>
<xs:element name="RecCount"
type="xs:int"
minOccurs="0"/>
<xs:element name="RecFailed"
type="xs:int"
minOccurs="0"/>
<xs:element name="RecSuccess"
type="xs:int"
minOccurs="0"/>
</xs:sequence>
</xs:complexType>
</xs:element>
</xs:choice>
</xs:complexType>
</xs:element>
</xs:schema>
<diffgr:diffgram xmlns:msdata="urn:schemas-microsoft-com:xml-msdata"
xmlns:diffgr="urn:schemas-microsoft-com:xml-diffgram-v1">
<Msg xmlns="">
<TBLMessages diffgr:id="TBLMessages1"
msdata:rowOrder="0"
diffgr:hasChanges="inserted">
<MsgIdEncrypt>zixb67zjp3yhf3pe43u4ethrgr</MsgIdEncrypt>
<Body>10</Body>
<Udh/>
<SendDate>2021-05-01T11:33:32.92+04:30</SendDate>
<Sender>09363796940</Sender>
<Receiver>10002156713700</Receiver>
<Parts>1</Parts>
<IsFlash>false</IsFlash>
<IsRead>false</IsRead>
<IsUnicode>false</IsUnicode>
<Credit>0</Credit>
<RecCount>1</RecCount>
<RecFailed>0</RecFailed>
<RecSuccess>1</RecSuccess>
</TBLMessages>
<TBLMessages diffgr:id="TBLMessages2"
msdata:rowOrder="1"
diffgr:hasChanges="inserted">
<MsgIdEncrypt>5sp1ejkbh4x393pe43u4ethrgr</MsgIdEncrypt>
<Body>10</Body>
<Udh/>
<SendDate>2021-05-01T11:13:55.44+04:30</SendDate>
<Sender>09393092295</Sender>
<Receiver>10002156713700</Receiver>
<Parts>1</Parts>
<IsFlash>false</IsFlash>
<IsRead>false</IsRead>
<IsUnicode>false</IsUnicode>
<Credit>0</Credit>
<RecCount>1</RecCount>
<RecFailed>0</RecFailed>
<RecSuccess>1</RecSuccess>
</TBLMessages>
</Msg>
</diffgr:diffgram>
</GetMessageResult>
</GetMessageResponse>
</soap:Body>
</soap:Envelope>

[mazoolagh]

با کمی بررسی میبینیم که هر رکورد در یک node به اسم TBLMessages ذخیره شده،
و مجموعه اونها هم درون node به اسم Msg قرار داره.
به بخش schema مربوط به تعریف فیلدها و دیتا کاری نداریم چون از قبل یک جدول آماده کردیم.

روش کار به این صورت هست که:
1- گره Msg رو پیدا میکنیم
2- یک رکوردست از جدول Messages باز میکنیم
3- در یک حلقه، تک تک TBLMessages ها رو میخونیم
4- یک رکورد جدید در رکوردست میسازیم
5- یک حلقه دیگه میسازیم که تمام node های درون TBLMessages v رو میخونه و در فیلدهای متناظر در رکوردست میریزه و در پایان حلقه رکورد رو ذخیره میکنه

[mazoolagh]

Dim x As String
x = Replace(XM, "@SGN", Signature)
x = Replace(x, "@LOC", Location)
With New XMLHTTP60
.Open "POST", "https://login.parsgreen.com/Api/MsgService.asmx", False
.setRequestHeader "HOST", "login.parsgreen.com"
.setRequestHeader "CONTENT-TYPE", "application/soap+xml; charset=utf-8"
.setRequestHeader "SOAPAction", "http://ParsGreen.com/GetMessage"
.Send x
GetMessages.http_status = .Status
GetMessages.http_status_text = .statusText
If .Status = 200 Then
Dim doc As New DOMDocument60
doc.SetProperty "SelectionNamespaces", "xmlns:pg='http://ParsGreen.com/'"
doc.loadXML .responseText
Dim TBLMessages As MSXML2.IXMLDOMNode
Dim Node As MSXML2.IXMLDOMNode
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("Messages")
For Each TBLMessages In doc.selectSingleNode("//pg:GetMessageResponse/pg:GetMessageResult//Msg").childNodes
rs.AddNew
For Each Node In TBLMessages.childNodes
rs(Node.baseName) = Node.Text
Next
rs.Update
Next
rs.Close
Set rs = Nothing
End If
End With

[mazoolagh]

در واقع تمام موارد رو پیشتر هم داشتیم و عملا نکته جدیدی در این کد نیست!
تنها چیزی که باید بهش دقت کرد نوشتن کوئری جستجوی node ها هست.
کد زیر گره Msg رو پیدا میکنه:

doc.selectSingleNode("//pg:GetMessageResponse/pg:GetMessageResult//Msg")

و کد زیر مجموعه TBLMessages ها :

doc.selectSingleNode("//pg:GetMessageResponse/pg:GetMessageResult//Msg").childNodes

[mazoolagh]

برای اینکه بدونیم چرا اکسس بعنوان یک ابزار همیشه راه حل خوبی برای هر مسئله ای نیست، یک نمونه desktop application با visual studio برای مقایسه ساختم و نتیجه گیری رو به خواننده واگذار میکنم.

[mazoolagh]

بعد از ایجاد پروژه، پکیج پارس گرین رو به اون اضافه میکنیم:

153292

[mazoolagh]

یک باتن، یک datagridview و یک MsgService به فرم اضافه میکنیم:

153293

153294

[mazoolagh]

کد زیر رو به فرم اضافه میکنیم
Private Const Signature = "..."


Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Me.DataGridView1.DataSource = Me.MsgService1.GetMessage(Signature, 1, Nothing).Tables(0)
End Sub

و برنامه رو اجرا میکنیم:
153295

[mazoolagh]

تمام این کار در کمتر از 10 دقیقه و بدون هیچ نیازی به دونستن جزئیات وب سرویس و درگیری با کدهای xml و ... انجام شد.

[mohammadsaleh]

سلام با سپاس فراوان از زحماتی که می کشید و مطئمنم زمان زیادی رو وقت گذاشتید تا این کدها را آماده کنید ولی خدا را شکر ضمن کمک به اینجانب بی شک بر غنای این سایت افزوده اید. مطالبی که بی شک حتی در stack overflow هم به این قشنگی توضیح داده نشده باشه

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

[mohammadsaleh]

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




' location isread
'----------------------------------------------
' 1 : daryaft null : all message
' 2 : ersal true : is read
' 3 : hazf false : is not read
Public Const InboxXML = "<?xml version='1.0' encoding='utf-8'?>" & _
"<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'>" & _
"<soap12:Body>" & _
"<GetMessage xmlns='http://ParsGreen.com/'>" & _
"<signature>@SGN</signature>" & _
"<location>@loc</location>" & _
"<isRead>@RD</isRead>" & _
"</GetMessage>" & _
"</soap12:Body>" & _
"</soap12:Envelope>"





Public Type GetMessages
GetMessageResult As String
http_status As Integer
http_status_text As String
End Type




Public Function GetMessage(intLocation As Integer, blnRead As Boolean) As GetMessages


'Call ConnectToServer
'Call GetSettingFunc


Dim x As String
x = Replace(InboxXML, "@SGN", signature)
x = Replace(x, "@LOC", Location)
x = Replace(x, "@RD", isRead)
MsgBox x
With New XMLHTTP60
.Open "POST", "https://login.parsgreen.com/Api/MsgService.asmx", False
.setRequestHeader "HOST", "login.parsgreen.com"
.setRequestHeader "CONTENT-TYPE", "application/soap+xml; charset=utf-8"
.setRequestHeader "SOAPAction", "http://ParsGreen.com/GetMessage"
.send x


GetMessage.http_status = .status
GetMessage.http_status_text = .statusText
If .status = 200 Then
MsgBox "200"
Dim doc As New DOMDocument60
doc.SetProperty "SelectionNamespaces", "xmlns:pg='http://ParsGreen.com/'"
doc.loadXML .responseText
Dim TBLMessages As MSXML2.IXMLDOMNode
Dim Node As MSXML2.IXMLDOMNode
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("Messages")
For Each TBLMessages In doc.selectSingleNode("//pg:GetMessageResponse/pg:GetMessageResult//Msg").childNodes
rs.AddNew
For Each Node In TBLMessages.childNodes
rs(Node.baseName) = Node.Text
Next
rs.Update
Next
rs.Close
Set rs = Nothing
Else
MsgBox "not 200"
End If

End With
End Function




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

[mazoolagh]

سلام و روز خوش
کد پست 66 خام هست و باید چند مورد در اون گنجانده بشه،
بعنوان مثال تگ isread یا باید مقدارش True/false باشه یا اصلا نباید در Request باشه.

یک برنامه نمونه براتون میسازم که این موارد رو دربر بگیره.

[mazoolagh]

Option Compare Database
Option Explicit
Private Const WSURL = "https://login.parsgreen.com/Api/MsgService.asmx"
Private Const Signature = "..."
Private Const XM = "<?xml version='1.0' encoding='utf-8'?>" & _
"<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'>" & _
"<soap12:Body>" & _
"<GetMessage xmlns='http://ParsGreen.com/'>" & _
"<signature>@SGN</signature>" & _
"<location>@LOC</location>" & _
"@RD" & _
"</GetMessage>" & _
"</soap12:Body>" & _
"</soap12:Envelope>"


Public Enum Box
Inbox = 1
Outbox = 2
Deleted = 4
End Enum


Public Enum MessageStatus
All = 0
Read = 1
NotRead = 2
End Enum


Public Type GetMessageResponse
MessagesCount As Long
http_status As Integer
http_status_text As String
End Type


Public Function GetMessages(Location As Box, IsRead As MessageStatus) As GetMessageResponse
Dim x As String
x = Replace(XM, "@SGN", Signature)
x = Replace(x, "@LOC", Location)
Select Case IsRead
Case MessageStatus.All
x = Replace(x, "@RD", "")
Case MessageStatus.Read
x = Replace(x, "@RD", "<isRead>true</isRead>")
Case MessageStatus.NotRead
x = Replace(x, "@RD", "<isRead>false</isRead>")
End Select


With New XMLHTTP60
.Open "POST", "https://login.parsgreen.com/Api/MsgService.asmx", False
.setRequestHeader "HOST", "login.parsgreen.com"
.setRequestHeader "CONTENT-TYPE", "application/soap+xml; charset=utf-8"
.setRequestHeader "SOAPAction", "http://ParsGreen.com/GetMessage"
.Send x
GetMessages.http_status = .Status
GetMessages.http_status_text = .statusText
If .Status = 200 Then
Dim doc As New DOMDocument60
doc.SetProperty "SelectionNamespaces", "xmlns:pg='http://ParsGreen.com/'"
doc.loadXML .responseText
Dim Msg As MSXML2.IXMLDOMNode
Set Msg = doc.selectSingleNode("//pg:GetMessageResponse/pg:GetMessageResult//Msg")
If Msg Is Nothing Then
GetMessages.MessagesCount = 0
Else
GetMessages.MessagesCount = Msg.childNodes.length
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("Messages")
Dim TBLMessages As MSXML2.IXMLDOMNode
Dim Node As MSXML2.IXMLDOMNode
For Each TBLMessages In Msg.childNodes
rs.AddNew
For Each Node In TBLMessages.childNodes
rs(Node.baseName) = Node.Text
Next
rs.Update
Next
rs.Close
Set rs = Nothing
End If
End If
End With


End Function




153300

153301

[mazoolagh]

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

[mazoolagh]

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

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

[mohammadsaleh]

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