单片机控制GPS/GSM原理（虚拟串口）

时间：11-17 来源：互联网点击：

单片机与GSM之间的通信调试成功。
------------------------------------全局变量声明---------------------------------------
Dim portno As Integer 端口号
Dim baudrate As Long 波特率
Const prex = "0891" 定义全局静态变量
Const midx = "0011000D91"
Const sufx = "000801"
Private Const EM_LINESCROLL = &HB6
----------------------------------------------------------------------------------------
发送信息
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As
Any) As Long
-----Sleep函数(延时功能)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
GetWindowTextW 指明这是一个 Unicode API (ASSII<->unicode)
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextW"
(ByVal hwnd As Long, ByVal lpString As Long, ByVal cch As Long) As
LongText2.Text = StrConv(StrConv(Text1.Text, vbUnicode),
vbFromUnicode)Private Sub NewSMSeting() 检测新信息
If Mobcomm.PortOpen = False Then
Mobcomm.PortOpen = True
End If
Mobcomm.Output = "AT+CNMI=1,1,0,0,1" + vbCr
Timer2.Enabled = True
End Sub
Private Function telc(num As String) As String 把电话号码转换成Unicode码
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 "电话号码有误!" & 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)
http://www.lwfree.com/ As Integer
Dim r As String
For i = 1 To Len(s) Step 4
r = r + ChrB("&H" & Mid(s, i + 2, 2)) & ChrB("&H" & Mid(s, i, 2))
Next
Unicode2AscII = r
End Function
Public Function AscII2Unicode(ByVal CS As String) 把信息转换成Unicode码
Dim Length As Integer
Dim temp As String
Dim i As Integer
Dim tempO As String
Dim tempN As String
tempN = ""
tempO = CS
Length = Len(tempO)
For i = 1 To Length
If AscW(Mid(CS, i, 1)) >= 0 And AscW(Mid(CS, i, 1)) < 128 Then
temp = "00" & Hex(AscW(Mid(CS, i, 1)))
Else
temp = Hex(AscW(Mid(CS, i, 1)))

End If
tempN = tempN & temp
Next i
AscII2Unicode = Trim(tempN)
End Function
Private Function ConTelc(teln As String) 电话号码译码
Dim i As Integer
Dim ltem, rtem, ttem As String
ttem = ""
For i = 1 To 14 Step 2
ltem = Mid(teln, i, 1)
rtem = Mid(teln, i + 1, 1)
If i = 13 Then ltem = ""
ttem = ttem & rtem & ltem
Next i
ConTelc = "+" + ttem
End Function
Private Function ConTimec(times As String) 时间译码
Dim Timetem As String
Timetem = Mid(times, 2, 1) + Mid(times, 1, 1) + "/" + Mid(times, 4, 1) +
Mid(times, 3, 1) + "/" _
+ Mid(times, 6, 1) + Mid(times, 5, 1) + " " + Mid(times, 8, 1) +
Mid(times, 7, 1) + ":" + _
Mid(times, 10, 1) + Mid(times, 9, 1) + ":" + Mid(times, 12, 1) +
Mid(times, 11, 1)
ConTimec = Timetem
End Function
Private Sub SMSend(ML As Integer, MS As String) 信息发送函数
Dim Backstring As String
If Mobcomm.PortOpen = False Then
Mobcomm.PortOpen = True
End If
Mobcomm.InBufferCount = 0
Mobcomm.OutBufferCount = 0
Mobcomm.InputLen = 0
Backstring = ""
Sleep (100)
Mobcomm.Output = "AT+CMGF=0" + vbCr
Sleep (400)
If Mobcomm.InBufferCount > 0 Then
Backstring = Mobcomm.Input
Mobcomm.InBufferCount = 0
Mobcomm.OutBufferCount = 0 1116

If InStr(Backstring, "OK") Then

Mobcomm.Output = "AT+CMGS=" + Str(ML) + Chr(13) + Chr(10)

Else
GoTo err
Exit Sub
End If
Backstring = ""
End If
Sleep (400)
If Mobcomm.InBufferCount > 0 Then
Backstring = Mobcomm.Input
Mobcomm.InBufferCount = 0
Mobcomm.OutBufferCount = 0
If InStr(Backstring, ">") Then

Mobcomm.Output = MS + Chr(26)

Else
GoTo err
Exit Sub
End If
Backstring = ""
End If
Sleep (2000)
If Mobcomm.InBufferCount > 0 Then
Backstring = Mobcomm.Input
Mobcomm.InBufferCount = 0
Mobcomm.OutBufferCount = 0
If InStr(Backstring, "OK") Then
MsgBox "信息发送成功!", vbOKOnly, "系统提示"
Else

GoTo err
Exit Function
End If
Backstring = ""
End If
Sleep (1000)
Exit Sub
err:
MsgBox "信息发送成功!", vbOKOnly, "系统提示"
MsgBox "传送出现错误,请重新发送!", vbOKOnly, "系统提示"
End Sub

上一篇：技巧 2 -- 单片机 C51 & A51 编程要点总结
下一篇：PIC单片机CCS之C语言(#IF,#ENDIF的用法)

单片机控制GPSGSM虚拟串相关文章：

栏目分类