User Tools

Site Tools


api_esempio_vb6

Differences

This shows you the differences between two versions of the page.

Link to this comparison view

api_esempio_vb6 [2020/08/01 23:02]
api_esempio_vb6 [2023/12/29 14:29] (current)
Line 1: Line 1:
 +====== Chiamata VB6 ====== 
 +==== Esempio API ==== 
 +<code> 
 +    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  
 +</code>
api_esempio_vb6.txt · Last modified: 2023/12/29 14:29 (external edit)