This shows you the differences between two versions of the page.
|
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 ==== | ||
| + | < | ||
| + | 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, | ||
| + | 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 " | ||
| + | ' | ||
| + | finalString = finalString & " | ||
| + | Case Else | ||
| + | hexValue = Hex$(acode) | ||
| + | Select Case Len(hexValue) | ||
| + | Case 1 | ||
| + | hexValue = " | ||
| + | Case 2 | ||
| + | 'ok | ||
| + | Case Else | ||
| + | ' | ||
| + | ' | ||
| + | hexValue = "" | ||
| + | End Select | ||
| + | ' replace punctuation chars with " | ||
| + | finalString = finalString & " | ||
| + | |||
| + | |||
| + | 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 = "" | ||
| + | Dim sender_error, | ||
| + | |||
| + | Dim xmlhttp As Object | ||
| + | xmlhttp = CreateObject(" | ||
| + | |||
| + | |||
| + | url = " | ||
| + | |||
| + | |||
| + | parameters = " | ||
| + | & " | ||
| + | & " | ||
| + | & " | ||
| + | |||
| + | |||
| + | |||
| + | Select Case charset | ||
| + | Case " | ||
| + | parameters = parameters & "& | ||
| + | Case Else | ||
| + | End Select | ||
| + | |||
| + | |||
| + | |||
| + | xmlhttp.open(" | ||
| + | xmlhttp.setRequestHeader(" | ||
| + | xmlhttp.setRequestHeader(" | ||
| + | xmlhttp.Send(parameters) | ||
| + | |||
| + | If xmlhttp.Status >= 400 And xmlhttp.Status <= 599 Then | ||
| + | SendSMS = " | ||
| + | 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 = "" | ||
| + | Dim url, method, parameters, msg As String | ||
| + | Dim xmlhttp As Object | ||
| + | xmlhttp = CreateObject(" | ||
| + | |||
| + | url = " | ||
| + | |||
| + | |||
| + | parameters = " | ||
| + | & " | ||
| + | |||
| + | xmlhttp.open(" | ||
| + | xmlhttp.setRequestHeader(" | ||
| + | xmlhttp.setRequestHeader(" | ||
| + | xmlhttp.Send(parameters) | ||
| + | |||
| + | If xmlhttp.Status >= 400 And xmlhttp.Status <= 599 Then | ||
| + | GetCredit = " | ||
| + | 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) = " | ||
| + | |||
| + | ' Per invio multiplo | ||
| + | ' recipients(0) = " | ||
| + | ' recipients(1) = " | ||
| + | |||
| + | ' ------------ Invio SMS -------------- | ||
| + | |||
| + | Dim result As String | ||
| + | result = SendSMS(" | ||
| + | |||
| + | ' ------------ LETTURA DEL CREDITO UTENTE ------------- | ||
| + | ' result = GetCredit(" | ||
| + | |||
| + | |||
| + | Dim responses As String() | ||
| + | responses = Split(result, | ||
| + | Dim Response As String = "" | ||
| + | For Each Item In responses | ||
| + | Response = Response & Item & vbCrLf | ||
| + | Next | ||
| + | MsgBox(Response, | ||
| + | End Sub | ||
| + | </ | ||