Ejemplo Visual Basic a FoxPro
Publicado por Manuel (2 intervenciones) el 28/12/2010 04:38:16
Tengo un pequeño modulo desarrollado en Visual Basic y me pidieron pasarlo a FoxPro, pero no tengo idea de por donde empezar, consegui una utilidad que hace el equivalente pero no funciona muy bien, si alguien tiene alguna utilidad para esto o simplemente tiene el tiempo para revisarlo se lo agradeceria, el codigo es el siguiente:
Option Compare Database
Option Explicit
Function EnviarSMS(Cel As String, TxT As String) As Integer
On Error GoTo errEnviarSMS
Dim cUrl As String
Dim objHttpTest As Object
Dim msg As String
Dim URLMsg As String
Dim User As String
Dim Pass As String
Dim Ans As String
DoEvents
DoCmd.Hourglass True
Set objHttpTest = CreateObject("Microsoft.XMLHTTP")
If Len(TxT) > 160 Then
EnviarSMS = 160
Exit Function
End If
URLMsg = URLEncode(TxT, True)
User = "Usuario"
Pass = "Clave"
cUrl = "Http://www.smssend.com/?phonenumber=" & Cel & "&Text=" & URLMsg & "&user=" & User & "&password=" & Pass
objHttpTest.Open "POST", cUrl, False
objHttpTest.Send
EnviarSMS = Left(objHttpTest.responseText, 3)
Exit_EnviarSMS:
On Error Resume Next
Set objHttpTest = Nothing
DoCmd.Hourglass False
On Error GoTo 0
Exit Function
errEnviarSMS:
On Error Resume Next
MsgBox "Error N°: " & Err.Number & vbCrLf & "Descripción: " & Err.Description, vbCritical, "Ocurrio un error"
Resume Exit_EnviarSMS
End Function
Public Function URLEncode( _
StringVal As String, _
Optional SpaceAsPlus As Boolean = False _
) As String
Dim StringLen As Long: StringLen = Len(StringVal)
If StringLen > 0 Then
ReDim result(StringLen) As String
Dim i As Long, CharCode As Integer
Dim Char As String, Space As String
If SpaceAsPlus Then Space = "+" Else Space = "%20"
For i = 1 To StringLen
Char = Mid$(StringVal, i, 1)
CharCode = Asc(Char)
Select Case CharCode
Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
result(i) = Char
Case 32
result(i) = Space
Case 0 To 15
result(i) = "%0" & Hex(CharCode)
Case Else
result(i) = "%" & Hex(CharCode)
End Select
Next i
URLEncode = Join(result, "")
End If
End Function
Muchas gracias de antemano.
Option Compare Database
Option Explicit
Function EnviarSMS(Cel As String, TxT As String) As Integer
On Error GoTo errEnviarSMS
Dim cUrl As String
Dim objHttpTest As Object
Dim msg As String
Dim URLMsg As String
Dim User As String
Dim Pass As String
Dim Ans As String
DoEvents
DoCmd.Hourglass True
Set objHttpTest = CreateObject("Microsoft.XMLHTTP")
If Len(TxT) > 160 Then
EnviarSMS = 160
Exit Function
End If
URLMsg = URLEncode(TxT, True)
User = "Usuario"
Pass = "Clave"
cUrl = "Http://www.smssend.com/?phonenumber=" & Cel & "&Text=" & URLMsg & "&user=" & User & "&password=" & Pass
objHttpTest.Open "POST", cUrl, False
objHttpTest.Send
EnviarSMS = Left(objHttpTest.responseText, 3)
Exit_EnviarSMS:
On Error Resume Next
Set objHttpTest = Nothing
DoCmd.Hourglass False
On Error GoTo 0
Exit Function
errEnviarSMS:
On Error Resume Next
MsgBox "Error N°: " & Err.Number & vbCrLf & "Descripción: " & Err.Description, vbCritical, "Ocurrio un error"
Resume Exit_EnviarSMS
End Function
Public Function URLEncode( _
StringVal As String, _
Optional SpaceAsPlus As Boolean = False _
) As String
Dim StringLen As Long: StringLen = Len(StringVal)
If StringLen > 0 Then
ReDim result(StringLen) As String
Dim i As Long, CharCode As Integer
Dim Char As String, Space As String
If SpaceAsPlus Then Space = "+" Else Space = "%20"
For i = 1 To StringLen
Char = Mid$(StringVal, i, 1)
CharCode = Asc(Char)
Select Case CharCode
Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
result(i) = Char
Case 32
result(i) = Space
Case 0 To 15
result(i) = "%0" & Hex(CharCode)
Case Else
result(i) = "%" & Hex(CharCode)
End Select
Next i
URLEncode = Join(result, "")
End If
End Function
Muchas gracias de antemano.
Valora esta pregunta


0