[VB.NET] ارسال رسائل نصية للجوال عبر شركة SSMS

PHP كود :

Public Class Form1


    'إرسال رسالة
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        'NUMBERS , إذا كان أكثر من رقم يجب أن تفصل بينهم بفاصلة
        SendMessage("USER", "PASSWORD", "MESSAGE", "NUMBERS", "SENDER")
    End Sub


    'الاستعلام عن الرصيد
    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        GetBalance("USER", "PASSWORD")
    End Sub


    'التأكد من نوع الرسالة
    Private Function isArabic(ByVal val1 As String) As Boolean
        Dim str As String = "دجحخهعغفقثصضطكمنتالبيسشظزوةىلارؤءئإلإألأآلآ"
        Dim i As Integer
        For i = 0 To val1.Length - 1
            If (str.IndexOf(val1.Substring(i, 1)) <> -1) Then
                Return True
            End If
        Next i
        Return False
    End Function


    'إرسال الرسالة
    Private Sub SendMessage(ByVal user As String, ByVal password As String, ByVal message As String, ByVal numbers As String, ByVal sender As String)
        Try
            Dim lang As String = If(isArabic(message), "ar", "en")
            Dim params As String =
                String.Format("?user={0}&password={1}&numbers={2}&sender={3}&message={4}&lang={5}", user, password, numbers, sender, message, lang)
            ShowResult(New Net.WebClient().DownloadString("http://ssms.ws/sendsms.php" & params))
        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Critical + MsgBoxStyle.MsgBoxRight + MsgBoxStyle.MsgBoxRtlReading)
        End Try
    End Sub


    'معرفة الرصيد
    Private Sub GetBalance(ByVal user As String, ByVal password As String)
        Try
            Dim params As String = String.Format("?user={0}&password={1}", user, password)
            Dim res As String = New Net.WebClient().DownloadString("http://ssms.ws/sendsms.php" & params)
            ShowResult(res)
        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Critical + MsgBoxStyle.MsgBoxRight + MsgBoxStyle.MsgBoxRtlReading)
        End Try
    End Sub


    'اظهار رسالة الخطأ
    Private Sub ShowResult(ByVal res As String)
        Dim msg As String = String.Empty
        Select Case res
            Case 1
                msg = "تم الإرسال بنجاح"
            Case 0
                msg = "خطأ في الإرسال"
            Case "Invalid login"
                msg = "خطأ في بيانات الدخول"
            Case "Missing or Empty Field"
                msg = "توجد قيمة خاطئة في إحدى الحقول , أو هناك حقل فارغ"
            Case "Insufficent Balance"
                msg = "رصيدك لايكفي لإتمام عملية الإرسال"
            Case "Invalid Sender"
                msg = "خطأ في اسم المرسل , اسم المرسل لابد أن يتكون من حروف انجليزية وأرقام"
            Case "Sender name is not activated"
                msg = "اسم المرسل غير مفعل"
            Case "Invalid Message Language"
                msg = "لغة الرسالة مخالفة عن القيمة المذكورة في متغير " & vbNewLine & "Lang"
        End Select
        If msg = "" Then
            MsgBox(msg, MsgBoxStyle.MsgBoxRight + MsgBoxStyle.MsgBoxRtlReading)
        Else
            MsgBox(msg, MsgBoxStyle.Critical + MsgBoxStyle.MsgBoxRight + MsgBoxStyle.MsgBoxRtlReading)
        End If
    End Sub


End Class 

كود :

Imports System.Net



Imports System.Text

Imports System.IO



Public Class SendSMS

    '****************************************************

    '* set the username Parameter

    '****************************************************

    Dim UserName As String = ""



    '****************************************************

    '* set the password Parameter

    '****************************************************

    Dim PassWord As String = ""





    '***************************************************



    Private Sub CmdClose_Click(sender As System.Object, e As System.EventArgs) Handles CmdClose.Click

        Me.Close()



    End Sub



    Private Sub CmdSend_Click(sender As System.Object, e As System.EventArgs) Handles CmdSend.Click

       



        If (cmbSender.Text = "") Then

            MessageBox.Show("يجب اختيار اسم المرسل", " ", MessageBoxButtons.OK, MessageBoxIcon.Hand, MessageBoxDefaultButton.Button1, MessageBoxOptions.RightAlign)

            Exit Sub

        End If

        '**************************************************

        '***  To Replace Any Separated Character With Comma

        '**************************************************

        Dim tmpNumbers As String = txtMobile.Text

        If tmpNumbers.Contains(vbLf) Then

            tmpNumbers = Replace(tmpNumbers, vbLf, ",", , , CompareMethod.Text)

        End If

        If tmpNumbers.Contains(vbTab) Then

            tmpNumbers = Replace(tmpNumbers, vbTab, ",", , , CompareMethod.Text)

        ElseIf tmpNumbers.Contains(" ") Then

            tmpNumbers = Replace(tmpNumbers, " ", ",", , , CompareMethod.Text)

        ElseIf tmpNumbers.Contains(";") Then

            tmpNumbers = Replace(tmpNumbers, ";", ",", , , CompareMethod.Text)

        ElseIf tmpNumbers.Contains("-") Then

            tmpNumbers = Replace(tmpNumbers, "-", ",", , , CompareMethod.Text)

        End If

        '*****************************************

        '* User Parameters

        '*****************************************

        Dim sendername As String = cmbSender.Text

        Dim tmpMsg As String = txtMessage.Text

        Dim tmpUniCode = isArabic(tmpMsg)

        Dim tmpDateTime As String = ""

        '******************************

        '* tmpDateTime = Today.Year.ToString() + "-" + Today.Month.ToString() + "-" + Today.Day.ToString() + " " + Today.TimeOfDay.ToString.Substring(0, 5)   

        '*****************************

        SendSMS(UserName, PassWord, sendername, tmpNumbers, tmpMsg, tmpUniCode, tmpDateTime)



    End Sub

    Public Function isArabic(ByVal val As String) As String



        Dim i As Integer

        Dim strg As String

        strg = "إلإدجحخهعغفقثصضطكمنتالبيسشظزوةىلارؤءئآلآ"

        isArabic = "E"



        For i = 1 To Len(val)

            If InStr(1, strg, Mid(val, i, 1), vbTextCompare) <> 0 Then

                isArabic = "U"

                Exit For

            End If

        Next i





    End Function

  

    Function SendSMS(ByVal tmpUserName As String, ByVal tmpPassword As String, ByVal tmpSender As String, ByVal tmpNubmers As String, ByVal tmpMsg As String, ByVal tmpUniCode As String, ByVal tmpDateTime As String) As String

        Try

            Dim writer As StreamWriter

            Dim SMSTxt As String = tmpMsg

            If tmpUniCode = "U" Then SMSTxt = ToUnicode(tmpMsg)

           



            Dim queryStr As String = String.Concat(New String() {"return=xml&username=", tmpUserName, "&password=", tmpPassword, "&unicode=", tmpUniCode, "&message=", SMSTxt, "&sender=", tmpSender, "&numbers=", tmpNubmers, "&datetime=", tmpDateTime})



            Dim tmpURL As String = "http://www.oursms.net/api/sendsms.php"

            Dim request As HttpWebRequest = DirectCast(WebRequest.Create(tmpURL), HttpWebRequest)

            request.Method = "POST"

            request.ContentLength = Encoding.UTF8.GetByteCount(queryStr)

            request.ContentType = "application/x-www-form-urlencoded"

            writer = New StreamWriter(request.GetRequestStream)

            writer.Write(queryStr)

            writer.Close()

            Dim response As HttpWebResponse = DirectCast(request.GetResponse, HttpWebResponse)

            Dim reader As StreamReader = Nothing

            reader = New StreamReader(response.GetResponseStream)

            Dim myds As New DataSet

            myds.ReadXml(reader)

            'Dim i As Integer

            Dim arow As DataRow

            arow = myds.Tables(0).Rows(0)

            Dim resultno = arow(0).ToString.Trim

            Dim resultmsg = arow(1).ToString.Trim

            Return resultmsg

        Catch ex As Exception

            Return (ex.Message & ChrW(10) & "لم يتم الاتصال بالانترنت ")

        End Try

    End Function

    Private Function ToUnicode(ByVal msg As String) As String

        Dim str As String = String.Empty

        Dim i As Integer

        For i = 0 To msg.Length - 1

            str = (str & ToChar(Convert.ToChar(msg.Substring(i, 1))))

        Next i

        Return str

    End Function

    Private Function ToChar(ByVal ch As Char) As String

        Dim bytes As Byte() = New UnicodeEncoding().GetBytes(Convert.ToString(ch))

        Return ToHexaDecimal((bytes(1) & bytes(0).ToString("X")))

    End Function

    Private Function ToHexaDecimal(ByVal msg As String) As String

        Dim str As String = String.Empty

        Select Case msg.Length

            Case 1

                Return ("000" & msg)

            Case 2

                Return ("00" & msg)

            Case 3

                Return ("0" & msg)

            Case 4

                Return msg

        End Select

        Return str

    End Function



    Private Sub txtMessage_TextChanged(sender As System.Object, e As System.EventArgs) Handles txtMessage.TextChanged

        lblMsgLength.Text = txtMessage.TextLength.ToString

        If isArabic(txtMessage.Text) = "U" Then

            lblMsgCount.Text = getMsgCount(txtMessage.Text.Length, True)

        Else

            lblMsgCount.Text = getMsgCount(txtMessage.Text.Length, False)

        End If

    End Sub

    Function getMsgCount(ByVal msglength As Long, ByVal flgArabic As Boolean) As Integer

        Dim msgcount As Integer

        If flgArabic Then

            msgcount = 0

            If ((msglength > 0) AndAlso (msglength <= 70)) Then

                msgcount = 1

            ElseIf ((msglength > 70) AndAlso (msglength <= 134)) Then

                msgcount = 2

            ElseIf ((msglength > 134) AndAlso (msglength <= 201)) Then

                msgcount = 3

            ElseIf ((msglength > 201) AndAlso (msglength <= 268)) Then

                msgcount = 4

            ElseIf ((msglength > 268) AndAlso (msglength <= 335)) Then

                msgcount = 5

            ElseIf ((msglength > 335) AndAlso (msglength <= 402)) Then

                msgcount = 6

            End If



        Else

            msgcount = 0

            If ((msglength > 0) AndAlso (msglength <= 160)) Then

                msgcount = 1

            ElseIf ((msglength > 160) AndAlso (msglength <= 268)) Then

                msgcount = 2

            ElseIf ((msglength > 268) AndAlso (msglength <= 402)) Then

                msgcount = 3

            ElseIf ((msglength > 402) AndAlso (msglength <= 536)) Then

                msgcount = 4

            ElseIf ((msglength > 536) AndAlso (msglength <= 670)) Then

                msgcount = 5

            ElseIf ((msglength > 670) AndAlso (msglength <= 804)) Then

                msgcount = 6

            End If



        End If

        Return msgcount





    End Function



    Private Sub SendSMS_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load

        lblBalance.Text = GetBalance()

        GetSenders()

    End Sub

    Public Function GetBalance() As String

        Dim tmpBalance As String = "0"

        Dim requestUriString As String = String.Concat(New String() {"http://www.oursms.net/api/getbalance.php?username=", UserName, "&password=", PassWord})

        Try

            Dim request As HttpWebRequest = DirectCast(WebRequest.Create(requestUriString), HttpWebRequest)

            Dim response As HttpWebResponse = DirectCast(request.GetResponse, HttpWebResponse)

            Dim reader As New StreamReader(response.GetResponseStream)

            tmpBalance = reader.ReadToEnd.ToString

            reader.Close()

            response.Close()

            Select Case tmpBalance

                Case "101"

                    tmpBalance = "اسم مستخدم أو كلمة مرور خطأ"

            End Select

            Return tmpBalance

        Catch exception As Exception

            MessageBox.Show((exception.Message & ChrW(13) & ChrW(10) & "ربما تم فقد الاتصال باالنت او ان السيرفر قيد الصيانة"), " ", MessageBoxButtons.OK, MessageBoxIcon.Hand, MessageBoxDefaultButton.Button1, MessageBoxOptions.RightAlign)

        End Try



    End Function

    Public Function GetSenders()

        Dim requestUriString As String = String.Concat(New String() {"http://www.oursms.net/apoursmsSpial/GetAllSenders.php?return=xml&username=", UserName, "&password=", PassWord})

        Try

            Dim request As HttpWebRequest = DirectCast(WebRequest.Create(requestUriString), HttpWebRequest)

            Dim response As HttpWebResponse = DirectCast(request.GetResponse, HttpWebResponse)

            Dim reader As New StreamReader(response.GetResponseStream)

            Dim reader2 As New StringReader(reader.ReadToEnd.Trim)

            reader.Close()

            response.Close()

            Dim myds As New DataSet

            myds.ReadXml(reader2)

            Dim tablesndr As DataTable

            tablesndr = myds.Tables(1)

            reader2.Close()

            Dim aRow As DataRow

            For i = 0 To tablesndr.Rows.Count - 1

                Try

                    aRow = tablesndr.Rows(i)

                    '*senderID = aRow(1)

                    '*senderState = aRow(3)

                    '*senderActiveState = aRow(4)

                    '*senderISDefult = aRow(5)

                    cmbSender.Items.Add(aRow(6))

                Catch ex As Exception

                End Try



            Next

        Catch exception As Exception

            MessageBox.Show((exception.Message & ChrW(13) & ChrW(10) & "ربما تم فقد الاتصال باالنت او ان السيرفر قيد الصيانة"), " ", MessageBoxButtons.OK, MessageBoxIcon.Hand, MessageBoxDefaultButton.Button1, MessageBoxOptions.RightAlign)

        End Try

    End Function

End Class