Source Code for Me (s-c.me)

Code's Tags

- VisualBasic
Your Codes

None
Reffers

- http://www.smspilot.ru/faq.php
- http://smspilot.ru/faq.php
Linked Codes

- 25921. // Simple but unreliable funct
- 24752. Sub Кнопка1_Щелчок() If SM
- 24751. Sub Êíîïêà1_Ùåë÷îê() If SMS
- 24642. <?php // скрипт send.php массо
- 24612. for ($i = 0; $i < 10; $i++) e
- 24611. /* human_time_diff Вывод р
- 24060. <?php // скрипт send.php массо
- 23911. // sockets version HTTP/POST f
- 23910. // sockets version HTTP/POST f
- 22947. <?php // sockets version HTTP

Code:

' Процедура для демонстрации использования
Sub Кнопка1_Щелчок()

If SMS("79087964781", "Привет") Then MsgBox ("Сообщение отправлено") Else MsgBox SMSError()
  
End Sub

' Собственнно функция для отправки SMS http://www.smspilot.ru/apikey.php
Public Function SMS(Phone As String, Text As String) As Boolean

SMS = False
 
 Set HttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
 
 URL = "http://smspilot.ru/api.php"
 URL = URL & "?send=" & URLEncode(Text)
 URL = URL & "&to=" & Phone
 
 ' Своя подпись
 ' URL = URL & "&from=smspilot"
 
 ' (!) Замените на свой API-ключ
 URL = URL & "&apikey=XXXXXXXXXXXXYYYYYYYYYYYYZZZZZZZZXXXXXXXXXXXXYYYYYYYYYYYYZZZZZZZZ"
 
 URL = URL & "&charset=windows-1251"
 
 If HttpReq.Open("GET", URL, False) <> 0 Then
 SMSError ("Connection error")
 Exit Function
 End If
 If HttpReq.Send() <> 0 Then
 SMSError ("Open URL " & URL & " error")
 Exit Function
 End If

If Left$(HttpReq.responseText, 7) <> "SUCCESS" Then
 SMSError (HttpReq.responseText)
 Exit Function
 End If
 
 SMS = True
 SMSError ("")
 
End Function

' Функция для хранения последней ошибки
Public Function SMSError(Optional SetErr As String = "") As String
 Static Err
 If SetErr <> "" Then Err = SetErr
 SMSError = Err
End Function

' Кодирование URL параметров http://ru.wikipedia.org/wiki/URL
Public Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String

Dim StringLen As Long: StringLen = Len(StringVal)

If StringLen > 0 Then
    ReDim result(StringLen) As String
    Dim i As Long, CharCode As Integer
    Dim Char As String, Space As String

If SpaceAsPlus Then Space = "+" Else Space = "%20"

For i = 1 To StringLen
      Char = Mid$(StringVal, i, 1)
      CharCode = Asc(Char)
      Select Case CharCode
        Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
          result(i) = Char
        Case 32
          result(i) = Space
        Case 0 To 15
          result(i) = "%0" & Hex(CharCode)
        Case Else
          result(i) = "%" & Hex(CharCode)
      End Select
    Next i
    URLEncode = Join(result, "")
  End If
End Function

Copy to clipboard (IE,FF)

As HTMLAs CSS Selected Language:
Show Linenumbers:

Short link for Twitter:

HTML:

<blockquote><code><a href="http://s-c.me/24753/s">Copy&nbsp;Source</a>&nbsp;|&nbsp;<a href="http://s-c.me/24753/h">Copy&nbsp;HTML</a><ol>
<li>'&nbsp;Процедура&nbsp;для&nbsp;демонстрации&nbsp;использования</li>
<li>Sub Кнопка1_Щелчок()</li>

<li>&nbsp;&nbsp;If SMS("79087964781", "Привет") Then MsgBox ("Сообщение&nbsp;отправлено") Else MsgBox SMSError()</li>

<li>'&nbsp;Собственнно&nbsp;функция&nbsp;для&nbsp;отправки&nbsp;SMS&nbsp;http://www.smspilot.ru/apikey.php</li>
<li>Public Function SMS(Phone As String, Text As String) As Boolean</li>

<li>&nbsp;&nbsp;SMS = False</li>

<li>&nbsp;&nbsp;Set HttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")</li>

<li>&nbsp;&nbsp;URL = "http://smspilot.ru/api.php"</li>
<li>&nbsp;&nbsp;URL = URL &amp; "?send=" &amp; URLEncode(Text)</li>
<li>&nbsp;&nbsp;URL = URL &amp; "&amp;to=" &amp; Phone</li>

<li>&nbsp;&nbsp;'&nbsp;Своя&nbsp;подпись</li>
<li>&nbsp;&nbsp;'&nbsp;URL&nbsp;=&nbsp;URL&nbsp;&amp;&nbsp;"&amp;from=smspilot"</li>

<li>&nbsp;&nbsp;'&nbsp;(!)&nbsp;Замените&nbsp;на&nbsp;свой&nbsp;API-ключ</li>
<li>&nbsp;&nbsp;URL = URL &amp; "&amp;apikey=XXXXXXXXXXXXYYYYYYYYYYYYZZZZZZZZXXXXXXXXXXXXYYYYYYYYYYYYZZZZZZZZ"</li>

<li>&nbsp;&nbsp;URL = URL &amp; "&amp;charset=windows-1251"</li>

<li>&nbsp;&nbsp;If HttpReq.Open("GET", URL, False) &lt;&gt; 0 Then</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;SMSError ("Connection&nbsp;error")</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;Exit Function</li>
<li>&nbsp;&nbsp;End If</li>
<li>&nbsp;&nbsp;If HttpReq.Send() &lt;&gt; 0 Then</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;SMSError ("Open&nbsp;URL&nbsp;" &amp; URL &amp; "&nbsp;error")</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;Exit Function</li>
<li>&nbsp;&nbsp;End If</li>

<li>&nbsp;&nbsp;If Left$(HttpReq.responseText, 7) &lt;&gt; "SUCCESS" Then</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;SMSError (HttpReq.responseText)</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;Exit Function</li>
<li>&nbsp;&nbsp;End If</li>

<li>&nbsp;&nbsp;SMS = True</li>
<li>&nbsp;&nbsp;SMSError ("")</li>

<li>End Function</li>

<li>'&nbsp;Функция&nbsp;для&nbsp;хранения&nbsp;последней&nbsp;ошибки</li>
<li>Public Function SMSError(Optional SetErr As String = "") As String</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;Static Err</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;If SetErr &lt;&gt; "" Then Err = SetErr</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;SMSError = Err</li>
<li>End Function</li>

<li>'&nbsp;Кодирование&nbsp;URL&nbsp;параметров&nbsp;http://ru.wikipedia.org/wiki/URL</li>
<li>Public Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String</li>

<li>&nbsp;&nbsp;Dim StringLen As Long: StringLen = Len(StringVal)</li>

<li>&nbsp;&nbsp;If StringLen &gt; 0 Then</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;ReDim result(StringLen) As String</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;Dim i As Long, CharCode As Integer</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;Dim Char As String, Space As String</li>

<li>&nbsp;&nbsp;&nbsp;&nbsp;If SpaceAsPlus Then Space = "+" Else Space = "%20"</li>

<li>&nbsp;&nbsp;&nbsp;&nbsp;For i = 1 To StringLen</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Char = Mid$(StringVal, i, 1)</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;CharCode = Asc(Char)</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Select Case CharCode</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;result(i) = Char</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Case 32</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;result(i) = Space</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Case 0 To 15</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;result(i) = "%0" &amp; Hex(CharCode)</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Case Else</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;result(i) = "%" &amp; Hex(CharCode)</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;End Select</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;Next i</li>
<li>&nbsp;&nbsp;&nbsp;&nbsp;URLEncode = Join(result, "")</li>
<li>&nbsp;&nbsp;End If</li>
<li>End Function </li>
</ol></code></blockquote>

Copy to clipboard (IE,FF)

HTML view:

Copy Source | Copy HTML ' Процедура для демонстрации использования Sub Кнопка1_Щелчок() If SMS("79087964781", "Привет") Then MsgBox ("Сообщение отправлено") Else MsgBox SMSError() End Sub ' Собственнно функция для отправки SMS http://www.smspilot.ru/apikey.php Public Function SMS(Phone As String, Text As String) As Boolean SMS = False Set HttpReq = CreateObject("WinHttp.WinHttpRequest.5.1") URL = "http://smspilot.ru/api.php" URL = URL & "?send=" & URLEncode(Text) URL = URL & "&to=" & Phone ' Своя подпись ' URL = URL & "&from=smspilot" ' (!) Замените на свой API-ключ URL = URL & "&apikey=XXXXXXXXXXXXYYYYYYYYYYYYZZZZZZZZXXXXXXXXXXXXYYYYYYYYYYYYZZZZZZZZ" URL = URL & "&charset=windows-1251" If HttpReq.Open("GET", URL, False) <> 0 Then SMSError ("Connection error") Exit Function End If If HttpReq.Send() <> 0 Then SMSError ("Open URL " & URL & " error") Exit Function End If If Left$(HttpReq.responseText, 7) <> "SUCCESS" Then SMSError (HttpReq.responseText) Exit Function End If SMS = True SMSError ("") End Function ' Функция для хранения последней ошибки Public Function SMSError(Optional SetErr As String = "") As String Static Err If SetErr <> "" Then Err = SetErr SMSError = Err End Function ' Кодирование URL параметров http://ru.wikipedia.org/wiki/URL Public Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String Dim StringLen As Long: StringLen = Len(StringVal) If StringLen > 0 Then ReDim result(StringLen) As String Dim i As Long, CharCode As Integer Dim Char As String, Space As String If SpaceAsPlus Then Space = "+" Else Space = "%20" For i = 1 To StringLen Char = Mid$(StringVal, i, 1) CharCode = Asc(Char) Select Case CharCode Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126 result(i) = Char Case 32 result(i) = Space Case 0 To 15 result(i) = "%0" & Hex(CharCode) Case Else result(i) = "%" & Hex(CharCode) End Select Next i URLEncode = Join(result, "") End If End Function

Source Code for Me (s-c.me)

Code's Tags

Your Codes

Reffers

Linked Codes