سلام خدمت اساتید و دوستان عزیز به ویژه جناب 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
