Colabora
 

smssender

[Un sms sender en VB6]

 

Fecha: 02/Ene/2010 (06-11-09)
Autor: Feli -

 


Introducción

Aquí queda un código en VB6 para enviar sms desde el pc mediante MSComm, que hice (parte lo adapté de otros códigos bajados de Dios Google y elguille.info) hace tiempo. Nunca lo he incorporado a ninguna aplicación simplemente lo hice y allí se quedó, pero ahora lo he recuperado para una aplicación VB.NET, para la que aconsejo adaptarlo usando SerialPort.

 

Contenido

Sin más este código no pretende nada, lo bueno es que en él tienes lo necesario para comprender como funciona el formato PDU y algunos comandos AT, necesarios para comunicarte con un módem GSM o teléfono móvil. Lo bueno de este código es que a más a más de enviar SMS en formato 7 bits (texto), 16 bits (PDU) incluye el formato 8 bits que es otra forma de enviar mensajes con caracteres especiales, no tantos como 16 bits, pero nos permite enviar hasta 140 caracteres con acentos. 7 bits: 160 caracteres sin acentos ni símbolos, 16 bits: 70 caracteres todos los caracteres existentes. Incluye un conversor a formato 16 y 8 bits, para que comprendas en que se convierte tu sms.

Nota:
El formato 8 bits no es compatible con todos los teléfonos, es más algunos no lo son con 7 bits y otros con 16 bits. De mis tres teléfonos uno acepta los tres formatos (sony ericson Z(algo)), otro made in china acepta 7 y 16 bits, y un LG sólo acepta 16 bits. así que eso es cuestión de suerte con el teléfono que tengas, no de código.

En que se convierte tu sms: se convierte en hexadecimal si es 8 o 16 bits y si es 7 bits no se convierte hasta el momento de la recepción. Cuando los recojes de tu móvil, se haya enviado en el formato que se haya enviado lo obtendrás en hexadecimal, para leerlo habrá que reconvertirlo. Este código no lee mensajes del móvil, aunque si te esmeras un poco no llega a ser tan complicado, pero si algo tedioso.

Nota:
Incluye una terminal para comunicarte con periféricos mediante comandos. No la comento pues no es mía y la verdad es que ya hace mucho tiempo que la descargué y no se de donde, aunque tengo sospechas de que no fue muy lejos. Pero la dejo en el proyecto ya que será útil para que practiques comandos AT con tu teléfono.

También existe una parte del código que te servirá como ejemplo para comunicarte con el teléfono, que sirve para pedirle al teléfono que te pase la lista de contactos (Agenda).

En un principio existía la posibilidad de usar un SMCS distinto al del móvil, en el que había alguno gratuito, pero lo he suprimido para evitar que te dejes una pasta probando servidores que tu operador ya haya tenido en cuenta. Piensa que cuando yo hice este código no existían los euros y cuando utilizaba un SMCS que no había verificado me salía el SMS por 100 pts. Resumiendo "NO LO RECOMIENDO".

El código:

A continuación sigue código en Visual Basic 6:

 

Private Sub Envio8Bits()
Label1.Caption = MSComm1.CommEvent & " Enviando SMS, en formato 8 bits..."
Label1.Visible = True
   If Not Text3.Text = "" Then
   MSComm1.CommPort = Text3.Text
   Else
   MsgBox "No ha seleccionado un puerto de comunicaciones/módem"
   Exit Sub
   End If
   If Text1.Text = "" Then
   MsgBox "No ha indicado un número de teléfono de destino..."
   Exit Sub
   End If
   If Text2.Text = "" Then
   MsgBox "No ha escrito ningún texto para el cuerpo del mensaje..."
   Exit Sub
   End If
   MSComm1.Settings = "9600,N,7,1"
       On Error Resume Next
    MSComm1.PortOpen = True

  'selecciono formato texto para enviar el SMS en PDU
MSComm1.Output = "AT+CMGF=0" + vbCr
Label1.Caption = MSComm1.CommEvent & " Confirmando formato del SMS."
'lo hago esperar durante un rato
   TiempoPausa = 5   ' Asigna hora de inicio.
   Inicio = Timer   ' Establece la hora de inicio.
   Do While Timer < Inicio + TiempoPausa
      DoEvents   ' Cambia a otros procesos.
   Loop
   Final = Time   ' Asigna hora de finalización.
   TiempoTotal = Final - Inicio   ' Calcula tiempo total.

    If Err Then
       MsgBox "el puerto no está disponible. Cambie la propiedad CommPort" + vbCr & _
       "a otro puerto, asegúrese que dispone de módem."
          If MSComm1.PortOpen = True Then
' Desconecta el módem.
Label1.Caption = " Terminado"
MSComm1.Output = "ATH" + vbCr
MSComm1.PortOpen = False
End If
       Exit Sub
End If


'Primero declaro las variables
Dim LargoSMCS, InterNacSMCS, SMCS, DigitosA, DigitosB, LargoTel, InterNacTel, Telefono
Dim PID, Formato, Caducidad, LargoMensaje, Mensaje, LargoMensajeTel, TotalSMS

' primero  calculo el largo del SMCS, si no utiliza SMCS el resulatdo es: 00
If Combo2.Text = "" Then
LargoSMCS = "00"
Else
LargoSMCS = "0" & Round((Len(Combo2.Text) / 2) + 1)

End If

' segundo compruebo si el SMCS es internacional o nacional
'buscando el signo + = "Internacional, si no usa SMCS el resultado es = vacío"
If Combo2.Text = "" Then
InterNacSMCS = ""
Else
InterNacSMCS = Left(Combo2.Text, 1)
If InterNacSMCS = "+" Then
InterNacSMCS = "91"
Else
InterNacSMCS = "92"
End If
End If

' tercero capturo el SMCS invirtiendo cada 2 dígitos y si es impar le añado la F rastreadora
' antes compruebo si usa el SMCS del móvil, si lo usa el resultado es: vacío
If Combo2.Text = "" Then
SMCS = ""
Else
Dim intCt As Integer
Dim strNew As String
Dim MiCadena, i, Invertido, Decena
i = 1
MiCadena = Combo2.Text
MiCadena = replace(MiCadena, "+", "")
If Not Round(Len(MiCadena) / 2) = Len(MiCadena) / 2 Then
MiCadena = MiCadena & "F"
End If
Do While i <= Len(MiCadena)
Decena = Mid(MiCadena, i, 2)
For intCt = 1 To Len(Decena)
strNew = Mid$(Decena, intCt, 1) & strNew
Next
SMCS = SMCS & Mid(strNew, 1, 2)
i = i + 2
Loop
End If

' cuarto y quinto añado los dígito 1100, no se exactamente que hacen pero deben estar
DigitosA = "11"
DigitosB = "00"

' sexto pongo el largo del teléfono de destino en hexadecimal
'elimino el + igual que en el SMCS
LargoTel = replace(Text1.Text, "+", "")
LargoTel = "0" & Hex(Len(LargoTel))
If LargoTel = 0 Then
LargoTel = "00"
End If

' y septimo indico si es Internacional o Nacional 91=Inter
Dim CInter2
CInter2 = Left(Text1.Text, 1)
If CInter2 = "+" Then
CInter2 = "91"
Else
CInter2 = "92"
End If
InterNacTel = CInter2

' obtavo capturo el teléfono de destino invirtiendo cada 2 dígitos
'y si es impar le añado la F rastreadora
' antes compruebo si está vacío, si lo usa el resultado es: vacío
If Text1.Text = "" Then
Telefono = ""
Else
i = 1
MiCadena = Text1.Text
MiCadena = replace(MiCadena, "+", "")
If Not Round(Len(MiCadena) / 2) = Len(MiCadena) / 2 Then
MiCadena = MiCadena & "F"
End If
Do While i <= Len(MiCadena)
Decena = Mid(MiCadena, i, 2)
For intCt = 1 To Len(Decena)
strNew = Mid$(Decena, intCt, 1) & strNew
Next
Telefono = Telefono & Mid(strNew, 1, 2)
i = i + 2
Loop
End If

' Noveno añado los dos dígitos del protocolo de identificación,
'pongo 00 para no cagarla, ya que no conozco como funciona
PID = "00"

' décimo añado los dígitos que indica el formato del sms:
'7 bits, 8 bits o 16 bits ---> 00 , 04, 08
If Check6.Value = 1 Then
Formato = "08" '16 bits
End If
If Check7.Value = 1 Then
Formato = "04" '8 bits
End If
If Check7.Value = 0 And Check6.Value = 0 Then
Formato = "00" '7 bits
End If

'decimoprimero añado el plazo de entrega, pongo AA que es 4 días, AF, etc.
Caducidad = "AA"

'decimosegundo añado el largo del mensaje en hexadecimal, si no hay nada el valor es 00
LargoMensaje = Hex((Len(Text2.Text)) * 2)
If Len(LargoMensaje) < 2 Then
LargoMensaje = "0" & LargoMensaje
End If

'decimotercero convierto el texto del mansaje a hexadecimal con los 00 delante de cada letra
Mensaje = ""
Dim MiCadenaDeBytes() As Byte
MiCadenaDeBytes = Text2.Text
For i = LBound(MiCadenaDeBytes) To (UBound(MiCadenaDeBytes) - 1)
If Not Hex(MiCadenaDeBytes(i)) = 0 Then
If Hex(MiCadenaDeBytes(i)) = "AC" Then
Mensaje = Mensaje & "20" & Left(Hex(MiCadenaDeBytes(i)), 4)
Else
If Hex(MiCadenaDeBytes(i)) = "D" Then
Mensaje = Mensaje & "0" & Left(Hex(MiCadenaDeBytes(i)), 4)
Else
If Hex(MiCadenaDeBytes(i)) = "A" Then
Mensaje = Mensaje & "0" & Left(Hex(MiCadenaDeBytes(i)), 4)
Else
Mensaje = Mensaje & Left(Hex(MiCadenaDeBytes(i)), 4)
End If
End If
End If
End If
Next
'Ahora elimino los dobles espacios del mansaje y arreglo el espacio de después del €
Mensaje = replace(Mensaje, "AC20", "AC")
Mensaje = replace(Mensaje, "2020", "20")

'decimocuarto recojo el largo total del mensaje y el largo del teléfono
'ya invertido y con la F, si el teléfono y el mensaje están vacíos el valor es 8
If Text1.Text = "" And Text2.Text = "" Then
LargoMensajeTel = "8"
Else
LargoMensajeTel = ((Len(Telefono) / 2) + (Len(Mensaje) / 2)) + 8
End If

'ahora juntamos todo el mensaje menos LargoMensajeTel , que lo dejamos para luego
TotalSMS = LargoSMCS & InterNacSMCS & SMCS & DigitosA & DigitosB & LargoTel & _
InterNacTel & Telefono & PID & Formato & Caducidad & LargoMensaje & Mensaje

'ahora si ya lo terminamos
'envío el mensaje
If Check5.Value = 1 Then
MSComm1.Output = "AT+CMGW=" & LargoMensajeTel & vbCr
Text4.Text = "AT+CMGW=" & LargoMensajeTel & vbCr
End If
If Check5.Value = 0 Then
MSComm1.Output = "AT+CMGS=" & LargoMensajeTel & vbCr
Text4.Text = "AT+CMGS=" & LargoMensajeTel & vbCr
End If
Label1.Caption = MSComm1.CommEvent & " Comunicando con el módem..."

'lo hago esperar durante un rato
   TiempoPausa = 5   ' Asigna hora de inicio.
   Inicio = Timer   ' Establece la hora de inicio.
   Do While Timer < Inicio + TiempoPausa
      DoEvents   ' Cambia a otros procesos.
   Loop
   Final = Time   ' Asigna hora de finalización.
   TiempoTotal = Final - Inicio   ' Calcula tiempo total.

 'ahora envío el SMS
MSComm1.Output = TotalSMS + Chr(26)
Text4.Text = Text4.Text + TotalSMS + Chr(26)

Label1.Caption = MSComm1.CommEvent & " enviando el SMS, en formato 8 bits..."



'lo hago esperar durante un rato
   TiempoPausa = 5   ' Asigna hora de inicio.
   Inicio = Timer   ' Establece la hora de inicio.
   Do While Timer < Inicio + TiempoPausa
      DoEvents   ' Cambia a otros procesos.
   Loop
   Final = Time   ' Asigna hora de finalización.
   TiempoTotal = Final - Inicio   ' Calcula tiempo total.

'cerramos la conexión
MSComm1.Output = "ATH" + vbCr
MSComm1.PortOpen = False

'aviso de que si el formato es nacional a lo mejor no llega
If CInter2 = "92" Then
MsgBox "No añadió el prefijo de país en el teléfono de destino, es posible que el mensaje no sea enviado..." & _
vbCr & "Ejemplo para España : +34XXXXXXXXX"
End If

'informo al usuario
Label1.Caption = MSComm1.CommEvent & " SMS ENVIADO, en formato 8 bits..."
'lo guardo en el registro
AnadirReg
End Sub
Private Sub EnvioPDU()
Label1.Caption = MSComm1.CommEvent & " Enviando SMS, en formato 16 bits..."
Label1.Visible = True
   If Not Text3.Text = "" Then
   MSComm1.CommPort = Text3.Text
   Else
   MsgBox "No ha seleccionado un puerto de comunicaciones/módem"
   Exit Sub
   End If
   If Text1.Text = "" Then
   MsgBox "No ha indicado un número de teléfono de destino..."
   Exit Sub
   End If
   If Text2.Text = "" Then
   MsgBox "No ha escrito ningún texto para el cuerpo del mensaje..."
   Exit Sub
   End If
   MSComm1.Settings = "9600,N,7,1"
       On Error Resume Next
    MSComm1.PortOpen = True

  'selecciono formato texto para enviar el SMS en PDU
MSComm1.Output = "AT+CMGF=0" + vbCr
Label1.Caption = MSComm1.CommEvent & " Confirmando formato del SMS."
'lo hago esperar durante un rato
   TiempoPausa = 5   ' Asigna hora de inicio.
   Inicio = Timer   ' Establece la hora de inicio.
   Do While Timer < Inicio + TiempoPausa
      DoEvents   ' Cambia a otros procesos.
   Loop
   Final = Time   ' Asigna hora de finalización.
   TiempoTotal = Final - Inicio   ' Calcula tiempo total.

    If Err Then
       MsgBox "el puerto no está disponible. Cambie la propiedad CommPort" & vbCr & _
       "a otro puerto, asegúrese que dispone de módem."
          If MSComm1.PortOpen = True Then
' Desconecta el módem.
Label1.Caption = " Terminado"
MSComm1.Output = "ATH" + vbCr
MSComm1.PortOpen = False
End If
       Exit Sub
End If


'Primero declaro las variables
Dim LargoSMCS, InterNacSMCS, SMCS, DigitosA, DigitosB, LargoTel, InterNacTel
Dim Telefono, PID, Formato, Caducidad, LargoMensaje, Mensaje, LargoMensajeTel, TotalSMS

' primero  calculo el largo del SMCS, si no utiliza SMCS el resulatdo es: 00
If Combo2.Text = "" Then
LargoSMCS = "00"
Else
LargoSMCS = "0" & Round((Len(Combo2.Text) / 2) + 1)
End If

' segundo compruebo si el SMCS es internacional o nacional
'buscando el signo + = "Internacional, si no usa SMCS el resultado es = vacío"
If Combo2.Text = "" Then
InterNacSMCS = ""
Else
InterNacSMCS = Left(Combo2.Text, 1)
If InterNacSMCS = "+" Then
InterNacSMCS = "91"
Else
InterNacSMCS = "92"
End If
End If

' tercero capturo el SMCS invirtiendo cada 2 dígitos y si es impar le añado la F rastreadora
' antes compruebo si usa el SMCS del móvil, si lo usa el resultado es: vacío
If Combo2.Text = "" Then
SMCS = ""
Else
Dim intCt As Integer
Dim strNew As String
Dim MiCadena, i, Invertido, Decena
i = 1
MiCadena = Combo2.Text
MiCadena = replace(MiCadena, "+", "")
If Not Round(Len(MiCadena) / 2) = Len(MiCadena) / 2 Then
MiCadena = MiCadena & "F"
End If
Do While i <= Len(MiCadena)
Decena = Mid(MiCadena, i, 2)
For intCt = 1 To Len(Decena)
strNew = Mid$(Decena, intCt, 1) & strNew
Next
SMCS = SMCS & Mid(strNew, 1, 2)
i = i + 2
Loop
End If

' cuarto y quinto añado los dígito 1100, no se exactamente que hacen pero deben estar
DigitosA = "11"
DigitosB = "00"

' sexto pongo el largo del teléfono de destino en hexadecimal, elimino el + igual que en el SMCS
LargoTel = replace(Text1.Text, "+", "")
LargoTel = "0" & Hex(Len(LargoTel))
If LargoTel = 0 Then
LargoTel = "00"
End If

' y septimo indico si es Internacional o Nacional 91=Inter
Dim CInter2
CInter2 = Left(Text1.Text, 1)
If CInter2 = "+" Then
CInter2 = "91"
Else
CInter2 = "92"
End If
InterNacTel = CInter2

' obtavo capturo el teléfono de destino invirtiendo cada 2 dígitos
'y si es impar le añado la F rastreadora
' antes compruebo si está vacío, si lo usa el resultado es: vacío
If Text1.Text = "" Then
Telefono = ""
Else
'Dim intCtb As Integer
'Dim strNewb As String
'Dim MiCadenab, ib, Decenab
i = 1
MiCadena = Text1.Text
MiCadena = replace(MiCadena, "+", "")
If Not Round(Len(MiCadena) / 2) = Len(MiCadena) / 2 Then
MiCadena = MiCadena & "F"
End If
Do While i <= Len(MiCadena)
Decena = Mid(MiCadena, i, 2)
For intCt = 1 To Len(Decena)
strNew = Mid$(Decena, intCt, 1) & strNew
Next
Telefono = Telefono & Mid(strNew, 1, 2)
i = i + 2
Loop
End If

' Noveno añado los dos dígitos del protocolo de identificación,
'pongo 00 para no cagarla, ya que no conozco como funciona
PID = "00"

' décimo añado los dígitos que indica el formato del sms:
'7 bits, 8 bits o 16 bits ---> 00 , 04, 08
If Check6.Value = 1 Then
Formato = "08" '16 bits
End If
If Check7.Value = 1 Then
Formato = "04" '8 bits
End If
If Check7.Value = 0 And Check6.Value = 0 Then
Formato = "00" '7 bits
End If

'decimoprimero añado el plazo de entrega, pongo AA que es 4 días, ya que no conozco otros
Caducidad = "AA"

'decimosegundo añado el largo del mensaje en hexadecimal, si no hay nada el valor es 00
LargoMensaje = Hex((Len(Text2.Text)) * 2)
If Len(LargoMensaje) < 2 Then
LargoMensaje = "0" & LargoMensaje
End If

'decimotercero convierto el texto del mansaje a hexadecimal con los 00 delante de cada letra
Mensaje = ""
Dim MiCadenaDeBytes() As Byte
MiCadenaDeBytes = Text2.Text
For i = LBound(MiCadenaDeBytes) To (UBound(MiCadenaDeBytes) - 1)
If Not Hex(MiCadenaDeBytes(i)) = 0 Then
If Hex(MiCadenaDeBytes(i)) = "AC" Then
Mensaje = Mensaje & "20" & Left(Hex(MiCadenaDeBytes(i)), 4)
Else
If Hex(MiCadenaDeBytes(i)) = "D" Then
Mensaje = Mensaje & "000" & Left(Hex(MiCadenaDeBytes(i)), 4)
Else
If Hex(MiCadenaDeBytes(i)) = "A" Then
Mensaje = Mensaje & "000" & Left(Hex(MiCadenaDeBytes(i)), 4)
Else
Mensaje = Mensaje & "00" & Left(Hex(MiCadenaDeBytes(i)), 4)
End If
End If
End If
End If
Next
'Ahora elimino los dobles espacios del mansaje y arreglo el espacio de después del €
Mensaje = replace(Mensaje, "20AC0020", "20AC")
Mensaje = replace(Mensaje, "00200020", "0020")

'decimocuarto recojo el largo total del mensaje y el largo del teléfono ya
'invertido y con la F, si el teléfono y el mensaje están vacíos el valor es 8
If Text1.Text = "" And Text2.Text = "" Then
LargoMensajeTel = "8"
Else
LargoMensajeTel = ((Len(Telefono) / 2) + (Len(Mensaje) / 2)) + 8
End If

'ahora juntamos todo el mensaje menos LargoMensajeTel , que lo dejamos para luego
TotalSMS = LargoSMCS & InterNacSMCS & SMCS & DigitosA & DigitosB & LargoTel & _
InterNacTel & Telefono & PID & Formato & Caducidad & LargoMensaje & Mensaje

'ahora si ya lo terminamos
'envío el mensaje
If Check5.Value = 1 Then
MSComm1.Output = "AT+CMGW=" & LargoMensajeTel & vbCr
Text4.Text = "AT+CMGW=" & LargoMensajeTel & vbCr
End If
If Check5.Value = 0 Then
MSComm1.Output = "AT+CMGS=" & LargoMensajeTel & vbCr
Text4.Text = "AT+CMGS=" & LargoMensajeTel & vbCr
End If
Label1.Caption = MSComm1.CommEvent & " Comunicando con el módem..."

'lo hago esperar durante un rato
   TiempoPausa = 5   ' Asigna hora de inicio.
   Inicio = Timer   ' Establece la hora de inicio.
   Do While Timer < Inicio + TiempoPausa
      DoEvents   ' Cambia a otros procesos.
   Loop
   Final = Time   ' Asigna hora de finalización.
   TiempoTotal = Final - Inicio   ' Calcula tiempo total.

 'ahora envío el SMS
MSComm1.Output = TotalSMS + Chr(26)
Text4.Text = Text4.Text + TotalSMS + Chr(26)

Label1.Caption = MSComm1.CommEvent & " enviando el SMS, en formato 16 bits..."



'lo hago esperar durante un rato
   TiempoPausa = 5   ' Asigna hora de inicio.
   Inicio = Timer   ' Establece la hora de inicio.
   Do While Timer < Inicio + TiempoPausa
      DoEvents   ' Cambia a otros procesos.
   Loop
   Final = Time   ' Asigna hora de finalización.
   TiempoTotal = Final - Inicio   ' Calcula tiempo total.

'cerramos la conexión
MSComm1.Output = "ATH" + vbCr
MSComm1.PortOpen = False
'informo al usuario
Label1.Caption = MSComm1.CommEvent & " SMS ENVIADO, en formato 16 bits..."

'aviso de que si el formato es nacional a lo mejor no llega
If CInter2 = "92" Then
MsgBox "No añadió el prefijo de país en el teléfono de destino," & _
es posible que el mensaje no sea enviado..." & vbCr & "Ejemplo para España : +34XXXXXXXXX""
End If

'lo guardo en el registro
AnadirReg
End Sub

Private Sub Check1_Click()
Check4.Value = 0
End Sub

Private Sub Check2_Click()
If Check2.Value = 1 And Check6.Value = 1 Or Check2.Value = 1 And Check7.Value = 1 Then
Check2.Value = 0
MsgBox "No se puede solicitar confirmación en formato 8 ó 16 bits"
Else
If Check2.Value = 1 Then
MsgBox "Al solicitar conformación de lectura el SMS se reduce a 156 caracteres..."
Text2.MaxLength = 156
Else
Text2.MaxLength = 160
End If
End If

End Sub

Private Sub Check3_Click()
If Not Combo2.Text = "" Then
Combo2.Text = ""

End If
End Sub

Private Sub Check4_Click()
Check1.Value = 0
End Sub



Private Sub Check6_Click()
If Check6.Value = 1 And Len(Text2.Text) >= 70 Then
MsgBox "Al activar 16 Bits el SMS se reduce a 70 caracteres" & _
y Vd. ha escrito " & Len(Text2.Text) & " caracteres...""
Check6.Value = 0
Else
If Check6.Value = 1 And Len(Text2.Text) < 70 Then
MsgBox "Al activar 16 Bits activa la compatibilidad con todos los idiomas" & _
pero el SMS se reduce a 70 caracteres...""
Text2.MaxLength = 70
Label4.Caption = "Quedan " & 70 - Len(Text2.Text) & " caracteres..."
Check7.Value = 0
Else
Text2.MaxLength = 160
Label4.Caption = "Quedan " & 160 - Len(Text2.Text) & " caracteres..."
End If
If Check2.Value = 1 Then
Check2.Value = 0
MsgBox "No se puede solicitar confirmación en formato 16 bits"
End If
End If
End Sub

Private Sub Check7_Click()
If Check7.Value = 1 And Len(Text2.Text) >= 140 Then
MsgBox "Al activar 8 Bits el SMS se reduce a 140 caracteres" & _
y Vd. ha escrito " & Len(Text2.Text) & " caracteres...""
Check7.Value = 0
Else
If Check7.Value = 1 And Len(Text2.Text) < 140 Then
MsgBox "Al activar 8 Bits aumenta la compatibilidad con todos los idiomas" & _
pero el SMS se reduce a 140 caracteres...""
Text2.MaxLength = 140
Label4.Caption = "Quedan " & 140 - Len(Text2.Text) & " caracteres..."
Check6.Value = 0
Else
Text2.MaxLength = 160
Label4.Caption = "Quedan " & 160 - Len(Text2.Text) & " caracteres..."
End If
If Check2.Value = 1 Then
Check2.Value = 0
MsgBox "No se puede solicitar confirmación en formato 8 bits"
End If
End If
End Sub

Private Sub Combo1_Click()
' Buscamos en la agenda el teléfono
    Const ForReading = 1, ForWriting = 2, ForAppending = 3
    Dim fs, f, miTel
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.OpenTextFile(App.path & ("\Agenda\") & Combo1.Text)
    miTel = f.readline
    f.Close
    If miTel = "" Then
    MsgBox "No existe teléfono en este contacto..."
    End
    Else
    Text1.Text = miTel
    End If
End Sub



Private Sub Combo2_Change()
If Combo2.Text = "" Then
Check3.Value = 1
End If
End Sub

Private Sub Combo2_Click()
If Check3.Value = 1 Then
Check3.Value = 0
End If
End Sub

Private Sub Command1_Click()
If Text3.Text = "" Then
MsgBox "No ha seleccionado un puerto para el módem o teléfono..."
Exit Sub
End If
Unload frmTerminal
If Check6.Value = 1 And Check7.Value = 0 Then
' compruebo que lo quiere enviar en 16bits, si no es así será formato texto, siguiendo este godigo
EnvioPDU
Exit Sub
End If
If Check6.Value = 0 And Check7.Value = 1 Then
' compruebo que lo quiere enviar en 16bits, si no es así será formato texto, siguiendo este godigo
Envio8Bits
Exit Sub
End If
Label1.Visible = True
On Error Resume Next
'Dim dummy
   ' Búfer para almacenar la cadena de entrada
   'Dim Instring As String
   ' Usar COM6.
   If Not Text3.Text = "" Then
   MSComm1.CommPort = Text3.Text
   Else
   MsgBox "No ha seleccionado un puerto de comunicaciones/módem"
   Exit Sub
   End If
   If Text1.Text = "" Then
   MsgBox "No ha indicado un número de teléfono de destino..."
   Exit Sub
   End If
   If Text2.Text = "" Then
   MsgBox "No ha escrito ningún texto para el cuerpo del mensaje..."
   Exit Sub
   End If
      ' 9600 baudios, sin paridad, 8 bits de datos y 1
    ' bit de parada.
   MSComm1.Settings = "9600,N,7,1"
   ' Indicar al control que lea todo el búfer al usar
    ' Input.
   'MSComm1.InputLen = 0
   ' Abrir el puerto.
       'On Error Resume Next
    MSComm1.PortOpen = True

    'MSComm1.NullDiscard = False
    'MSComm1.Handshaking = comNone

    If Err Then
       MsgBox "el puerto no está disponible. Cambie la propiedad CommPort" & _
       "a otro puerto, asegúrese que dispone de módem."
       Exit Sub
    End If
   ' Enviar al módem el comando de atención.
 'Número del Servidor SMS
If Check3.Value = 0 Then
MSComm1.Output = "AT+CSCA=" + Combo2.Text + Chr(13)
End If

   'Número de destino al que enviamos el mensaje
Dim lcTFDestino, lcTexto
lcTFDestino = Chr(34) + Text1.Text + Chr(34)
    'mensaje
lcTexto = Text2.Text

'selecciono formato texto para enviar el SMS
MSComm1.Output = "AT+CMGF=1" + vbCr

Label1.Caption = MSComm1.CommEvent & " Confirmando formato del SMS."
             ' lo hago marcar durante un rato
   TiempoPausa = 2   ' Asigna hora de inicio.
   Inicio = Timer   ' Establece la hora de inicio.
   Do While Timer < Inicio + TiempoPausa
      DoEvents   ' Cambia a otros procesos.
   Loop
   Final = Time   ' Asigna hora de finalización.
   TiempoTotal = Final - Inicio   ' Calcula tiempo total.

   If Check5.Value = 1 Then
MSComm1.Output = "AT+CMGW=" + lcTFDestino + vbCr
Else
MSComm1.Output = "AT+CMGS=" + lcTFDestino + vbCr
End If
Label1.Caption = MSComm1.CommEvent & " Confirmando destino"
             ' lo hago marcar durante un rato
   Dim Tiempo
   'If Len(Text2.Text) >= 80 Then
'Tiempo = 5
'Else
Tiempo = 2
'End If
   TiempoPausa = Tiempo   ' Asigna hora de inicio.
   Inicio = Timer   ' Establece la hora de inicio.
   Do While Timer < Inicio + TiempoPausa
      DoEvents   ' Cambia a otros procesos.
   Loop
   Final = Time   ' Asigna hora de finalización.
   TiempoTotal = Final - Inicio   ' Calcula tiempo total.


'Hago susutituciones de caracter para que el
'destinatario lo entienda mejor al leer, aunque no es lo suyo...
lcTexto = replace(lcTexto, "ñ", Chr(125))
lcTexto = replace(lcTexto, "@", Chr(0))
lcTexto = replace(lcTexto, "£", Chr(1))
lcTexto = replace(lcTexto, "$", Chr(2))
lcTexto = replace(lcTexto, "¥", Chr(3))
lcTexto = replace(lcTexto, "è", Chr(4))
lcTexto = replace(lcTexto, "é", Chr(5))
lcTexto = replace(lcTexto, "ù", Chr(6))
lcTexto = replace(lcTexto, "ì", Chr(7))
lcTexto = replace(lcTexto, "ò", Chr(8))
lcTexto = replace(lcTexto, "Ç", Chr(9))
'lcTexto = Replace(lcTexto, "", Chr(10)) 'LINE FEED
lcTexto = replace(lcTexto, "Ø", Chr(11))
lcTexto = replace(lcTexto, "ø", Chr(12))
'lcTexto = Replace(lcTexto, "", Chr(13)) 'CARRIAGE RETURN
lcTexto = replace(lcTexto, "Å", Chr(14))
lcTexto = replace(lcTexto, "å", Chr(15))
'lcTexto = Replace(lcTexto, "", Chr(16)) 'GREEK CAPITAL LETTER DELTA
lcTexto = replace(lcTexto, "_", Chr(17))
'lcTexto = Replace(lcTexto, "", Chr(18)) 'GREEK CAPITAL LETTER PHI
'lcTexto = Replace(lcTexto, "", Chr(19)) 'GREEK CAPITAL LETTER GAMMA
'lcTexto = Replace(lcTexto, "", Chr(20)) 'GREEK CAPITAL LETTER LAMBDA
'lcTexto = Replace(lcTexto, "", Chr(21)) 'GREEK CAPITAL LETTER OMEGA
'lcTexto = Replace(lcTexto, "", Chr(22)) 'GREEK CAPITAL LETTER PI
'lcTexto = Replace(lcTexto, "", Chr(23)) 'GREEK CAPITAL LETTER PSI
'lcTexto = Replace(lcTexto, "", Chr(24)) 'GREEK CAPITAL LETTER SIGMA
'lcTexto = Replace(lcTexto, "", Chr(25)) 'GREEK CAPITAL LETTER THETA
'lcTexto = Replace(lcTexto, "", Chr(26)) 'GREEK CAPITAL LETTER XI
'lcTexto = Replace(lcTexto, "", Chr(27)) 'ESCAPE TO EXTENSION TABLE
'0x1B14 27 20 CIRCUMFLEX ACCENT ^
'0x1B28 27 40 LEFT CURLY BRACKET {
'0x1B29 27 41 RIGHT CURLY BRACKET }
'0x1B2F 27 47 REVERSE SOLIDUS (BACKSLASH) \
'0x1B3C 27 60 LEFT SQUARE BRACKET [
'0x1B3D 27 61 TILDE ~
'0x1B3E 27 62 RIGHT SQUARE BRACKET ]
'0x1B40 27 64 VERTICAL BAR |
'0x1B65 27 101 EURO SIGN €
lcTexto = replace(lcTexto, "Æ", Chr(28))
lcTexto = replace(lcTexto, "æ", Chr(29))
lcTexto = replace(lcTexto, "ß", Chr(30))
lcTexto = replace(lcTexto, "É", Chr(31))
'lcTexto = Replace(lcTexto, "", Chr(32)) 'ESPACE
lcTexto = replace(lcTexto, "!", Chr(33))
'lcTexto = Replace(lcTexto, """, Chr(34)) 'comillas"
lcTexto = replace(lcTexto, "#", Chr(35))
lcTexto = replace(lcTexto, "¤", Chr(36))
lcTexto = replace(lcTexto, "%", Chr(37))
lcTexto = replace(lcTexto, "&", Chr(38))
lcTexto = replace(lcTexto, "'", Chr(39))
lcTexto = replace(lcTexto, "(", Chr(40))
lcTexto = replace(lcTexto, ")", Chr(41))
lcTexto = replace(lcTexto, "*", Chr(42))
lcTexto = replace(lcTexto, "+", Chr(43))
lcTexto = replace(lcTexto, ",", Chr(44))
lcTexto = replace(lcTexto, "-", Chr(45))
lcTexto = replace(lcTexto, ".", Chr(46))
lcTexto = replace(lcTexto, "/", Chr(47))
'lcTexto = Replace(lcTexto, "0", Chr(48))
'lcTexto = Replace(lcTexto, "1", Chr(49))
'lcTexto = Replace(lcTexto, "2", Chr(50))
'lcTexto = Replace(lcTexto, "3", Chr(51))
'lcTexto = Replace(lcTexto, "4", Chr(52))
'lcTexto = Replace(lcTexto, "5", Chr(53))
'lcTexto = Replace(lcTexto, "6", Chr(54))
'lcTexto = Replace(lcTexto, "7", Chr(55))
'lcTexto = Replace(lcTexto, "8", Chr(56))
'lcTexto = Replace(lcTexto, "9", Chr(57))
lcTexto = replace(lcTexto, ":", Chr(58))
lcTexto = replace(lcTexto, ";", Chr(59))
lcTexto = replace(lcTexto, "<", Chr(60))
lcTexto = replace(lcTexto, "=", Chr(61))
lcTexto = replace(lcTexto, ">", Chr(62))
lcTexto = replace(lcTexto, "?", Chr(63))
lcTexto = replace(lcTexto, "¡", Chr(64))
'lcTexto = Replace(lcTexto, "", Chr(65)) 'MAYÚSCULAS
'lcTexto = Replace(lcTexto, "", Chr(66))
'lcTexto = Replace(lcTexto, "", Chr(67))
'lcTexto = Replace(lcTexto, "", Chr(68))
'lcTexto = Replace(lcTexto, "", Chr(69))
'lcTexto = Replace(lcTexto, "", Chr(70))
'lcTexto = Replace(lcTexto, "", Chr(71))
'lcTexto = Replace(lcTexto, "", Chr(72))
'lcTexto = Replace(lcTexto, "", Chr(73))
'lcTexto = Replace(lcTexto, "", Chr(74))
'lcTexto = Replace(lcTexto, "", Chr(75))
'lcTexto = Replace(lcTexto, "", Chr(76))
'lcTexto = Replace(lcTexto, "", Chr(77))
'lcTexto = Replace(lcTexto, "", Chr(78))
'lcTexto = Replace(lcTexto, "", Chr(79))
'lcTexto = Replace(lcTexto, "", Chr(80))
'lcTexto = Replace(lcTexto, "", Chr(81))
'lcTexto = Replace(lcTexto, "", Chr(82))
'lcTexto = Replace(lcTexto, "", Chr(83))
'lcTexto = Replace(lcTexto, "", Chr(84))
'lcTexto = Replace(lcTexto, "", Chr(85))
'lcTexto = Replace(lcTexto, "", Chr(86))
'lcTexto = Replace(lcTexto, "", Chr(87))
'lcTexto = Replace(lcTexto, "", Chr(88))
'lcTexto = Replace(lcTexto, "", Chr(89))
'lcTexto = Replace(lcTexto, "", Chr(90))
lcTexto = replace(lcTexto, "Ä", Chr(91))
lcTexto = replace(lcTexto, "Ö", Chr(92))
lcTexto = replace(lcTexto, "Ñ", Chr(93))
lcTexto = replace(lcTexto, "Ü", Chr(94))
lcTexto = replace(lcTexto, "§", Chr(95))
lcTexto = replace(lcTexto, "¿", Chr(96))
'lcTexto = Replace(lcTexto, "", Chr(97)) 'minúsculas
'lcTexto = Replace(lcTexto, "", Chr(98))
'lcTexto = Replace(lcTexto, "", Chr(99))
'lcTexto = Replace(lcTexto, "", Chr(100))
'lcTexto = Replace(lcTexto, "", Chr(101))
'lcTexto = Replace(lcTexto, "", Chr(102))
'lcTexto = Replace(lcTexto, "", Chr(103))
'lcTexto = Replace(lcTexto, "", Chr(104))
'lcTexto = Replace(lcTexto, "", Chr(105))
'lcTexto = Replace(lcTexto, "", Chr(106))
'lcTexto = Replace(lcTexto, "", Chr(107))
'lcTexto = Replace(lcTexto, "", Chr(108))
'lcTexto = Replace(lcTexto, "", Chr(109))
'lcTexto = Replace(lcTexto, "", Chr(110))
'lcTexto = Replace(lcTexto, "", Chr(111))
'lcTexto = Replace(lcTexto, "", Chr(112))
'lcTexto = Replace(lcTexto, "", Chr(113))
'lcTexto = Replace(lcTexto, "", Chr(114))
'lcTexto = Replace(lcTexto, "", Chr(115))
'lcTexto = Replace(lcTexto, "", Chr(116))
'lcTexto = Replace(lcTexto, "", Chr(117))
'lcTexto = Replace(lcTexto, "", Chr(118))
'lcTexto = Replace(lcTexto, "", Chr(119))
'lcTexto = Replace(lcTexto, "", Chr(120))
'lcTexto = Replace(lcTexto, "", Chr(121))
'lcTexto = Replace(lcTexto, "", Chr(122))
lcTexto = replace(lcTexto, "ä", Chr(123))
lcTexto = replace(lcTexto, "ö", Chr(124))
lcTexto = replace(lcTexto, "ñ", Chr(125))
lcTexto = replace(lcTexto, "ü", Chr(126))
lcTexto = replace(lcTexto, "à", Chr(127))

lcTexto = replace(lcTexto, "á", Chr(127))
lcTexto = replace(lcTexto, "í", "i")
lcTexto = replace(lcTexto, "ó", Chr(8))
lcTexto = replace(lcTexto, "ú", Chr(6))
lcTexto = replace(lcTexto, "ç", Chr(9))

lcTexto = replace(lcTexto, "·", ".")
lcTexto = replace(lcTexto, "ë", "e")
lcTexto = replace(lcTexto, "ï", "i")

lcTexto = replace(lcTexto, "Á", "A")
lcTexto = replace(lcTexto, "Í", "I")
lcTexto = replace(lcTexto, "Ó", "O")
lcTexto = replace(lcTexto, "Ú", "U")

lcTexto = replace(lcTexto, "€", Chr(24))

'Texto que queremos enviar (acabado con CTRL + Z)
If Check2.Value = 0 Then
MSComm1.Output = lcTexto + Chr(26)
End If
'esto es por si pide confirmación de lectura
If Check2.Value = 1 Then
MSComm1.Output = "*N# " & lcTexto + Chr(26) 'ojo según operador podría ser *R#
End If

Label1.Caption = MSComm1.CommEvent & " Enviando SMS"

             ' lo hago esperar durante un rato rescatando la variable de más arriba
   TiempoPausa = Tiempo   ' Asigna hora de inicio.
   Inicio = Timer   ' Establece la hora de inicio.
   Do While Timer < Inicio + TiempoPausa
      DoEvents   ' Cambia a otros procesos.
   Loop
   Final = Time   ' Asigna hora de finalización.
   TiempoTotal = Final - Inicio   ' Calcula tiempo total.

   Label1.Caption = MSComm1.CommEvent & " SMS enviado con éxito..."

   If MSComm1.PortOpen = True Then
' Desconecta el módem.
Label1.Caption = " Terminado"
MSComm1.Output = "ATH" + vbCr
MSComm1.PortOpen = False
'MsgBox lcTexto + Chr(26)
End If
'lo guardo en el registro
AnadirReg

End Sub


Private Sub Command13_Click()
Form3.Text1.Visible = False
If Text3.Text = "" Then
MsgBox "No ha seleccionado un puerto para el módem o teléfono..."
Exit Sub
End If
    If Not Form1.Text3.Text = "" Then
    frmTerminal.Proceso.Visible = False
Load frmTerminal
frmTerminal.Show
    Else
    MsgBox "No ha seleccionado un puerto de comunicaciones..."
End If
End Sub

Private Sub Command14_Click()
If Text3.Text = "" Then
MsgBox "No ha seleccionado un puerto para el módem o teléfono..."
Exit Sub
End If
On Error GoTo Errr
Load frmTerminal
frmTerminal.LargoListado
frmTerminal.Show

Errr:
Exit Sub

End Sub

Private Sub Command15_Click()
If Text3.Text = "" Then
MsgBox "No ha seleccionado un puerto para el módem o teléfono..."
Exit Sub
End If
'esto es para llamar por teléfono
On Error Resume Next
Label1.Visible = True
If MSComm1.PortOpen = True Then
MsgBox "El puerto está abierto, pulse cancelar para cerrarlo, antes de volver allamar"
Exit Sub
End If
   If Not Text3.Text = "" Then
   MSComm1.CommPort = Text3.Text
   Else
   MsgBox "No ha seleccionado un puerto de comunicaciones/módem"
   Exit Sub
   End If

   ' 9600 baudios, sin paridad, 8 bits de datos y 1
    ' bit de parada.
   MSComm1.Settings = "28800,N,8,1"
   ' Indicar al control que lea todo el búfer al usar
    ' Input.
   'MSComm1.InputLen = 0
   ' Abrir el puerto.

    MSComm1.PortOpen = True
    If Err Then
       MsgBox "el puerto no está disponible. Cambie la propiedad CommPort" & _
       "a otro puerto, asegúrese que dispone de módem."
       Exit Sub
    End If



MSComm1.Output = "ATZ" + vbCr

If MSComm1.PortOpen = True Then
' Desconecta el módem.
Label1.Caption = " Terminado"
MSComm1.Output = "ATH" + vbCr
MSComm1.PortOpen = False
End If

End Sub

Private Sub Command16_Click()
' Si se especifica 1 como el segundo argumento, la aplicación se
' ejecuta normalmente y recibe el enfoque.
    ShellExecute hWnd, "open", "Registro.txt", vbNullString, vbNullString, SW_SHOW


End Sub

Private Sub Command17_Click()
Dim strURL As String
Dim bData() As Byte      ' Variable de datos
Dim intFile As Integer   ' Variable FreeFile
strURL = _
http://www.attitudeofgame.com/Soft/SMCS.txt""
intFile = FreeFile()      ' Establece intFile a un
                        ' archivo no utilizado.
' El resultado del método OpenURL va a la matriz
' de bytes y ésta se guarda entonces en disco.
bData() = Inet1.OpenURL(strURL, icByteArray)
Open App.path & "\SMCS" For Binary Access Write _
As #intFile
Put #intFile, , bData()
Close #intFile

MsgBox "Debe reiniciar el programa para que se actualicen los nuevos SMCS"
'Dim strURL As String      ' Cadena URL
'Dim intFile As Integer   ' Variable FreeFile
'intFile = FreeFile()
'strURL = "http://www.attitudeofgame.com/Soft/SMCS.txt"
'Open App.path & "\SMCS" For Output _
'As #intFile
'Write #intFile, Inet1.OpenURL(strURL)
'Close #intFile

End Sub

Private Sub Command2_Click()
'esto es para salir
If MSComm1.PortOpen = True Then
' Desconecta el módem.
Label1.Caption = " Terminado"
MSComm1.Output = "ATH" + vbCr
MSComm1.PortOpen = False
End If
End
End Sub


Private Sub Command3_Click()
'esto es para detectar el módem
Label1.Visible = True
On Error Resume Next
Port = 1
If Check8.Value = 1 Then
Port = 2
End If
PortinG:
MSComm1.CommPort = Port
MSComm1.PortOpen = True


Form1.MSComm1.Settings = "9600,N,8,1"
MSComm1.Output = "AT" + Chr$(13)
X = 1

Do: DoEvents
X = X + 1
If X = 1000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 2000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 3000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 4000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 5000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 6000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 7000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 8000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 9000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 10000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 11000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 12000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 13000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 14000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 15000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 16000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 17000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 18000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 19000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 20000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 21000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 22000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 23000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 24000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 25000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 26000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 27000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 28000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 29000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 30000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 31000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 32000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 33000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 34000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 35000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 36000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 37000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 38000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 39000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 40000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 41000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 42000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 43000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 44000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 45000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 46000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 47000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 48000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 49000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 50000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 51000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 52000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 53000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 54000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 55000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 56000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 57000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 58000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 59000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 60000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 61000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 62000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 63000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 64000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 65000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 66000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 67000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 68000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 69000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 70000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 71000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 72000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 73000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 74000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 75000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 76000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 77000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 78000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 79000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 80000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 81000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 82000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 83000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 84000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 85000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 86000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 87000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 88000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 89000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 90000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 91000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 92000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 93000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 94000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 95000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 96000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 97000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 98000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 99000 Then MSComm1.Output = "AT" + Chr$(13)
If X = 100000 Then MSComm1.Output = "AT" + Chr$(13)

If X = 100000 Then
MSComm1.PortOpen = False
Port = Port + 1
Label1.Caption = " Puerto: " & Port
If Port >= 100 Then
GoTo Errr
End If
GoTo PortinG:


If MSComm1.CommPort >= 100000 Then
Errr:
MsgBox Err.Description & ", No se ha detectado ningún puerto rastreando 100 puertos." & _
Si Vd. conoce el puerto de su módem indíquelo en la casilla ´´Puerto COM:´´ manualmente...""


End If

End If

Loop Until MSComm1.InBufferCount >= 2

InString = MSComm1.Input
MSComm1.PortOpen = False
Label1.Caption = "Com " & MSComm1.CommPort & " , se detectó un módem..."
MsgBox "Módem Localizado en el Comm " & Port
If Port = 1 Or Port = 2 Then
MsgBox "Los puertos Com1 y Com2, suelen ser puertos reservados" & _
si Vd. tiene un Módem analógico instalado," & _"
es posible que dicho módem no sea compatible con GSM," & _"
se aconseja descartar los puertos 1 y 2.""
End If
Text3.Text = Port

End Sub


Private Sub Command4_Click()
'esto es para cancelar
If MSComm1.PortOpen = True Then
' Desconecta el módem.
Label1.Caption = " Cancelando..."
'MSComm1.Output = "AT" + vbCr
MSComm1.Output = "ATH" + vbCr
MSComm1.PortOpen = False
MsgBox "Cancelado, por el usuario ó error en el envío del SMS..."
Label1.Visible = False
End If

End Sub


Private Sub Command5_Click()
'abre la agenda, Form2
Label1.Visible = True
Form2.Show
End Sub

Private Sub Command6_Click()
If Text3.Text = "" Then
MsgBox "No ha seleccionado un puerto para el módem o teléfono..."
Exit Sub
End If
'esto es para llamar por teléfono
On Error Resume Next
Label1.Visible = True
If MSComm1.PortOpen = True Then
MsgBox "El puerto está abierto, pulse cancelar para cerrarlo, antes de volver allamar"
Exit Sub
End If
   If Not Text3.Text = "" Then
   MSComm1.CommPort = Text3.Text
   Else
   MsgBox "No ha seleccionado un puerto de comunicaciones/módem"
   Exit Sub
   End If
   If Text1.Text = "" Then
   MsgBox "No ha indicado un número de teléfono de destino..."
   Exit Sub
   End If
   If Check1.Value = 0 And Check4.Value = 0 Then
MsgBox "Debe seleccionar el tipo de llamada..."
Exit Sub
End If
   ' 9600 baudios, sin paridad, 8 bits de datos y 1
    ' bit de parada.
   MSComm1.Settings = "28800,N,8,1"
   ' Indicar al control que lea todo el búfer al usar
    ' Input.
   'MSComm1.InputLen = 0
   ' Abrir el puerto.

    MSComm1.PortOpen = True
    If Err Then
       MsgBox "el puerto no está disponible. Cambie la propiedad CommPort" & _
       "a otro puerto, asegúrese que dispone de módem."
       Exit Sub
    End If

    MSComm1.NullDiscard = False
    MSComm1.Handshaking = comNone

Dim lcTFDestino
lcTFDestino = Text1.Text

If Check1.Value = 0 And Check4.Value = 1 Then
MSComm1.Output = "ATDT" + lcTFDestino + ";" + vbCr
End If
If Check1.Value = 1 And Check4.Value = 0 Then
MSComm1.Output = "ATDT" + lcTFDestino + vbCr
End If
             ' lo hago marcar durante un rato
   TiempoPausa = 1   ' Asigna hora de inicio.
   Inicio = Timer   ' Establece la hora de inicio.
   Do While Timer < Inicio + TiempoPausa
      DoEvents   ' Cambia a otros procesos.
   Loop
   Final = Time   ' Asigna hora de finalización.
   TiempoTotal = Final - Inicio   ' Calcula tiempo total.

Label1.Caption = "Efectuando llamada, pulse Cancelar para terminar..."
End Sub

Private Sub Command7_Click()
'esto es para ver la ayuda, abre el archivo readme.mht
On Error GoTo Error
         Dim X As Long
    ShellExecute hWnd, "open", "Readme.mht", vbNullString, vbNullString, SW_SHOW
Exit Sub

Error:
MsgBox "Se ha producido un error, y no he podido lanzar el archivo."
End Sub

Private Sub Command8_Click()
'Primero declaro las variables
Dim LargoSMCS, InterNacSMCS, SMCS, DigitosA, DigitosB, LargoTel, InterNacTel
Dim Telefono, PID, Formato, Caducidad, LargoMensaje, Mensaje, LargoMensajeTel, TotalSMS

' primero  calculo el largo del SMCS, si no utiliza SMCS el resulatdo es: 00
If Combo2.Text = "" Then
LargoSMCS = "00"
Else
LargoSMCS = "0" & Round((Len(Combo2.Text) / 2) + 1)
End If

' segundo compruebo si el SMCS es internacional o nacional,
'buscando el signo + = "Internacional, si no usa SMCS el resultado es = vacío"
If Combo2.Text = "" Then
InterNacSMCS = ""
Else
InterNacSMCS = Left(Combo2.Text, 1)
If InterNacSMCS = "+" Then
InterNacSMCS = "91"
Else
InterNacSMCS = "92"
End If
End If

' tercero capturo el SMCS invirtiendo cada 2 dígitos y si es impar le añado la F rastreadora
' antes compruebo si usa el SMCS del móvil, si lo usa el resultado es: vacío
If Combo2.Text = "" Then
SMCS = ""
Else
Dim intCt As Integer
Dim strNew As String
Dim MiCadena, i, Invertido, Decena
i = 1
MiCadena = Combo2.Text
MiCadena = replace(MiCadena, "+", "")
If Not Round(Len(MiCadena) / 2) = Len(MiCadena) / 2 Then
MiCadena = MiCadena & "F"
End If
Do While i <= Len(MiCadena)
Decena = Mid(MiCadena, i, 2)
For intCt = 1 To Len(Decena)
strNew = Mid$(Decena, intCt, 1) & strNew
Next
SMCS = SMCS & Mid(strNew, 1, 2)
i = i + 2
Loop
End If

' cuarto y quinto añado los dígito 1100, no se exactamente que hacen pero deben estar
DigitosA = "11"
DigitosB = "00"

' sexto pongo el largo del teléfono de destino en hexadecimal, elimino el + igual que en el SMCS
LargoTel = replace(Text1.Text, "+", "")
LargoTel = "0" & Hex(Len(LargoTel))
If LargoTel = 0 Then
LargoTel = "00"
End If

' y septimo indico si es Internacional o Nacional 91=Inter
Dim CInter2
CInter2 = Left(Text1.Text, 1)
If CInter2 = "+" Then
CInter2 = "91"
Else
CInter2 = "92"
End If
InterNacTel = CInter2

' obtavo capturo el teléfono de destino invirtiendo cada 2 dígitos y si es impar le añado la F rastreadora
' antes compruebo si está vacío, si lo usa el resultado es: vacío
If Text1.Text = "" Then
Telefono = ""
Else
'Dim intCtb As Integer
'Dim strNewb As String
'Dim MiCadenab, ib, Decenab
i = 1
MiCadena = Text1.Text
MiCadena = replace(MiCadena, "+", "")
If Not Round(Len(MiCadena) / 2) = Len(MiCadena) / 2 Then
MiCadena = MiCadena & "F"
End If
Do While i <= Len(MiCadena)
Decena = Mid(MiCadena, i, 2)
For intCt = 1 To Len(Decena)
strNew = Mid$(Decena, intCt, 1) & strNew
Next
Telefono = Telefono & Mid(strNew, 1, 2)
i = i + 2
Loop
End If

' Noveno añado los dos dígitos del protocolo de identificación,
'pongo 00 para no caxxxla, ya que no conozco como funciona
PID = "00"

' décimo añado los dígitos que indica el formato del sms:
'7 bits, 8 bits o 16 bits ---> 00 , 04, 08
If Check6.Value = 1 Then
Formato = "08" '16 bits
End If
If Check7.Value = 1 Then
Formato = "04" '8 bits
End If
If Check7.Value = 0 And Check6.Value = 0 Then
Formato = "00" '7 bits
End If

'decimoprimero añado el plazo de entrega, pongo AA que es 4 días, ya que no conozco otros
Caducidad = "AA"

'decimosegundo añado el largo del mensaje en hexadecimal, si no hay nada el valor es 00
LargoMensaje = Hex((Len(Text2.Text)) * 2)
If Len(LargoMensaje) < 2 Then
LargoMensaje = "0" & LargoMensaje
End If

'decimotercero convierto el texto del mansaje a hexadecimal con los 00 delante de cada letra
Mensaje = ""
Dim MiCadenaDeBytes() As Byte
MiCadenaDeBytes = Text2.Text
For i = LBound(MiCadenaDeBytes) To (UBound(MiCadenaDeBytes) - 1)
If Not Hex(MiCadenaDeBytes(i)) = 0 Then
If Hex(MiCadenaDeBytes(i)) = "AC" Then
Mensaje = Mensaje & "20" & Left(Hex(MiCadenaDeBytes(i)), 4)
Else
If Hex(MiCadenaDeBytes(i)) = "D" Then
Mensaje = Mensaje & "000" & Left(Hex(MiCadenaDeBytes(i)), 4)
Else
If Hex(MiCadenaDeBytes(i)) = "A" Then
Mensaje = Mensaje & "000" & Left(Hex(MiCadenaDeBytes(i)), 4)
Else
Mensaje = Mensaje & "00" & Left(Hex(MiCadenaDeBytes(i)), 4)
End If
End If
End If
End If
Next
'Ahora elimino los dobles espacios del mansaje y arreglo el espacio de después del €
Mensaje = replace(Mensaje, "20AC0020", "20AC")
Mensaje = replace(Mensaje, "00200020", "0020")

'decimocuarto recojo el largo total del mensaje y el largo del teléfono ya
'invertido y con la F, si el teléfono y el mensaje están vacíos el valor es 8
If Text1.Text = "" And Text2.Text = "" Then
LargoMensajeTel = "8"
Else
LargoMensajeTel = ((Len(Telefono) / 2) + (Len(Mensaje) / 2)) + 8
End If

'ahora juntamos todo el mensaje menos LargoMensajeTel , que lo dejamos para luego
TotalSMS = LargoSMCS & InterNacSMCS & SMCS & DigitosA & DigitosB & LargoTel & _
InterNacTel & Telefono & PID & Formato & Caducidad & LargoMensaje & Mensaje

'ahora si ya lo terminamos
Dim Envio
If Check5.Value = 1 Then
Envio = "AT+CMGW="
Else
Envio = "AT+CMGS="
End If
Text4.Text = Envio & LargoMensajeTel & Chr(13)
Text4.Text = Text4.Text & TotalSMS
End Sub

Private Sub Command9_Click()
'Primero declaro las variables
Dim LargoSMCS, InterNacSMCS, SMCS, DigitosA, DigitosB, LargoTel, InterNacTel
Dim Telefono, PID, Formato, Caducidad, LargoMensaje, Mensaje, LargoMensajeTel, TotalSMS

' primero  calculo el largo del SMCS, si no utiliza SMCS el resulatdo es: 00
If Combo2.Text = "" Then
LargoSMCS = "00"
Else
LargoSMCS = "0" & Round((Len(Combo2.Text) / 2) + 1)
End If

' segundo compruebo si el SMCS es internacional o nacional,
'buscando el signo + = "Internacional, si no usa SMCS el resultado es = vacío"
If Combo2.Text = "" Then
InterNacSMCS = ""
Else
InterNacSMCS = Left(Combo2.Text, 1)
If InterNacSMCS = "+" Then
InterNacSMCS = "91"
Else
InterNacSMCS = "92"
End If
End If

' tercero capturo el SMCS invirtiendo cada 2 dígitos y si es impar le añado la F rastreadora
' antes compruebo si usa el SMCS del móvil, si lo usa el resultado es: vacío
If Combo2.Text = "" Then
SMCS = ""
Else
Dim intCt As Integer
Dim strNew As String
Dim MiCadena, i, Invertido, Decena
i = 1
MiCadena = Combo2.Text
MiCadena = replace(MiCadena, "+", "")
If Not Round(Len(MiCadena) / 2) = Len(MiCadena) / 2 Then
MiCadena = MiCadena & "F"
End If
Do While i <= Len(MiCadena)
Decena = Mid(MiCadena, i, 2)
For intCt = 1 To Len(Decena)
strNew = Mid$(Decena, intCt, 1) & strNew
Next
SMCS = SMCS & Mid(strNew, 1, 2)
i = i + 2
Loop
End If

' cuarto y quinto añado los dígito 1100, no se exactamente que hacen pero deben estar
DigitosA = "11"
DigitosB = "00"

' sexto pongo el largo del teléfono de destino en hexadecimal, elimino el + igual que en el SMCS
LargoTel = replace(Text1.Text, "+", "")
LargoTel = Hex(Len(LargoTel))
If LargoTel = 0 Then
LargoTel = "00"
End If

' y septimo indico si es Internacional o Nacional 91=Inter
Dim CInter2
CInter2 = Left(Text1.Text, 1)
If CInter2 = "+" Then
CInter2 = "91"
Else
CInter2 = "92"
End If
InterNacTel = CInter2

' obtavo capturo el teléfono de destino invirtiendo cada 2 dígitos y si es impar le añado la F rastreadora
' antes compruebo si está vacío, si lo usa el resultado es: vacío
If Text1.Text = "" Then
Telefono = ""
Else
'Dim intCtb As Integer
'Dim strNewb As String
'Dim MiCadenab, ib, Decenab
i = 1
MiCadena = Text1.Text
MiCadena = replace(MiCadena, "+", "")
If Not Round(Len(MiCadena) / 2) = Len(MiCadena) / 2 Then
MiCadena = MiCadena & "F"
End If
Do While i <= Len(MiCadena)
Decena = Mid(MiCadena, i, 2)
For intCt = 1 To Len(Decena)
strNew = Mid$(Decena, intCt, 1) & strNew
Next
Telefono = Telefono & Mid(strNew, 1, 2)
i = i + 2
Loop
End If

' Noveno añado los dos dígitos del protocolo de identificación,
'pongo 00 para no caxxxla, ya que no conozco como funciona
PID = "00"

' décimo añado los dígitos que indica el formato del sms:
'7 bits, 8 bits o 16 bits ---> 00 , 04, 08
If Check6.Value = 1 Then
Formato = "08" '16 bits
End If
If Check7.Value = 1 Then
Formato = "04" '8 bits
End If
If Check7.Value = 0 And Check6.Value = 0 Then
Formato = "00" '7 bits
End If

'decimoprimero añado el plazo de entrega, pongo AA que es 4 días, ya que no conozco otros
Caducidad = "AA"

'decimosegundo añado el largo del mensaje en hexadecimal, si no hay nada el valor es 00
LargoMensaje = Hex((Len(Text2.Text)) * 2)
If Len(LargoMensaje) < 2 Then
LargoMensaje = "0" & LargoMensaje
End If

'decimotercero convierto el texto del mansaje a hexadecimal con los 00 delante de cada letra
Mensaje = ""
Dim MiCadenaDeBytes() As Byte
MiCadenaDeBytes = Text2.Text
For i = LBound(MiCadenaDeBytes) To (UBound(MiCadenaDeBytes) - 1)
If Not Hex(MiCadenaDeBytes(i)) = 0 Then
If Hex(MiCadenaDeBytes(i)) = "AC" Then
Mensaje = Mensaje & "20" & Left(Hex(MiCadenaDeBytes(i)), 4)
Else
If Hex(MiCadenaDeBytes(i)) = "D" Then
Mensaje = Mensaje & "0" & Left(Hex(MiCadenaDeBytes(i)), 4)
Else
If Hex(MiCadenaDeBytes(i)) = "A" Then
Mensaje = Mensaje & "0" & Left(Hex(MiCadenaDeBytes(i)), 4)
Else
Mensaje = Mensaje & Left(Hex(MiCadenaDeBytes(i)), 4)
End If
End If
End If
End If
Next
'Ahora elimino los dobles espacios del mansaje y arreglo el espacio de después del €
Mensaje = replace(Mensaje, "AC20", "AC")
Mensaje = replace(Mensaje, "2020", "20")

'decimocuarto recojo el largo total del mensaje y el largo del teléfono
'ya invertido y con la F, si el teléfono y el mensaje están vacíos el valor es 8
If Text1.Text = "" And Text2.Text = "" Then
LargoMensajeTel = "8"
Else
LargoMensajeTel = ((Len(Telefono) / 2) + (Len(Mensaje) / 2)) + 8
End If

'ahora juntamos todo el mensaje menos LargoMensajeTel , que lo dejamos para luego
TotalSMS = LargoSMCS & InterNacSMCS & SMCS & DigitosA & DigitosB & LargoTel & InterNacTel & _
Telefono & PID & Formato & Caducidad & LargoMensaje & Mensaje

'ahora si ya lo terminamos
Dim Envio
If Check5.Value = 1 Then
Envio = "AT+CMGW="
Else
Envio = "AT+CMGS="
End If
Text4.Text = Envio & LargoMensajeTel & Chr(13)
Text4.Text = Text4.Text & TotalSMS
End Sub

Private Sub Form_Activate()
'relleno el combolist de la agenda
'Combo1.Clear
Dim miAgenda
Dim MiRuta, MiNombre
MiRuta = App.path & ("\Agenda\") ' Establece la ruta.
MiNombre = Dir(MiRuta, vbFile)   ' Recupera la primera entrada.

             ' lo hago esperar durante un rato
   TiempoPausa = 1   ' Asigna hora de inicio.
   Inicio = Timer   ' Establece la hora de inicio.
   Do While Timer < Inicio + TiempoPausa
      DoEvents   ' Cambia a otros procesos.
   Loop
   Final = Time   ' Asigna hora de finalización.
   TiempoTotal = Final - Inicio   ' Calcula tiempo total.


Registro
End Sub


Private Sub Form_Unload(Cancel As Integer)
End
End Sub





Private Sub Text2_Change()
'esto es para contar los caracteres que puede escribir el el cuerpo del mensaje
Label4.Caption = "Quedan " & 160 - Len(Text2.Text) & " caracteres..."
If Len(Text2.Text) >= 160 Then
MsgBox "No puede escribir más de 160 caracteres..."
End If
If Check2.Value = 1 Then
Text2.MaxLength = 156
If Len(Text2.Text) >= 156 Then
MsgBox "No puede escribir más de 156 caracteres, al solicitar confirmación de lectura..."
End If
End If

'esto es para contar los caracteres que puede escribir el el cuerpo
'del mensaje en caso de tener seleccionado los 16 bits
If Check6.Value = 1 Then
Label4.Caption = "Quedan " & 70 - Len(Text2.Text) & " caracteres..."
If Len(Text2.Text) >= 70 Then
MsgBox "No puede escribir más de 70 caracteres, en formato 16 bits..."
End If
End If

End Sub




Private Sub Registro()

'comprobamos que exista el archivo de registro y si no lo creamos
On Error Resume Next
    Const ForReading = 1, ForWriting = 2, ForAppending = 3
    Dim fs3, a3, miPrueba
        Set fs3 = CreateObject("Scripting.FileSystemObject")
    Set a3 = fs3.OpenTextFile(App.path & "\Registro.txt", 1)
    miPrueba = a3.readline
    a3.Close
    If miPrueba = "" Then
    Set a3 = fs3.CreateTextFile(App.path & "\Registro.txt")
    a3.WriteLine "Archivo de mensajes..." & vbCr
    a3.WriteBlankLines (3)
    a3.Close
    End If

'AnadirReg


End Sub
Private Sub AnadirReg()

'Si existe añadimos el registro de este mensaje
    'Const ForReading = 1, ForWriting = 2, ForAppending = 3
    Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
    Dim fs, f, ts, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(App.path & "\Registro.txt")
    Set ts = f.OpenAsTextStream(8, TristateUseDefault)
    ts.Write "--------------------------------------------------"
    ts.WriteBlankLines (1)
    ts.Write "Enviado el: " & Date & " a las " & Time
    ts.WriteBlankLines (1)
    ts.Write "Destinatario: " & Combo1.Text
    ts.WriteBlankLines (1)
    ts.Write "Teléfono: " & Text1.Text
    ts.WriteBlankLines (1)
    If Check3.Value = 1 Then
    ts.Write "Centro Servicio SMCS: Por defecto el del móvil / módem."
    ts.WriteBlankLines (1)
    Else
    ts.Write "Centro Servicio SMCS: " & Combo2.Text
    ts.WriteBlankLines (1)
    End If
    If Check6.Value = 1 Then
    ts.Write "Formato del SMS: 16 Bits"
    ts.WriteBlankLines (1)
    End If
    If Check7.Value = 1 Then
    ts.Write "Formato del SMS: 8 Bits"
    ts.WriteBlankLines (1)
    End If
    If Not Check6.Value = 1 And Not Check7.Value = 1 Then
    ts.Write "Formato del SMS: Texto / 7 Bits"
    ts.WriteBlankLines (1)
    End If
    If Check2.Value = 1 Then
    ts.Write "Confirmación de lectura: Si"
    ts.WriteBlankLines (1)
    End If
    If Check2.Value = 0 Then
    ts.Write "Confirmación de lectura: No"
    ts.WriteBlankLines (1)
    End If
    If Check5.Value = 1 Then
    ts.Write "El SMS se guardó en la memoría SIM del móvil, no queda constancia de su envío."
    ts.WriteBlankLines (2)
    End If
    ts.Write "Mensaje: "
    ts.WriteBlankLines (1)
    ts.Write Text2.Text
    ts.WriteBlankLines (1)
    ts.Write "--------------------------------------------------"
    ts.WriteBlankLines (3)
    ts.Close




End Sub

Nota:
Si utilizas el rastreador de puertos, este buscará hasta encontrar el primer puerto existente, sea o no sea el de tu móvil. Por eso te recomiendo que lo ingreses a mano o modifiques el código, para que siga buscando hasta que de con el puerto correcto, pero es más práctico ponerlo manualmente.

Un ejemplo de adaptación a VB.NET

Private Sub EnvioPDU() '16 bits


        Try
            'Cursor = Cursors.WaitCursor
            TextBox_AT.Text = ""
            Label_INFO.Text = "Nuevo mensaje."
            If Not ComboBoxCOM.Text = "" Then
                SerialPort1.PortName = ComboBoxCOM.Text
            Else
                MsgBox("No ha seleccionado un puerto de comunicaciones/módem")
                Exit Sub
            End If
            If ComboBox_TEL.Text = "" Then
                MsgBox("No ha indicado un número de teléfono de destino...")
                Exit Sub
            End If
            If Text_MENSAJE.Text = "" Then
                MsgBox("No ha escrito ningún texto para el cuerpo del mensaje...")
                Exit Sub
            End If

            SerialPort1.Open()

            'probamos el modem
            SerialPort1.WriteLine("AT" & vbCr)



            'selecciono formato texto para enviar el SMS en PDU
            SerialPort1.WriteLine("AT+CMGF=0" & vbCr)

            Label_INFO.Text = "Confirmando formato del SMS."

            Label_INFO.Refresh()
            'Primero declaro las variables
            Dim LargoMensajeTel, LargoMensaje, Formato, Telefono, LargoTel, DigitosA, InterNacSMCS As String
			Dim LargoSMCS, SMCS, DigitosB, InterNacTel, PID, Caducidad, Mensaje, TotalSMS As String

            LargoMensajeTel = ""
            LargoMensaje = ""
            Formato = ""
            Telefono = ""
            LargoTel = ""
            DigitosA = ""
            InterNacSMCS = ""
            LargoSMCS = ""
            SMCS = ""
            DigitosB = ""
            InterNacTel = ""
            PID = ""
            Caducidad = ""
            Mensaje = ""
            TotalSMS = ""

            ' primero  calculo el largo del SMCS, si no utiliza SMCS el resultado es: 00


            LargoSMCS = "00"


            ' segundo compruebo si el SMCS es internacional o nacional, buscando el
'signo + = "Internacional, si no usa SMCS el resultado es = vacío"


            InterNacSMCS = ""


            ' tercero capturo el SMCS invirtiendo cada 2 dígitos y si es impar le añado la F rastreadora
            ' antes compruebo si usa el SMCS del móvil, si lo usa el resultado es: vacío


            Dim strNew As String = ""
            Dim MiCadena As String
            Dim i As Integer
            Dim Decena As String

            SMCS = ""


            ' cuarto y quinto añado los dígito 1100, no se exactamente que hacen pero deben estar

            DigitosA = "11"

            DigitosB = "00"

            ' sexto pongo el largo del teléfono de destino en hexadecimal, elimino el + 
            Dim PreTel As String = TextBox_INTER.Text & ComboBox_TEL.Text
            LargoTel = Replace(PreTel, "+", "")


            LargoTel = "0" & Hex(Len(LargoTel))

            If LargoTel = "0" Then

                LargoTel = "00"
            End If

            ' y septimo indico si es Internacional o Nacional 91=Inter
            Dim CInter As String

            CInter = VB.Left(TextBox_INTER.Text & ComboBox_TEL.Text, 1)

            If CInter = "+" Then

                CInter = "91"
            Else
                'CInter = "92"
                CInter = "00"
            End If

            InterNacTel = CInter

            ' obtavo capturo el teléfono de destino invirtiendo cada 2 dígitos y si es impar
'le añado la F rastreadora antes compruebo si está vacío, si lo usa el resultado es: vacío
            If ComboBox_TEL.Text = "" Then
                Telefono = ""
            Else

                i = 1

                MiCadena = Trim(TextBox_INTER.Text & ComboBox_TEL.Text)

                MiCadena = Replace(MiCadena, "+", "")
                If Not System.Math.Round(Len(MiCadena) / 2) = Len(MiCadena) / 2 Then
                    'si es impar F rastreadora
                    MiCadena = MiCadena & "F"
                End If

                Do While i <= Len(MiCadena)

                    Decena = Mid(MiCadena, i, 2)
                    For intCt = 1 To Len(Decena)
                        strNew = Mid(Decena, intCt, 1) & strNew
                    Next
                    Telefono = Telefono & Mid(strNew, 1, 2)
                    i = i + 2
                Loop

            End If

            ' Noveno añado los dos dígitos del protocolo de identificación,
'pongo 00 para no cagarla, ya que no conozco como funciona

            PID = "00"

            ' décimo añado los dígitos que indica el formato del sms: 7 bits, 8 bits o 16 bits ---> 00 , 04, 08
            If Check16b.CheckState = 1 Then
                Formato = "08" '16 bits
            End If
            If Check7b.CheckState = 1 Then
                Formato = "00" '7 bits
            End If



            'decimoprimero añado el plazo de entrega, AA que es 4 días, hay otros, yo soy chulo 00

            Caducidad = "00"

            'decimosegundo añado el largo del mensaje en hexadecimal, si no hay nada el valor es 00
            If CheckRECIBO.CheckState = 1 Then
                LargoMensaje = Hex((Len(TextBox_RECIBO.Text & Text_MENSAJE.Text)) * 2)
            Else
                LargoMensaje = Hex((Len(Text_MENSAJE.Text)) * 2)
            End If

            If Len(LargoMensaje) < 2 Then
                LargoMensaje = "0" & LargoMensaje
            End If

            'decimotercero convierto el texto del mansaje a hexadecimal con los 00 delante de cada letra

            Mensaje = ""
            Dim texto As String = Text_MENSAJE.Text
            Dim MiCadenaDeBytes() As Byte

            'Un usuario de www.houserentalbook.com le ha escrito, revise su correo.
            If CheckRECIBO.CheckState = 1 Then
                texto = TextBox_RECIBO.Text & " " & texto
            End If

            MiCadenaDeBytes = System.Text.UnicodeEncoding.Unicode.GetBytes(texto)

            For i = LBound(MiCadenaDeBytes) To (UBound(MiCadenaDeBytes) - 1)
                'On Error Resume Next
                If Not (Hex(MiCadenaDeBytes(i)).ToString) = "0" Then
                    'If Not CDbl(Hex(MiCadenaDeBytes(i))) = 0 Then
                    If Hex(MiCadenaDeBytes(i).ToString) = "AC" Then
                        Mensaje = Mensaje & "20" & VB.Left(Hex(MiCadenaDeBytes(i).ToString), 4)
                    Else
                        If Hex(MiCadenaDeBytes(i).ToString) = "D" Then
                            Mensaje = Mensaje & "000" & VB.Left(Hex(MiCadenaDeBytes(i).ToString), 4)
                        Else
                            If Hex(MiCadenaDeBytes(i).ToString) = "A" Then
                                Mensaje = Mensaje & "000" & VB.Left(Hex(MiCadenaDeBytes(i).ToString), 4)
                            Else
                                Mensaje = Mensaje & "00" & VB.Left(Hex(MiCadenaDeBytes(i).ToString), 4)
                            End If
                        End If
                    End If
                End If
            Next

            'Ahora elimino los dobles espacios del mensaje y arreglo el espacio de después del €
            Mensaje = Replace(Mensaje, "20AC0020", "20AC")
            Mensaje = Replace(Mensaje, "00200020", "0020")

            'decimocuarto recojo el largo total del mensaje y el largo del teléfono ya
'invertido y con la F, si el teléfono y el mensaje están vacíos el valor es 8
            If ComboBox_TEL.Text = "" And Text_MENSAJE.Text = "" Then
                LargoMensajeTel = "8"
            Else
                LargoMensajeTel = ((Len(Telefono) / 2) + (Len(Mensaje) / 2)) + 8
            End If

            'ahora juntamos todo el mensaje menos LargoMensajeTel , que lo dejamos para luego

            TotalSMS = LargoSMCS & InterNacSMCS & SMCS & DigitosA & DigitosB & LargoTel & InterNacTel & _
Telefono & PID & Formato & Caducidad & LargoMensaje & Mensaje

            'ahora si ya lo terminamos
            'envío el mensaje
            Label_INFO.Text = "Comunicando con el módem..."

            If CheckSIM.CheckState = 1 Then

                SerialPort1.WriteLine("AT+CMGW=" & LargoMensajeTel & vbCr)

                Label_INFO.Refresh()
            End If
            If CheckSIM.CheckState = 0 Then

                SerialPort1.WriteLine("AT+CMGS=" & LargoMensajeTel & vbCr)

                Label_INFO.Refresh()
            End If

            'TextBox_AT.Text = TextBox_AT.Text & vbCrLf & SerialPort1.ReadLine

            SerialPort1.WriteLine(TotalSMS + Chr(26))




            TextBox_AT.Refresh()



            'leer_SerialPort1()
            Thread.Sleep(5000)
            Dim buffer As String
            buffer = SerialPort1.ReadExisting()
            TextBox_AT.Text = buffer.ToString()
            'cerramos la conexión

            SerialPort1.Close()

            'informo al usuario
            If CheckSIM.CheckState = 1 Then
                Label_INFO.Text = "SMS GUARDADO EN SIM, ENVÍO PENDIENTE, en formato 16 bits..."
            End If
            If CheckSIM.CheckState = 0 Then
                Label_INFO.Text = "SMS ENVIADO, en formato 16 bits..."
            End If
            Label_INFO.Refresh()




            'lo guardo en el registro
            AnadirReg()
            Cursor = Cursors.Default
        Catch ex As Exception
            SerialPort1.Close()
            MessageBox.Show("ERROR al conectar o recuperar los datos: " & SerialPort1.PortName.ToString & vbCrLf & _
            ex.Message, "Conectar con dispositivo GSM.", _
        MessageBoxButtons.OK, MessageBoxIcon.Error)
        End Try

 

Info sobre comandos AT y PDU.

No puedo ponerte todos los enlaces que encontré sobre este tema, pero una sencilla búsqueda en google, te facilitará información, para saciar tus necesidades: http://www.google.es/search?hl=es&q=format+PDU&btnG=Buscar&meta=lr%3Dlang_es&aq=f&oq=

 


Espacios de nombres usados en el código de este artículo:

Para esta versión VB6, como es evidente sólo debes utilizar MSComm, no se importan espacios de nombres.
Si lo adaptas a VB.NET te será necesario:

System.Threading
System.IO.Ports

 



Compromiso del autor del artículo con el sitio del Guille:

Lo comentado en este artículo está probado (y funciona) con la siguiente configuración:

El autor se compromete personalmente de que lo expuesto en este artículo es cierto y lo ha comprobado usando la configuración indicada anteriormente.

En cualquier caso, el Guille no se responsabiliza del contenido de este artículo.

Si encuentras alguna errata o fallo en algún link (enlace), por favor comunícalo usando este link:

Gracias.


Código de ejemplo (comprimido):

 

Fichero con el código de ejemplo: feli3171_smssenderVB6_01.zip - 357 KB

(MD5 checksum: D29867BBD13B889E341C009B8A1020B0)

 


Ir al índice principal de el Guille