Option Explicit
'Alexey Spirin (Alexey@VBRussian.com)

'Программа для отправки SMS абонентам МТС Московского региона
'через сайт http://www.mts.ru с возможность отправки сообщений
'длиной до до 730 символов (вместо позволенных 160 на сайте)

'Объявляем API функции
'Для открытия соединения и получения его дескриптора
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
'Для убивания дескриптора
Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer
'Для обращения к URL
Private Declare Function InternetOpenUrl Lib "wininet" _
       Alias "InternetOpenUrlA" _
       (ByVal hInternetSession As Long, _
       ByVal lpszUrl As String, _
       ByVal lpszHeaders As String, _
       ByVal dwHeadersLength As Long, _
       ByVal dwFlags As Long, _
       ByVal dwContext As Long) As Long

Private Sub cmdSend_Click()

  Dim a As Long, b As Variant, Prefix As String, Message As String

  'Делаем нужный префикс

  Select Case cboPrefix.ListIndex
   Case 0
     Prefix = "7095"
   Case 1
     Prefix = "7910"
   Case 2
     Prefix = "7916"
  End Select

  'Переделываем сообщение в такой формат, котоырй необходим для отправки,
  'т.е. избавляемся от нежелательных в URL символов

  Message = txtMessage
  Message = Replace(Message, "%", "%25")
  Message = Replace(Message, "?", "%3F")
  Message = Replace(Message, "&", "%26")
  Message = Replace(Message, vbCrLf, "%0D")

  'создаем соединение и получаем его дескриптор
  a = InternetOpen("Microsoft Internet Explorer 5.0", 0, vbNullString, vbNullString, 0)
  'обращаемся к сценарию с заданными параметрами
  b = InternetOpenUrl(a, "http://www.mts.ru:5051/cgi-bin/cgi.exe?function=sms_send&MMObjectType=0&MMObjectID=&To=" & Prefix & txtNumber & "&Msg=" & Message & "&Hour=23&Min=59&Day=31&Mon=12&Year=2005&Lang=2", vbNullString, 0, 0, 0)
  'закрываем соединение
  InternetCloseHandle a

  'отключаем кнопку отправки и включаем таймер, чтобы затем ее включить опять
  'делается это из-за того, что можно посылат сообщения не чаще 1 раза в минуту
  Timer1.Enabled = True
  cmdSend.Enabled = False

  MsgBox "Done!", vbInformation

  'чистим поля и вохвращаем фокус
  txtNumber = ""
  txtMessage = ""
  cboPrefix.SetFocus

End Sub

Private Sub Form_Load()
  cboPrefix.ListIndex = 2
End Sub

Private Sub Timer1_Timer()
  cmdSend.Enabled = True
  Timer1.Enabled = False
End Sub

Private Sub txtMessage_Change()
  Label3 = "Осталось: " & 730 - Len(txtMessage)
End Sub