ارسال رسالة sms الى الجوال

[ابوخليل]

المعمول به  والمتوفر الآن   هو  الارسال عبر بوابة مزود الخدمة

بمعنى ان الخدمة مدفوعة وليست مجانية

اي تشتري كمية من الرسائل ثم تعيد ارسالها

ويوجد الكثير من البوابات تقوم بتزويد الخدمة

نذكر منها عندنا مثلا لا على سبيل الحصر  : سعوديsms  ومملكة الرسائل  و موبايليوز

وتختلف كل واحدة عن الاخرى ببعض الاختلافات حسب اللغة البرمجية للموقع فالطريقة الاولى مثلا في البوابة الثانية والثالثة تفرض وجود الاداة InetCtls.Inet داخل الفورم  ويصاحبها مكتبة لتشغيل الاداة  وهي msinet.ocx يتم تسجيلها داخل ملفات النظام في وندوز ،  بينما الطريقة الثانية في البوابة الاولى يتم الارسال بدون هذه الاداة الوسيطة .

وحيث انه يوجد من تطرق للطريقة الاولى وقام بعرضها  في بعض منتديات اكسس الشقيقة ، لذا يطيب لي ان اعرض الطريقة الثانية مع الامثلة :

في البداية يلزم  الاشتراك في الموقع مقدم الخدمة

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

بعد الاشتراك تحصل على ثلاث رسائل مجانية للتجربة

رابط التسجيل : http://saudisms.net/p/method_register

يهمنا النتيجة المحصلة بعد التسجيل وهي :

1- اسم المستخدم

2- كلمة المرور

3- اسم المرسل

الآن يمكنك تجربة ارسال رسالة واحدة من الموقع الى جوال آخر للتأكد ورؤية بيانات الرسالة وكيف يظهر اسم المستخدم  والاحتفاظ بالرسالتين الاخريين لتجربتهما من خلال اكسس

بعض البوابات تشترط ان يكون في رصيدك اكثر من 50 رسالة حتى تتمكن من تغيير اسم المرسل

 

الآن جاء دور التطبيق وهو مثال  قام الموقع بعمله 

وانظر ايضا من الموقع نفسه لدعم المبرمج  http://saudisms.net/p/api

ومع اني املك امثلة اكثر تقدما لاكثر من بوابة الا ان هذا اقرب الى فهم المتعلم ويمكنه تطويره بنفسه .

الكودات الموجودة في المثال :

وحدات نمطية عامة لكشف الرصيد ولارسال الرسائل ولتحويل البيانات

Option Compare Database
Public Function UrlEncoding(str As String) As String
'  تحويل البيانات إلى تشفير الآسكي قبل إرسالها
    Dim strResult As String
    Dim i As Integer
        For i = 1 To Len(str)
        strResult = strResult + " " & Asc(Mid(str, i, 1))
    Next i
       UrlEncoding = strResult
End Function


Public Function GetCredits(strUserName As String, strUserPassword As String) As Integer
' للحصول على الرصيد
    On Error GoTo ErrHandler
    Dim intFinalResult As Integer
    Dim WinHttpReq As New WinHttpRequest
    Dim strResponseBody As String
    WinHttpReq.Open "GET", "http://saudisms.net/gw/Balance.php?userName=" & strUserName & "&userPassword=" & strUserPassword
    WinHttpReq.Send
    strResponseBody = WinHttpReq.ResponseText
    intFinalResult = CInt(Replace(Left(strResponseBody, 50), " ", ""))
    GetCredits = intFinalResult
    Exit Function
ErrHandler:
    MsgBox Err.Number & ": " & Err.Description, vbExclamation, "sms error"
End Function


Public Function SendSMS(strUserName As String, strUserPassword As String, strNumbers As String, strOriginator As String, strMessage As String) As String
' ارسال الرسالة
    On Error GoTo ErrHandler
    Dim intFinalResult As Integer
    Dim WinHttpReq As New WinHttpRequest
    Dim strResponseBody As String
    Dim strSendResult As String
    WinHttpReq.Open "GET", "http://saudisms.net/gw/?userName=" & strUserName & "&userPassword=" & strUserPassword & _
                           "&numbers=" & strNumbers & "&userSender=" & strOriginator & "&msg=" & strMessage & "&By=API"
    WinHttpReq.Send
    strResponseBody = WinHttpReq.ResponseText
    intFinalResult = Replace(Left(strResponseBody, 10), " ", "")
    
    Select Case intFinalResult
        Case 1: strSendResult = "SMS Sent Successfully."
        Case 1010: strSendResult = "Missing Data, Message content or Numbers."
        Case 1020: strSendResult = "Wrong Login Combination."
        Case 1030: strSendResult = "Same message with same destinations exist in queue, Wait 10 seconds befoure resending it."
        Case 1040: strSendResult = "Unrecognized Charset."
        Case 1050: strSendResult = "Msg Empty. Reason, message fileration remove message content."
        Case 1060: strSendResult = "Insufficient Credits to procces sending."
        Case 1070: strSendResult = "Your Credits is 0, Insufficient to procces sending."
        Case 1080: strSendResult = "Message Not Sent, Error Sending Message."
        Case 1090: strSendResult = "Repetition filter catch the message."
        Case 1100: strSendResult = "Sorry, Message Not Sent. Try later."
        Case 1110: strSendResult = "Sorry, Bad Originator (Sender Name) you used. Try another Originator."
        Case 1120: strSendResult = "Sorry,The country you are trying to send to is not covered by our network."
        Case 1130: strSendResult = "Sorry, Consult our network administrator regarding defiend netowrk for you account."
        Case 1140: strSendResult = "Sorry, You exceeded maximum messages parts. Try sending fewer parts."
    End Select
    
    SendSMS = intFinalResult
    
    Exit Function
ErrHandler:
    MsgBox Err.Number & ": " & Err.Description, vbExclamation, "sms error"
End Function

ثم نموذج وحيد ويشتمل على اكواد لتطبيق الوحدات النمطية اعلاه

Private Sub cmdGetCredits_Click()
    'اظهار الرصيد
    On Error GoTo ErrHandler
    Dim strUserName As String, strUserPassword As String
  
    strUserName = UrlEncoding(txtUserName)
    strUserPassword = UrlEncoding(txtUserPassword)
    
    txtCredits = GetCredits(strUserName, strUserPassword)
        
    Exit Sub
ErrHandler:
    MsgBox Err.Number & ": " & Err.Description, vbExclamation, "sms error"
End Sub


Private Sub cmdSendSMS_Click()
   
    On Error GoTo ErrHandler
    Dim strUserName As String, strUserPassword As String
    Dim strNumbers As String
    Dim strOriginator As String
    Dim strMessage As String
    
    strUserName = UrlEncoding(txtUserName)
    strUserPassword = UrlEncoding(txtUserPassword)
    strNumbers = UrlEncoding(txtNumbers)
    strOriginator = UrlEncoding(txtOriginator)
    strMessage = UrlEncoding(txtMessage)
     'ارسال
    txtSendingResult = SendSMS(strUserName, strUserPassword, strNumbers, strOriginator, strMessage)
    
    Call cmdGetCredits_Click
        
    Exit Sub
ErrHandler:
    MsgBox Err.Number & ": " & Err.Description, vbExclamation, "sms error"
End Sub


Private Sub Form_Load()
    DoCmd.Restore
End Sub

ملحوظة :

رغم ان المثال يحتوي على الجمل البرمجيه اعلاه  الا ان البيانات المكتوبة غالبا تبقى خلافا للمرفقات التي قد تعتريها العوارض .

saudisms2.rar

[محمد السباعي]

جزاك الله خير 

لسه من يومين كنت بفكر في الموضوع ده

[سمير1]

بارك الله فيك

 

ان شاء الله اقوم بالتجربة

[محمدعوض]

طيب هل ممكن التسجيل غير بلد مثلا متل لبنان

[ابوخليل]

لم لا تجرب ...

لن تخسر شيئاً ...

[خليل خليل داماس]

جهد جبّار
موفق من رب العالمين