كود :
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