Chiamata VB6

Esempio API

    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