Indice
- Wiki
- API SEMPLIFICATE
- Utilità
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