form1.frm

GSM MODEM利用串口通信通过PC手法短信

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4980
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6975
   LinkTopic       =   "Form1"
   ScaleHeight     =   4980
   ScaleWidth      =   6975
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command4 
      Caption         =   "read"
      Height          =   495
      Left            =   2880
      TabIndex        =   6
      Top             =   2280
      Width           =   1215
   End
   Begin VB.TextBox Text3 
      Height          =   495
      Left            =   4200
      TabIndex        =   5
      Text            =   "如果收到短信,请回复."
      Top             =   1200
      Width           =   1215
   End
   Begin VB.TextBox Text2 
      Height          =   495
      Left            =   2520
      TabIndex        =   4
      Text            =   "13607360858"
      Top             =   1200
      Width           =   1215
   End
   Begin VB.TextBox Text1 
      Height          =   495
      Left            =   840
      TabIndex        =   3
      Text            =   "13800731500"
      Top             =   1200
      Width           =   1215
   End
   Begin VB.CommandButton Command3 
      Caption         =   "upd"
      Height          =   495
      Left            =   1080
      TabIndex        =   2
      Top             =   3720
      Width           =   1215
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Command2"
      Height          =   495
      Left            =   1080
      TabIndex        =   1
      Top             =   3000
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "text"
      Height          =   495
      Left            =   1080
      TabIndex        =   0
      Top             =   2160
      Width           =   1215
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   720
      Top             =   360
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      CommPort        =   5
      DTREnable       =   -1  'True
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
MSComm1.Output = "AT+CMGF=1" + vbCr '‘设置发送的模式,注意:一定要加上 vbCr
MSComm1.Output = "AT+CSCA=" & Chr$(34) & "8613800731500" & Chr$(34) & ",129" + vbCr '‘8613010341500是短消息中心,各地的号码不一样,必须设置当地的短消息号码
MSComm1.Output = "AT+CMGS=" & Chr$(34) & "13607360858" & Chr$(34) & ",129" + vbCr '‘13057575064是对方手机号
MSComm1.Output = "this is a sms test-2" & Chr$(26) '‘chr$(26)是Ctr+ Z


End Sub

Private Sub Command2_Click()
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True
length = Len("如果收到短信,请回复.") * 2
MSComm1.Output = "AT+CMGF=0" + vbCr ';‘以Pdu模式发送短信
MSComm1.Output = "AT+CMGS=" & Str(15 + length) + vbCr
'                 0891683110301405F011000D91683159717456F4000800165982679C6536523077ED4FE1002C8BF756DE590D002E

MSComm1.Output = "0891683108701305F011000D91683106370658F8000800165982679C6536523077ED4FE1002C8BF756DE590D002E" & Chr$(26)

Start = Timer
pause = 1
While Timer < Start + pause
DoEvents
Wend
reco = MSComm1.Input
'If InStr(reco, "OK") Then Sendsms = True
'If InStr(reco, "ERROR") Then Sendsms = False
'MSComm1.Output = "AT+CMGS=" & Str(15 + length) + vbCr '中的15为 11000D91683159717456F400080016的位数.length为5982679C6536523077ED4FE1002C8BF756DE590D002E的位数.
End Sub

Private Sub Command3_Click()
Dim csca, num, rmsg As String
csca = "13800731500"
'telc (num)
num = "13607360858"
'telc (num)
rmsg = "如果收到短信,请回复."
'chg (rmsg)
'Call Sendsms("13800731500", "13607360858", "如果收到短信,请回复.")
Call Sendsms(Text1.Text, Text2.Text, Text3.Text)

End Sub

Private Sub Command4_Click()
rnum = "13607362602"
 readsms (rnum)
End Sub

Private Sub Form_Load()
  MSComm1.Settings = "9600,N,8,1" ' ‘9600波特,无奇偶校验,8位数据,一个停止位
MSComm1.InputLen = 0 '‘读入整个缓冲区
MSComm1.PortOpen = True '‘打开端口
MSComm1.Output = "AT CNMI = 1, 1, 0, 0, 1" + vbCr
End Sub

'//////将中文字符转换为Unicode码
Public Function chg(rmsg As String) As String
   Dim tep As String
     Dim temp As String
     Dim i As Integer
     Dim b As Integer
     tep = rmsg
     i = Len(tep)
     b = i / 4
     If i = b * 4 Then
     b = b - 1
     tep = Left(tep, b * 4)
     Else
     tep = Left(tep, b * 4)
     End If
     chg = ""
     For i = 1 To b
     temp = "&H" & Mid(tep, (i - 1) * 4 + 1, 4)
     chg = chg & ChrW(CInt(Val(temp)))
     Next i
     End Function
'////将手机号码和对方手机号码也转换为PDU格式
Public Function telc(num As String) As String
     Dim tl As Integer
     Dim ltem, rtem, ttem As String
     Dim ti As Integer
     ttem = ""
     tl = Len(num)
     If tl <> 11 And tl <> 13 Then
     MsgBox "wrong number." & tl
     Exit Function
     End If
     If tl = 11 Then
     tl = tl + 2
     num = "86" & num
     End If
     For ti = 1 To tl Step 2
     ltem = Mid(num, ti, 1)
     rtem = Mid(num, ti + 1, 1)
     If ti = tl Then rtem = "F"
     ttem = ttem & rtem & ltem
     Next ti
     telc = ttem
     End Function

'/////短信的发送是由AT+CMGS指令完成的，采用PDU模式发送
   Public Function Sendsms(csca As String, num As String, msg As String) As Boolean
     Const prex = "0891"
     Const midx = "11000D91"
     Const sufx = "000800"


     
     Dim pdu, psmsc, pnum, pmsg As String
     Dim leng As String
     Dim length As Integer
     length = Len(msg)
     length = 2 * length
     leng = Hex(length)
     If length < 16 Then leng = "0" & leng
     psmsc = Trim(telc(csca)) '683108701305F0
     pnum = Trim(telc(num)) '683106370658F8
     pmsg = Trim(ascg(msg)) '转换为CU2码
     pdu = prex & psmsc & midx & pnum & sufx & leng & pmsg '0891683108701305F011000D91683106370658F8000800165982679C6536523077ED4FE1002C8BF756DE590D002E

     'sleep (1)
     If MSComm1.PortOpen = False Then MSComm1.PortOpen = True '////////////////////
     MSComm1.Output = "AT+CMGF=0" + vbCr ';‘以Pdu模式发送短信
     MSComm1.Output = "AT+CMGS=" & Str(15 + length) + vbCr
     MSComm1.Output = pdu & Chr(26)
Start = Timer
pause = 1
While Timer < Start + pause
DoEvents
Wend
'reco = MSComm1.Input
     
     Sendsms = True

     End Function


Public Function ascg(smsg As String) As String
     Dim si, sb As Integer
     Dim stmp As Integer
     Dim stemp As String
     sb = Len(smsg)
     ascg = ""
     For si = 1 To sb
     stmp = AscW(Mid(smsg, si, 1))
     If Abs(stmp) < 127 Then
     stemp = "00" & Hex(stmp)
     Else
     stemp = Hex(stmp)
     End If
     ascg = ascg & stemp
     Next si
     ascg = Trim(ascg) '5982679C6536523077ED4FE1002C8BF756DE590D002E

     End Function
    Public Sub readsms(rnum As String)
     MSComm1.Output = "AT+CMGF=1" + vbCr
     MSComm1.Output = "AT CNMI = 1, 1, 0, 0, 1" + vbCr
     'AT CNMI = 2, 2, , 1    这组参数来了新信息直接显示到串口，不作存储，仍然打开传送回报。

     rnum = MSComm1.Input
     MSComm1.Output = "AT+CMGR=" & rnum + vbCr
     jg = MSComm1.Input
     temp = Time
     Do While Timer < temp + 30
     reco = reco & MSComm1.Input
     Loop
     
     End Sub