[vb]
Public Function SendSMSLabsMobile(Sender As String, Phone As String, SendDateTime As String, Message As String, Test As String, AllowLongMessage As String) As String
Dim SendString As String
Dim ResultCall As String
Dim gAccountLM As String = "account@domain.com"
Dim gPasswordLM As String = "password"
If SendDateTime = "" Then
SendString = "http://api.labsmobile.com/get/send.php" & _
"?username=" & gAccountLM & _
"&password=" & gPasswordLM + _
"&sender=" & Sender + _
"&long=" & LongMessage + _
"&test=" & Test + _
"&msisdn=" & Phone + _
"&message=" + ozURLEncode(Message)
Else
SendString = "http://api.labsmobile.com/get/send.php" & _
"?&username=" & gAccountLM & _
"&password=" & gPasswordLM + _
"&sender=" & Sender + _
"&scheduled=" & SendDateTime + _
"&long=" & LongMessage + _
"&test=" & Test + _
"&msisdn=" & Phone + _
"&message=" + ozURLEncode(Message)
End If
ResultCall = SendRequest(SendString)
If Trim(ResultCall) <> "" Then
Dim x As Long: Dim y As Long
Dim CodeRes As String: Dim TmpCodeRes As String
x = InStr(1, ResultCall, "", vbTextCompare)
If x = 0 Then
CodeRes = 99
Else
TmpCodeRes = Mid(ResultCall, x + 6, 4)
y = InStr(1, TmpCodeRes, "<", vbTextCompare)
CodeRes = Mid(TmpCodeRes, 1, y - 1)
End If
Select Case Val(CodeRes)
Case 0
EnviaSMSLabsMobile = "Ok"
Case 30
EnviaSMSLabsMobile = "There was an error while sending the message"
Case 35
EnviaSMSLabsMobile = "No enough credit"
Case 36
EnviaSMSLabsMobile = "Incorrect phone number"
Case 37
EnviaSMSLabsMobile = "The account has reached the maximum number of sendings per day"
Case 39
EnviaSMSLabsMobile = "Incorrect scheduled datetime"
Case 40
EnviaSMSLabsMobile = "The user cannot send scheduled messages"
Case 41
EnviaSMSLabsMobile = "You cannot send scheduled messages in test mode"
Case Else
EnviaSMSLabsMobile = "Unexpected error - Message not sent"
End Select
End If
End Function
Public Function SendRequest(ByVal strUrl As String) As String
Dim ozData As String
Dim ozConnOpen As Long, ozGetFile As Long
Dim ozReturnValue As Long, ozBuffer As String * 128
ozConnOpen = InternetOpen("Ozeki HTTP client", 1, vbNullString, vbNullString, 0)
ozGetFile = InternetOpenUrl(ozConnOpen, strUrl, vbNullString, 0, &H4000000, 0)
If ozGetFile = 0 Then
MsgBox "Unviable connection", vbExclamation, "Error"
Exit Function
End If
InternetReadFile ozGetFile, ozBuffer, 128, ozReturnValue
ozData = ozBuffer
Do While ozReturnValue <> 0
InternetReadFile ozGetFile, ozBuffer, 128, ozReturnValue
ozData = ozData + Mid(ozBuffer, 1, ozReturnValue)
Loop
InternetCloseHandle ozGetFile
InternetCloseHandle ozConnOpen
SendRequest = ozData
ozData = ""
End Function
Public Function ozURLEncode(ByVal Text As String) As String
Dim i As Integer
Dim ozCode As Integer
Dim char As String
ozURLEncode = Text
For i = Len(ozURLEncode) To 1 Step -1
ozCode = Asc(Mid$(ozURLEncode, i, 1))
Select Case ozCode
Case 48 To 57, 65 To 90, 97 To 122
' Do not replace the alphanumeric characters
Case 32
' Replace the space character with "+"
Mid$(ozURLEncode, i, 1) = "+"
Case Else
' Replace the national characters with a percent sign and the characters hexadecimal Value
ozURLEncode = Left$(ozURLEncode, i - 1) & "%" & Hex$(ozCode) & Mid$ _
(ozURLEncode, i + 1)
End Select
Next
End Function
[/vb]