Option Explicit

'************************************************
'******************COM 端口設置******************
'************************************************
Public Function COMSet(CommObj As MSComm, ByVal mPort As String, ByVal mSet As String) As Boolean
??? On Error GoTo Err
??? If CommObj.PortOpen = True Then CommObj.PortOpen = False
??? CommObj.InBufferSize = 1024
??? CommObj.OutBufferSize = 512
??? CommObj.CommPort = mPort
??? CommObj.Settings = mSet
??? CommObj.PortOpen = True
??? CommObj.RThreshold = 1
??? CommObj.NullDiscard = False
??? CommObj.InputLen = 0
??? CommObj.SThreshold = 1
??? CommObj.InputMode = comInputModeBinary
??? COMSet = True
??? Exit Function
Err:
??? COMSet = False
End Function

'************************************************
'****************十六進制轉十進制****************
'************************************************
Public Function HexToDec(HexValue As Variant) As Variant
??? Dim LowValue, HighValue As String
????
??? If Len(HexValue) = 1 Then
?????? HexValue = "0" & HexValue
??? End If
??? Select Case Left(HexValue, 1)
?????????? Case "A"
??????????????? LowValue = "10"
?????????? Case "B"
??????????????? LowValue = "11"
?????????? Case "C"
??????????????? LowValue = "12"
?????????? Case "D"
??????????????? LowValue = "13"
?????????? Case "E"
??????????????? LowValue = "14"
?????????? Case "F"
??????????????? LowValue = "15"
?????????? Case Else
??????????????? LowValue = Left(HexValue, 1)
??? End Select
??? Select Case Right(HexValue, 1)
?????????? Case "A"
??????????????? HighValue = "10"
?????????? Case "B"
??????????????? HighValue = "11"
?????????? Case "C"
??????????????? HighValue = "12"
?????????? Case "D"
??????????????? HighValue = "13"
?????????? Case "E"
??????????????? HighValue = "14"
?????????? Case "F"
??????????????? HighValue = "15"
?????????? Case Else
??????????????? HighValue = Right(HexValue, 1)
??? End Select
??? HexToDec = Val(LowValue) * 16 + Val(HighValue)
End Function

'************************************************
'***********判斷發送數據是否是十六進制***********
'************************************************
Public Function OpinHEX(strobj As String) As Boolean
??? Dim i As Long
??? If Len(strobj) Mod 2 = 0 Then
??????? OpinHEX = True
??? Else
??????? OpinHEX = False
??????? Exit Function
??? End If
??? For i = 1 To Len(strobj)
??????? If (Asc(Mid(strobj, i, 1)) >= 48 And Asc(Mid(strobj, i, 1)) <= 57) Or (Asc(Mid(strobj, i, 1)) >= 65 And Asc(Mid(strobj, i, 1)) <= 70) Then
??????????? OpinHEX = True
??????? Else
??????????? OpinHEX = False
??????????? Exit Function
??????? End If
??? Next
End Function

'************************************************
'***將接收到的十六進制數據轉換為中文***
'************************************************
Public Function HexToChinese_RHR(DataStr As String) As String
??? Dim i As Long, j As Long
??? i = Len(DataStr) \ 4
??? For j = 0 To i - 1
??????? HexToChinese_RHR = HexToChinese_RHR & ChrW(HexToDec(Mid(DataStr, 1 + 4 * j, 2)) * 256 + HexToDec(Mid(DataStr, 1 + 2 + 4 * j, 2)))
??? Next
End Function

'************************************************
'****將接收到的十六進制數據轉換為中文（標準）****
'************************************************
Public Function HexToChinese_Stand(DataStr As String) As String
??? Dim i As Long, j As Long
??? i = Len(DataStr) \ 4
??? For j = 0 To i - 1
??????? HexToChinese_Stand = HexToChinese_Stand & Chr(HexToDec(Mid(DataStr, 1 + 4 * j, 2)) * 256 + HexToDec(Mid(DataStr, 1 + 2 + 4 * j, 2)))
??? Next
End Function

'************************************************
'********將接收到的中文轉換為十六進制數據********
'************************************************
Public Function ChineseToHex(DataStr As String) As String
??? Dim i As Long, j As Long
??? Dim DataStr_Tmp As String
????
??? For i = 0 To Len(DataStr) - 1
??????? DataStr_Tmp = Hex(AscW(Mid(DataStr, i + 1, 1)))
??????? For j = 1 To 4 - Len(DataStr_Tmp)
??????????? DataStr_Tmp = "0" & DataStr_Tmp
??????? Next
??????? ChineseToHex = ChineseToHex & DataStr_Tmp
??? Next
End Function

'************************************************
'**************將數據轉換為十六進制**************
'************************************************
Public Function HEXData(DataStr As String) As String
??? Dim DataStr_Tmp As String
??? Dim SendData As String
??? Dim i As Long
????
??? '去掉字符串中的空格
??? DataStr_Tmp = DelBlank(DataStr)
??? '轉換為十進制
??? For i = 1 To Len(DataStr_Tmp) \ 2
??????? SendData = SendData & Chr(HexToDec(Mid(DataStr_Tmp, 2 * (i - 1) + 1, 2)))
??? Next
??? HEXData = SendData
End Function

'************************************************
'************以GSM按 十六進制發送數據************
'************************************************
Public Function GSM_SendHEX(DataStr As String)
??? Dim DataStr_Tmp As String
??? Dim SendData() As Byte
??? Dim i As Long
????
??? '去掉字符串中的空格
??? DataStr_Tmp = DelBlank(DataStr)
??? '發送數據
??? ReDim SendData(Len(DataStr_Tmp) \ 2 - 1) As Byte
??? For i = 1 To Len(DataStr_Tmp) \ 2
??????? SendData(i - 1) = HexToDec(Mid(DataStr_Tmp, 2 * (i - 1) + 1, 2))
??? Next
????
??? FrmMain.MSComm1.Output = SendData
End Function

'************************************************
'*************以GSM按ASCII碼發送數據*************
'************************************************
Public Function GSM_SendASCII(DataStr As String)
??? Dim DataStr_Tmp As String
??? Dim SendData() As Byte
??? Dim i As Long
????
??? '去掉字符串中的空格
??? DataStr_Tmp = DelBlank(DataStr)
??? '發送數據
??? ReDim SendData(Len(DataStr_Tmp) - 1) As Byte
??? For i = 1 To Len(DataStr_Tmp)
??????? SendData(i - 1) = Asc(Mid(DataStr_Tmp, i, 1))
??? Next
????
??? FrmMain.MSComm1.Output = SendData
End Function

'************************************************
'********以GPRS按十六進制發送數據 （TCP）********
'************************************************
Public Function GPRS_SendHEX_TCP(DataStr As String, IDString As String)
??? Dim DataStr_Tmp As String
??? Dim SendData() As Byte
??? Dim i As Long
????
??? '去掉字符串中的空格
??? DataStr_Tmp = DelBlank(DataStr)
??? '發送數據
??? ReDim SendData(Len(DataStr_Tmp) \ 2 - 1) As Byte
??? For i = 1 To Len(DataStr_Tmp) \ 2
??????? SendData(i - 1) = HexToDec(Mid(DataStr_Tmp, 2 * (i - 1) + 1, 2))
??? Next
??? FrmMain.Winsock2(IDString).SendData SendData
End Function

'************************************************
'*********以GPRS按ASCII碼發送數據（TCP）*********
'************************************************
Public Function GPRS_SendASCII_TCP(DataStr As String, IDString As String)
??? Dim DataStr_Tmp As String
??? Dim i As Long
????
??? '轉換數據
??? DataStr_Tmp = DataStr
????
??? FrmMain.Winsock2(IDString).SendData DataStr_Tmp
End Function

'************************************************
'********以GPRS按十六進制發送數據 （UDP）********
'************************************************
Public Function GPRS_SendHEX_UDP(DataStr As String, IDString As String)
??? Dim DataStr_Tmp As String
??? Dim SendData() As Byte
??? Dim i As Long
????
??? '去掉字符串中的空格
??? DataStr_Tmp = DelBlank(DataStr)
??? '發送數據
??? ReDim SendData(Len(DataStr_Tmp) \ 2 - 1) As Byte
??? For i = 1 To Len(DataStr_Tmp) \ 2
??????? SendData(i - 1) = HexToDec(Mid(DataStr_Tmp, 2 * (i - 1) + 1, 2))
??? Next
??? FrmMain.Winsock3(IDString).SendData SendData
End Function

'************************************************
'*********以GPRS按ASCII碼發送數據（UDP）*********
'************************************************
Public Function GPRS_SendASCII_UDP(DataStr As String, IDString As String)
??? Dim DataStr_Tmp As String
??? Dim i As Long
????
??? '轉換數據
??? DataStr_Tmp = DataStr
????
??? FrmMain.Winsock3(IDString).SendData DataStr_Tmp
End Function

轉載于:https://www.cnblogs.com/MMLoveMeMM/articles/3131994.html

總結

以上是生活随笔為你收集整理的GSM-串口和GPRS-网口通信的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。