Тема: VBScript: отправка SMS на номера Beeline
Скрипт запрашивает номер телефона и текст сообщения через InputBox, а затем отправляет сообщение, посылая запрос к серверному скрипту на beonline.ru.
'/// Скрипт бесплатной отправки SMS сообщений на номера Beeline
'К сожалению как и всего бесплатного так и у этого скрипта есть ограничения
'1) Отправлять СМС можно только на номера Beeline
'2) Количество отправляемых сообщений с одного IP ограничено
'3) Плюс часто приходит ответ о том, что система перегружена. В этом случае повторите отправку ещё раз.
Dim Operators(8)
Operators(0) = "777 - K-Mobile (Казахстан)"
Operators(1) = "095 - Beeline Damps (Россия)"
Operators(2) = "901 - Beeline Damps (Россия)"
Operators(3) = "903 - Beeline GSM (Россия)"
Operators(4) = "905 - Beeline GSM (Россия)"
Operators(5) = "906 - Beeline GSM (Россия)"
Operators(6) = "909 - Beeline GSM (Россия)"
Operators(7) = "960 - Beeline GSM (Россия)"
Operators(8) = "961 - Beeline GSM (Россия)"
Dim phone,message
phone = InputBox("Введите номер на который хотите произвести отправку сообщения." & vbCrlf & vbCrlf & "Доступные операторы:" & vbCrlf & vbCrlf & Join(Operators,vbCrlf),"Отправка смс сообщения на номера Beeline","890")
message = InputBox("Введите текст сообщения.","Отправка смс сообщения на номера Beeline","Сообщение")
Dim Status
Status = SendBeelineSMS(phone,message,1)
If Err.Number = 0 Then
Msgbox Status,vbInformation
Else
MsgBox Err.Number & " " & Err.Description,vbCritical
End if
Function SendBeelineSMS(phone,Message,translit)
On Error Resume Next
Dim operator, VarBody, XMLHTTP
If Len(phone) <> 11 Then
Err.Number = vbObjectError + 1
Err.Description = "Недопустимая длина номера. Номер должен быть формата 890XXXXXXXX"
Exit Function
End If
operator = Mid(phone, 2, 3)
Dim AvailableOperators
AvailableOperators = "777,095,901,903,905,906,909,960,961"
if Instr(1,AvailableOperators,operator) = 0 Then
Err.Number = vbObjectError + 2
Err.Description = "Недопустимый (" & operator & ") оператор."
Exit Function
End if
phone = Mid(phone, 5)
if translit <> "" then translit="1"
VarBody = "number_sms=number_sms_send&adv_year=&termtype=G&translit=" & translit & "&y=4&x=5&prf=7" & operator & "&phone=" & phone & "&message=" & EncodeURIcomponent(message) & "&submit=" & EncodeURIcomponent("Отправить")
Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
XMLHTTP.open "POST", "http://217.118.84.204/servlet/send/sms/", False
XMLHTTP.SetRequestHeader "Content-type", "application/x-www-form-urlencoded"
XMLHTTP.Send VarBody
Select Case XMLHTTP.Status
Case 200
SendBeelineSMS = XMLHTTP.responsetext
Case Else
Err.Number = vbObjectError + 3
Err.Description = "Ошибка при отправке запроса: " & XMLHTTP.Status & " " & XMLHTTP.StatusText & vbCrLf
Exit Function
End Select
End Function
Function EncodeURIcomponent(SourceString)
Dim I, C, Out
For I = 1 To Len(SourceString)
C = Asc(Mid(SourceString, I, 1))
If C = 32 Then
EncodeURIcomponent = EncodeURIcomponent + "+"
ElseIf (C < 48 Or C > 126) Or (C > 56 And C <= 64) Then
EncodeURIcomponent = EncodeURIcomponent + "%" + Hex(C)
Else
EncodeURIcomponent = EncodeURIcomponent + Chr(C)
End If
Next
End Function
Автор скрипта - Xameleon.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.