关于VB6.0编写手机短信发送

Question

自己正在编写
开发语言：VB6.0
开发环境：Windows
运行环境：windows
运行要求：带串口的电脑一台，手机一部，手机数据线一条
操作方法：将收发短信的手机通过手机数据线接到电脑的串口，运行该软件的可执行程序即可进行接收和发送短信
自己写的有问题,屡试不爽,有哪位前辈有源码,发出来或是[email protected]，俺参考一下!!

Answer 1

发一个模块
Option Explicit'****************************************
'public type
'****************************************
Public Type rasentryname95
   dwsize               As Long
   szentryname(ras95_maxentryname) As Byte
End Type
'#######################"
Public Type rasdialparam95
   'dwsize = 1052
   dwzise               As Long
   szentryname(ras95_maxentryname) As Byte
   szphonenumber(ras_maxphonenumber) As Byte
   szcallbacknumber(ras95_maxcallbacknumber) As Byte
   SZUSERNAME(unlen)    As Byte
   szpassword(pwlen)    As Byte
   szdomain(dnlen)      As Byte
End Type
'#######################"
Public Type rasconn95
   dwsize               As Long
   hRascon              As Long
   szentryname(ras95_maxentryname) As Byte
   szdevicetype(ras95_maxdevicetype) As Byte
   szdevicename(ras95_maxdevicename) As Byte
End Type
'#######################"
Public Type rasconnstatus95
   dwsize               As Long
   rasconnstate         As Long
   dwerror              As Long
   szdevicetype(ras95_maxdevicetype) As Byte
   szdevicename(ras95_maxdevicename) As Byte
End Type
'#######################"'****************************************
'variables
'****************************************
Public ras95_entryname(ras95_maxentryname) As rasentryname95
Public handle           As Long
Public status           As Long
Public szentryname(ras95_maxentryname) As BytePublic Function isconnected() As Boolean
   Dim trascon(255)     As rasconn95
   Dim lg               As Long
   Dim lpcon            As Long
   Dim retval           As Long
   Dim tstatus          As rasconnstatus95
   '
   trascon(0).dwsize = 412
   lg = 256 * trascon(0).dwsize
   '
   retval = RasEnumConnections(trascon(0), lg, lpcon)
   If retval <> 0 Then
      MsgBox "Problème!!!"
      Exit Function
   End If
   ' if retval <> 0 alors erreur
   ' if trascon(0).hrascon <> 0 alors le port est ouvert
   handle = trascon(0).hRascon
   tstatus.dwsize = 160
   retval = RasGetConnectStatus(handle, tstatus)
   status = tstatus.rasconnstate
   If status = 5 Or status = 8193 Or status = &H2000 Then
      isconnected = True
   Else
      isconnected = False
   End If
End FunctionPublic Sub sauve()
   SaveSetting "raservice", "provider", "provider", PROVIDER
   SaveSetting "raservice", "provider", "login", LOGIN
   SaveSetting "raservice", "provider", "psw", PASSWORD
   SaveSetting "raservice", "provider", "domain", DOMAINE
End SubPublic Sub sauve2()
   SaveSetting "raservice", "provider", "provider", provi.Combo1.Text
   SaveSetting "raservice", "provider", "login", provi.logp.Text
   SaveSetting "raservice", "provider", "psw", provi.pasp.Text
   SaveSetting "raservice", "provider", "domain", provi.domp.Text
End SubPublic Sub lit()   provi.Combo1.Text = GetSetting("raservice", "provider", "provider")
   provi.logp.Text = GetSetting("raservice", "provider", "login")
   provi.pasp.Text = GetSetting("raservice", "provider", "psw")
   provi.domp.Text = GetSetting("raservice", "provider", "domain")
End Sub

Answer 2

'API nécessaire
'connection internet
Public Declare Function RasEnumEntries Lib "RasApi32.dll" Alias "RasEnumEntriesA" (ByVal Reserved As String, ByVal lpszPhonebook As String, lprasentryname As Any, lpcb As Long, lpcentries As Long) As Long
Public Declare Function RasDial Lib "RasApi32.dll" Alias "RasDialA" (lpRasDialExtensions As Any, ByVal lpszPhonebook As String, lprasdialparams As Any, ByVal dwNotifierType As Long, lpvNotifier As Long, lphRasConn As Long) As Long
Public Declare Function RasHangup Lib "RasApi32.dll" Alias "RasHangUpA" (ByVal hRascon As Long) As Long
Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnection As Long) As Long
Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRascon As Long, lpStatus As Any) As Long
Public Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (lpString1 As Any, ByVal lpString2 As String) As Long
'const pour la connection reseau
Public Const APINULL = 0&
Public Const ras95_maxentryname = 256
Public Const ras95_maxdevicetype = 16
Public Const ras95_maxdevicename = 32
Public Const ras_maxphonenumber = 128
Public Const ras95_maxcallbacknumber = 128
Public Const unlen = 256
Public Const pwlen = 256
Public Const dnlen = 15
'****************************************
' constante d'erreur
'****************************************
Public Const Error_Succes = 0
Public Const Error_PortOpen = 602
Public Reseaux          As String
Public Reseaux2         As String
Public Existe_Proxy     As Boolean
Public Port_ecoute_proxy As String
Public Adresse_Proxy    As String
Public PROVIDER         As String
Public LOGIN            As String
Public PASSWORD         As String
Public DOMAINE          As String

Answer 3

Private Sub about_Click()
   frmAbout.Show
End SubPrivate Sub Command1_Click()
   For i = 0 To prefixe.ListCount - 1 Step 1
      If prefixe.Selected(i) = True Then
         envoyer.Close
         message.Text = Replace(message.Text, " ", "+", 1, , vbBinaryCompare)         Reseaux = Replace(Reseaux, "NUMERO", numero.Text, 1, , vbBinaryCompare)
         Reseaux = Replace(Reseaux, "TAILLE", carac.Caption, 1, , vbBinaryCompare)
         Reseaux = Replace(Reseaux, "PREFIXE", "32" & Mid(prefixe.List(prefixe.ListIndex), 2), 1, , vbBinaryCompare)
         Reseaux = Replace(Reseaux, "MESSAGE", message.Text, 1, , vbBinaryCompare)         message.Text = Replace(message.Text, "+", "%20", 1, , vbBinaryCompare)
         Reseaux2 = Replace(Reseaux2, "NUMERO", numero.Text, 1, , vbBinaryCompare)
         Reseaux2 = Replace(Reseaux2, "TAILLE", carac.Caption, 1, , vbBinaryCompare)
         Reseaux2 = Replace(Reseaux2, "PREFIXE", "32" & Mid(prefixe.List(prefixe.ListIndex), 2), 1, , vbBinaryCompare)
         Reseaux2 = Replace(Reseaux2, "MESSAGE", message.Text, 1, , vbBinaryCompare)
         If Existe_Proxy Then
            envoyer.Connect Adresse_Proxy, Port_ecoute_proxy
         Else
            envoyer.Connect "212.68.202.150", 80
         End If
         message.Text = Replace(message.Text, "+", " ", 1, , vbBinaryCompare)
         Exit Sub
      End If
   Next
   MsgBox "Choisir le préfixe!"
End SubPrivate Sub Command2_Click()
   Unload Me
   isconnected
   provi.hangup
End SubPrivate Sub directe_Click()
   provi.Show
End SubPrivate Sub envoyer_Connect()
   envoyer.SendData Reseaux
   envoyer.SendData Reseaux2
End SubPrivate Sub envoyer_DataArrival(ByVal bytesTotal As Long)
   envoyer.GetData donnee
   MsgBox "Mini Message Envoyé !"
   envoyer.Close
   Form_Load
End Sub
Private Sub Form_Load()
   Dim numfile          As Integer
   Dim donnee           As String
   Dim k, l             As Integer
   numfile = FreeFile   fic = FreeFile
   Open App.Path & "\provider.txt" For Binary As numfile
   donnee = String(LOF(numfile), " ")
   Get numfile, , donnee
   Close numfile
   If donnee <> "" Then
      pos = InStr(1, donnee, vbCrLf, vbBinaryCompare)
      PROVIDER = Left(donnee, pos - 1)
      donnee = Mid(donnee, pos + 2)
      pos = InStr(1, donnee, vbCrLf, vbBinaryCompare)
      LOGIN = Left(donnee, pos - 1)
      donnee = Mid(donnee, pos + 2)
      pos = InStr(1, donnee, vbCrLf, vbBinaryCompare)
      PASSWORD = Left(donnee, pos - 1)
      donnee = Mid(donnee, pos + 2)
      pos = InStr(1, donnee, vbCrLf, vbBinaryCompare)
      DOMAINE = Left(donnee, pos - 1)
   End If   Open App.Path & "\reseaux.txt" For Binary As numfile
   Reseaux = String(LOF(numfile), " ")
   Get numfile, , Reseaux
   Close numfile   Open App.Path & "\reseaux2.txt" For Binary As numfile
   Reseaux2 = String(LOF(numfile), " ")
   Get numfile, , Reseaux2
   Close numfile   Open App.Path & "\proxy.txt" For Binary As numfile
   donnee = String(LOF(numfile), " ")
   Get numfile, , donnee
   Close numfile
   If donnee <> "" Then
      If Mid(donnee, 1, 1) = 1 Then
         Existe_Proxy = True
         Adresse_Proxy = Mid(donnee, 2, 15)
         Port_ecoute_proxy = Mid(donnee, 17)
      Else
         Existe_Proxy = False
      End If
   End If
End Sub
Private Sub Form_Paint()   'FAIT UN DEGRADE A L'ECRAN
   l = 1
   For k = Me.ScaleHeight To 1 Step -1
      Me.Line (1, l)-(Me.ScaleWidth, l), RGB(0, 0, k * 256 / Me.ScaleHeight)
      l = l + 1
   NextEnd SubPrivate Sub message_Change()   carac.Caption = 140 - Len(message.Text)End SubPrivate Sub message_KeyPress(KeyAscii As Integer)
   If KeyAscii <> 8 Then
      carac.Caption = Int(carac.Caption) - 1
   Else
      If message.Text <> "" Then
         carac.Caption = Int(carac.Caption) + 1
      End If
   End If
   If carac.Caption = -1 Then
      message.Text = Mid(message.Text, 1, Len(message.Text) - 1)
      message.SelStart = Len(message.Text)
      carac.Caption = 0
   End If
End SubPrivate Sub Option1_Click(Index As Integer)
   prefixe.Clear
   prefixe.Enabled = True
   numero.Enabled = True
   message.Enabled = True   If Option1(0).Value = True Then
      carac.Caption = "140"
      prefixe.AddItem "0495", 0
      prefixe.AddItem "0496", 1
      prefixe.AddItem "0497", 2
      prefixe.ForeColor = &HFF00&
      numero.ForeColor = &HFF00&
   End If   If Option1(1).Value = True Then
      carac.Caption = " 140"
      prefixe.AddItem "0486", 0
      prefixe.ForeColor = &H80FF&
      numero.ForeColor = &H80FF&
   End If   If Option1(2).Value = True Then
      carac.Caption = "140"
      prefixe.AddItem "075", 0
      prefixe.AddItem "0476", 1
      prefixe.AddItem "0477", 2
      prefixe.AddItem "0478", 3
      prefixe.AddItem "0479", 4
      prefixe.ForeColor = &HFFFF00
      numero.ForeColor = &HFFFF00
   End If   carac.Caption = Int(carac.Caption) - Len(message.Text)
End Sub
Private Sub prefixe_Click()
   'prefixe.Selected(prefixe.ListIndex) = True
End SubPrivate Sub prefixe_Scroll()
   prefixe_Click
End SubPrivate Sub viaproxy_Click()
   Proxyoption.Show
End Sub

Answer 4

偶近期正在研究，已经可以对手机的PDU 7bit 和UCS2码进行编码、解码.
已能正常发送和接收短信，但对8bit码还没有完善。开发试用的硬件为西门子
m55手机和WaveCom的Q2403A模块。呵呵，以后可以交流。

Answer 5

http://vb.infoserv.com.tw/cptVB/mfbus15.zip
//可以参考这个例子

Answer 6

可以用Mscomm控件直接和手机模块通讯！

Answer 7

看看我的：http://www.51mis.com/sms/setup.exe