Function URLEncode(ByVal Text As String) As String
Dim i As Integer
Dim acode As Integer
Dim chr As String
Dim hexValue As String
Dim finalString As String
finalString = ""
For i = 1 To Len(Text) Step 1
acode = Asc(Mid$(Text, i, 1))
Select Case acode
Case 48 To 57, 65 To 90, 97 To 122
' don't touch alphanumeric chars
finalString = finalString & Mid$(Text, i, 1)
Case 32
' replace space with "+"
'Mid$(Text, i, 1) = "+"
finalString = finalString & "+"
Case Else
hexValue = Hex$(acode)
Select Case Len(hexValue)
Case 1
hexValue = "0" & hexValue
Case 2
'ok
Case Else
'carattere non valido
'skip
hexValue = ""
End Select
' replace punctuation chars with "%hex"
finalString = finalString & "%" & hexValue
End Select
Next
Return finalString
End Function
Function SendSMS(username As String, password As String, recipients() As String, Text As String, Optional charset As String = "") As String
Dim sender_error, url, method, parameters, msg As String
Dim xmlhttp As Object
xmlhttp = CreateObject("WinHttp.WinHttpRequest.5.1")
url = "https://www.smskdev.it/send.php"
parameters = "username=" & URLEncode(username) & "&" _
& "password=" & URLEncode(password) & "&" _
& "text=" & URLEncode(Text) & "&" _
& "to=" & Join(recipients, "&recipients[]=")
Select Case charset
Case "UTF-8"
parameters = parameters & "&charset=UTF-8"
Case Else
End Select
xmlhttp.open("POST", url, False)
xmlhttp.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
xmlhttp.setRequestHeader("Content-Length", Len(parameters))
xmlhttp.Send(parameters)
If xmlhttp.Status >= 400 And xmlhttp.Status <= 599 Then
SendSMS = "status=failed&message=" & xmlhttp.Status & " - " & xmlhttp.statusText
Exit Function
End If
msg = xmlhttp.responseText
xmlhttp = Nothing
SendSMS = msg
End Function
Function GetCredit(username As String, password As String, Optional charset As String = "") As String
Dim url, method, parameters, msg As String
Dim xmlhttp As Object
xmlhttp = CreateObject("WinHttp.WinHttpRequest.5.1")
url = "https://www.smskdev.it/credit.php"
parameters = "username=" & URLEncode(username) & "&" _
& "password=" & URLEncode(password)
xmlhttp.open("POST", url, False)
xmlhttp.setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
xmlhttp.setRequestHeader("Content-Length", Len(parameters))
xmlhttp.Send(parameters)
If xmlhttp.Status >= 400 And xmlhttp.Status <= 599 Then
GetCredit = "status=failed&message=" & xmlhttp.Status & " - " & xmlhttp.statusText
Exit Function
End If
msg = xmlhttp.responseText
xmlhttp = Nothing
GetCredit = msg
End Function
Private Sub Form_Load()
Dim recipients(0) As String
Dim i As Integer
' Invio singolo
recipients(0) = "39XXXXXXXXX"
' Per invio multiplo
' recipients(0) = "39XXXXXXXXX1"
' recipients(1) = "39XXXXXXXXX2"
' ------------ Invio SMS --------------
Dim result As String
result = SendSMS("username","password",recipients,"TESTO DEL MESSAGGIO","")
' ------------ LETTURA DEL CREDITO UTENTE -------------
' result = GetCredit("username", "password")
Dim responses As String()
responses = Split(result, "&")
Dim Response As String = ""
For Each Item In responses
Response = Response & Item & vbCrLf
Next
MsgBox(Response, vbOKOnly + vbInformation, "Result")
End Sub