IntroducciónAquí 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.
ContenidoSin 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: 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: 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: 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. System.Threading
|
