|
马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
现在,也有了从事软件工程的想法,在经过了一个月的PHP培训学习之后,发现其实软件工程并没有想像中的那么难。编码 网上有良多使用COM口毗连手机,使用手机MODEM,利用AT指令发送短信,引见PDU编码的道理良多,写一个现成的类出来,给有需求的人参考和利用。
SMSPDUClass.cls
Option Explicit
'坚持属性值的部分变量
Private mvarSMSCLen As Integer '部分复制
Private mvarSMSCType As String '部分复制
Private mvarSMSC As String '部分复制
Private mvarMsgHead As Integer '部分复制
Private mvarTPMR As Integer '部分复制
Private mvarDestPhoneNumLen As Integer '部分复制
Private mvarDestPhoneNumType As String '部分复制
Private mvarDestPhoneNum As String '部分复制
Private mvarTPPID As Integer '部分复制
Private mvarTPDSC As Integer '部分复制
Private mvarTPVP As Integer '部分复制
Private mvarMSGLen As Integer '部分复制
Private mvarMSGContent As String '部分复制
Private mvarPDULen As Integer '部分复制
Private mvarPDU As String '部分复制
'要激发该事务,请遵守以下语法利用 RaiseEvent:
'RaiseEvent ValidResult[(arg1, arg2, ... , argn)]
Public Event ValidResult(ByVal ErrorCode As Integer, ByVal ErrorString As String)
Public Function genPDU(Optional ByVal SMSContent As String, _
Optional ByVal DestNo As String, _
Optional ByVal ServiceNo As String) As String
'mvarSMSCLen = 0
'mvarSMSCType = ""
'mvarSMSC = ""
'mvarMsgHead = 11
'mvarTPMR = 0
'mvarDestPhoneNumLen = 0
'mvarDestPhoneNumType = ""
'mvarDestPhoneNum = ""
'mvarTPPID = 0
'mvarTPDSC = 8
'mvarTPVP = 0
'mvarMSGLen = 0
'mvarMSGContent = ""
'mvarPDULen = 0
'mvarPDU = ""
If Len(SMSContent) > 0 Then
mvarMSGContent = SMSContent
End If
If Len(DestNo) > 0 Then
mvarDestPhoneNum = DestNo
End If
If Len(ServiceNo) > 0 Then
mvarSMSC = ServiceNo
If Len(mvarSMSC) > 14 Then
RaiseEvent ValidResult(7, "SMSC Error!")
mvarSMSC = "+8613800769500"
End If
If Len(mvarSMSC) < 11 Then
RaiseEvent ValidResult(7, "SMSC Error!")
mvarSMSC = "+8613800769500"
End If
mvarSMSC = "+86" & Right(mvarSMSC, 11)
End If
If Len(mvarDestPhoneNum) = 0 Then
genPDU = ""
RaiseEvent ValidResult(3, "DestPhoneNumber is null!")
Exit Function
End If
If mvarTPDSC <> 0 And mvarTPDSC <> 8 Then
genPDU = ""
RaiseEvent ValidResult(5, "TP-DCS Error!")
Exit Function
End If
Dim ServiceNumPDU As String
Dim DestPhoneNumPDU As String
ServiceNumPDU = mvarSMSC
DestPhoneNumPDU = mvarDestPhoneNum
' msg.DestPhoneNumType 被叫号码类型。有+86时分为"91",不然为"81"
If Len(mvarSMSC) > 0 Then
FormatPhoneNum ServiceNumPDU, mvarSMSCType
mvarSMSCLen = Len(ServiceNumPDU & mvarSMSCType) / 2 '短信息中间地址长度。(短信息中间号码类型 + 短信息中间号码长度 /2 的十六进制暗示)
End If
mvarDestPhoneNumLen = FormatPhoneNum(DestPhoneNumPDU, mvarDestPhoneNumType) ''被叫号码长度。被叫号码长度的十六进制暗示。
'
If Len(mvarMSGContent) > 70 Then
mvarMSGContent = Left(mvarMSGContent, 70)
End If
' mvarMSGLen = Len(mvarMSGContent)
Dim SMSText As String
SMSText = mvarMSGContent
'
SMSText = GB2Unicode(SMSText) '把汉字符转化为UNICODE的HEX编码字符串
'
'
mvarMSGLen = Len(SMSText) \ 2
If Len(mvarSMSC) = 0 Then
mvarSMSCLen = 0
mvarPDU = Int2HexStr(mvarSMSCLen) & Int2HexStr(mvarMsgHead) & Int2HexStr(mvarTPMR) & Int2HexStr(mvarDestPhoneNumLen) & mvarDestPhoneNumType & DestPhoneNumPDU & _
Int2HexStr(mvarTPPID) & Int2HexStr(mvarTPDSC) & Int2HexStr(mvarTPVP) & Int2HexStr(mvarMSGLen) & SMSText
mvarPDULen = Len(mvarPDU) / 2 - 1
Else
mvarPDU = Int2HexStr(mvarSMSCLen) & mvarSMSCType & ServiceNumPDU & Int2HexStr(mvarMsgHead) & Int2HexStr(mvarTPMR) & Int2HexStr(mvarDestPhoneNumLen) & mvarDestPhoneNumType & DestPhoneNumPDU & _
Int2HexStr(mvarTPPID) & Int2HexStr(mvarTPDSC) & Int2HexStr(mvarTPVP) & Int2HexStr(mvarMSGLen) & SMSText
mvarPDULen = Len(mvarPDU) / 2 - 9 'PDU字符串长度
End If
genPDU = mvarPDU
End Function
'Public Property Let PDU(ByVal vData As String)
''向属性指派值时利用,位于赋值语句的右边。
''Syntax: X.PDU = 5
' mvarPDU = vData
'End Property
Public Property Get PDU() As String
'检索属性值时利用,位于赋值语句的右侧。
'Syntax: Debug.Print X.PDU
Call genPDU
PDU = mvarPDU
End Property
'Public Property Let PDULen(ByVal vData As Integer)
''向属性指派值时利用,位于赋值语句的右边。
''Syntax: X.PDULen = 5
' mvarPDULen = vData
'End Property
Public Property Get PDULen() As Integer
'检索属性值时利用,位于赋值语句的右侧。
'Syntax: Debug.Print X.PDULen
PDULen = mvarPDULen
End Property
Public Property Let MSGContent(ByVal vData As String)
'向属性指派值时利用,位于赋值语句的右边。
'Syntax: X.MSGContent = 5
mvarMSGContent = vData
mvarMSGLen = Len(vData) * 2
End Property
Public Property Get MSGContent() As String
'检索属性值时利用,位于赋值语句的右侧。
'Syntax: Debug.Print X.MSGContent
MSGContent = mvarMSGContent
End Property
'Public Property Let MSGLen(ByVal vData As String)
''向属性指派值时利用,位于赋值语句的右边。
''Syntax: X.MSGLen = 5
' mvarMSGLen = vData
'End Property
Public Property Get MSGLen() As Integer
'检索属性值时利用,位于赋值语句的右侧。
'Syntax: Debug.Print X.MSGLen
MSGLen = mvarMSGLen
End Property
Public Property Let TPVP(ByVal vData As Integer)
'向属性指派值时利用,位于赋值语句的右边。
'Syntax: X.TPVP = 5
If vData >= 0 And vData < 256 Then
mvarTPVP = vData
Else
RaiseEvent ValidResult(6, "TP-VP Error!")
End If
End Property
Public Property Get TPVP() As Integer
'检索属性值时利用,位于赋值语句的右侧。
'Syntax: Debug.Print X.TPVP
TPVP = mvarTPVP
End Property
Public Property Let TPDCS(ByVal vData As Integer)
'向属性指派值时利用,位于赋值语句的右边。
'Syntax: X.TPDSC = 5
If vData >= 0 And vData < 256 Then
mvarTPDSC = vData
Else
RaiseEvent ValidResult(5, "TP-DCS Error!")
End If
End Property
Public Property Get TPDCS() As Integer
'检索属性值时利用,位于赋值语句的右侧。
'Syntax: Debug.Print X.TPDSC
TPDCS = mvarTPDSC
End Property
Public Property Let TPPID(ByVal vData As Integer)
'向属性指派值时利用,位于赋值语句的右边。
'Syntax: X.TPPID = 5
If vData >= 0 And vData < 256 Then
mvarTPPID = vData
Else
RaiseEvent ValidResult(4, "TP-PID Error!")
End If
End Property
Public Property Get TPPID() As Integer
'检索属性值时利用,位于赋值语句的右侧。
'Syntax: Debug.Print X.TPPID
TPPID = mvarTPPID
End Property
Public Property Let DestPhoneNum(ByVal vData As String)
'向属性指派值时利用,位于赋值语句的右边。
'Syntax: X.DestPhoneNum = 5
If Len(vData) = 0 Then
RaiseEvent ValidResult(3, "DestPhoneNumber is null!")
Else
mvarDestPhoneNum = vData
mvarDestPhoneNumLen = FormatPhoneNum(vData, mvarDestPhoneNumType)
End If
End Property
Public Property Get DestPhoneNum() As String
'检索属性值时利用,位于赋值语句的右侧。
'Syntax: Debug.Print X.DestPhoneNum
DestPhoneNum = mvarDestPhoneNum
End Property
'Public Property Let DestPhoneNumType(ByVal vData As String)
''向属性指派值时利用,位于赋值语句的右边。
''Syntax: X.DestPhoneNumType = 5
' mvarDestPhoneNumType = vData
'End Property
'
'
Public Property Get DestPhoneNumType() As String
'检索属性值时利用,位于赋值语句的右侧。
'Syntax: Debug.Print X.DestPhoneNumType
If Len(mvarDestPhoneNum) = 0 Then
mvarDestPhoneNumType = "FF"
Else
Dim str As String
str = mvarDestPhoneNum
FormatPhoneNum str, mvarDestPhoneNumType
End If
DestPhoneNumType = mvarDestPhoneNumType
End Property
'Public Property Let DestPhoneNumLen(ByVal vData As String)
''向属性指派值时利用,位于赋值语句的右边。
''Syntax: X.DestPhoneNumLen = 5
' mvarDestPhoneNumLen = vData
'End Property
'
'
Public Property Get DestPhoneNumLen() As Integer
'检索属性值时利用,位于赋值语句的右侧。
'Syntax: Debug.Print X.DestPhoneNumLen
If Len(DestPhoneNum) = 0 Then
mvarDestPhoneNumLen = 0
Else
Dim str As String
str = DestPhoneNum
mvarDestPhoneNumLen = FormatPhoneNum(str, mvarDestPhoneNumType)
End If
DestPhoneNumLen = mvarDestPhoneNumLen
End Property
Public Property Let TPMR(ByVal vData As Integer)
'向属性指派值时利用,位于赋值语句的右边。
'Syntax: X.TPMR = 5
If vData >= 0 And vData < 256 Then
mvarTPMR = vData
Else
RaiseEvent ValidResult(2, "TP-MR Error!")
End If
End Property
Public Property Get TPMR() As Integer
'检索属性值时利用,位于赋值语句的右侧。
'Syntax: Debug.Print X.TPMR
TPMR = mvarTPMR
End Property
Public Property Let MsgHead(ByVal vData As Integer)
'向属性指派值时利用,位于赋值语句的右边。
'Syntax: X.MsgHead = 5
If vData >= 0 And vData < 256 Then
mvarMsgHead = vData
Else
RaiseEvent ValidResult(1, "MsgHead Error!")
End If
End Property
Public Property Get MsgHead() As Integer
'检索属性值时利用,位于赋值语句的右侧。
'Syntax: Debug.Print X.MsgHead
MsgHead = mvarMsgHead
End Property
Public Property Let SMSC(ByVal vData As String)
'向属性指派值时利用,位于赋值语句的右边。
'Syntax: X.SMSC = 5
If Len(vData) = 0 Then
mvarSMSCLen = 0
mvarSMSC = vData
Else
If Len(vData) > 14 Then
RaiseEvent ValidResult(7, "SMSC Error!")
vData = "+8613800769500"
End If
If Len(vData) < 11 Then
RaiseEvent ValidResult(7, "SMSC Error!")
vData = "+8613800769500"
End If
vData = "+86" & Right(vData, 11)
mvarSMSC = vData
mvarSMSCLen = FormatPhoneNum(vData, mvarSMSCType) / 2
End If
End Property
Public Property Get SMSC() As String
'检索属性值时利用,位于赋值语句的右侧。
'Syntax: Debug.Print X.SMSC
SMSC = mvarSMSC
End Property
'Public Property Let SMSCType(ByVal vData As String)
''向属性指派值时利用,位于赋值语句的右边。
''Syntax: X.SMSCType = 5
' mvarSMSCType = vData
'End Property
Public Property Get SMSCType() As String
'检索属性值时利用,位于赋值语句的右侧。
'Syntax: Debug.Print X.SMSCType
If Len(SMSC) = 0 Then
mvarSMSCType = "FF"
Else
Dim str As String
str = SMSC
FormatPhoneNum str, mvarSMSCType
End If
SMSCType = mvarSMSCType
End Property
'Public Property Let SMSCLen(ByVal vData As String)
''向属性指派值时利用,位于赋值语句的右边。
''Syntax: X.SMSCLen = 5
' mvarSMSCLen = vData
'End Property
'
'
Public Property Get SMSCLen() As Integer
'检索属性值时利用,位于赋值语句的右侧。
'Syntax: Debug.Print X.SMSCLen
If Len(SMSC) = 0 Then
mvarSMSCLen = 0
Else
Dim str As String
str = SMSC
FormatPhoneNum str, mvarSMSCType
mvarSMSCLen = Len(mvarSMSCType & str) / 2
End If
SMSCLen = mvarSMSCLen
End Property
Private Sub Class_Initialize()
mvarSMSCLen = 0
mvarSMSCType = ""
mvarSMSC = ""
mvarMsgHead = 17
mvarTPMR = 0
mvarDestPhoneNumLen = 0
mvarDestPhoneNumType = ""
mvarDestPhoneNum = ""
mvarTPPID = 0
mvarTPDSC = 8
mvarTPVP = 255
mvarMSGLen = 0
mvarMSGContent = ""
mvarPDULen = 0
mvarPDU = ""
' Msg.MsgHead = "11" '文件头字节 (header byte, 是一种 bitmask) 。这里 11 斧正常地发送短信息。
' Msg.TPMR = "00" '信息参考号。( TP-MR )
' Msg.TPPID = "00" '‘普通都是 00 ,暗示点到点的尺度短信
' Msg.TPVP = "FF" '‘无效期 (TP-VP), 短信的无效工夫 ,00或FF暗示无效
' Msg.TPDSC = "08" '用户信息编码体例 (TP-DCS) , 7-bit 编码( 08 : UCS2 编码 汉字通常是08)
End Sub
Private Function Int2HexStr(ByVal arg0 As Integer) As String
Dim strChar As String
strChar = ""
strChar = Hex(arg0)
If Len(strChar) < 2 Then strChar = "0" & strChar
Int2HexStr = strChar
End Function
'因为地位上略有处置,实践号码应为: 8613805515500( 字母 F 意指长度减 1),
'这是作者地点地 GSM 短信息中间的号码。 ( 号码处置办法为 , 假如为 +86 入手下手 , 将 + 号去失落 ,
'然后判别是不是为偶数 , 不是在末尾补 F, 然后将奇数位和偶数位交换 )
Public Function FormatPhoneNum(ByRef phoneNum As String, ByRef tonNpiFlag As String) As Integer
Dim i As Integer
Dim iAsc As Integer
Dim strChar As String
' If Len(phoneNum) = 14 Then
' If Left(phoneNum, 3) = "+86" Then
' phoneNum = Right(phoneNum, 11)
' Else
' If Len(phoneNum) <> 11 Then
' FormatSMSC = 0
' Exit Function
' End If
' End If
' End If
If Len(phoneNum) <= 0 Then
FormatPhoneNum = 0
Exit Function
End If
If Left(phoneNum, 3) = "+86" Then
phoneNum = Right(phoneNum, 13)
tonNpiFlag = "91"
Else
' If Len(phoneNum) <> 11 Then
' FormatSMSC = 0
' Exit Function
' End If
tonNpiFlag = "81"
End If
For i = 1 To Len(phoneNum)
strChar = Mid(phoneNum, i, 1)
iAsc = Asc(strChar)
If iAsc > 57 Or iAsc < 48 Then
FormatPhoneNum = 0
Exit Function
End If
Next i
If Len(phoneNum) Mod 2 <> 0 Then
phoneNum = phoneNum & "F"
End If
Dim strTmp2, strTmp1 As String
strTmp1 = ""
For i = 1 To Len(phoneNum) Step 2
strTmp2 = Mid(phoneNum, i, 2)
strTmp1 = strTmp1 & Right(strTmp2, 1) & Left(strTmp2, 1)
Next i
phoneNum = strTmp1
FormatPhoneNum = Len(phoneNum) - 1
End Function
Public Function GB2Unicode(ByVal strGB As String) As String
Dim byteA() As Byte
Dim i As Integer
Dim strTmpUnicode As String
Dim strA As String
Dim strB As String
On Error GoTo ErrorUnicode
i = LenB(strGB)
ReDim byteA(1 To i)
For i = 1 To LenB(strGB)
strA = MidB(strGB, i, 1)
byteA(i) = AscB(strA)
Next i
'此时已将strGB转换为Unicode编码,保留在数组byteA()中。
'上面需求调剂按次并以字符串的模式前往
strTmpUnicode = ""
For i = 1 To UBound(byteA) Step 2
strA = Hex(byteA(i))
If Len(strA) < 2 Then strA = "0" & strA
strB = Hex(byteA(i + 1))
If Len(strB) < 2 Then strB = "0" & strB
strTmpUnicode = strTmpUnicode & strB & strA
Next i
GB2Unicode = strTmpUnicode
Exit Function
ErrorUnicode:
' MsgBox "毛病:" & Err & "." & vbCrLf & Err.Description
RaiseEvent ValidResult(Err.Number, Err.Description)
GB2Unicode = ""
End Function
利用办法:
Dim sms1 As New SMSPDUClass
sms1.DestPhoneNum = "13922992078"
sms1.SMSC = "+861380076950011"
sms1.MSGContent = "aa"
SendSms sms1.pdu,sms1.pduleni
Public Function SendSms(ByVal strSMSPdu As String, ByVal SMSLen As Integer) As Boolean
With MSComm1
If .PortOpen = True Then
' Debug.Print Now()
If SMSLen > 5 Then
.Output = "AT+CMGF=0" & vbCr
.Output = "AT+CMGS=" & SMSLen & vbCr
Else
SendSms = False
Exit Function
End If
If Len(strSMSPdu) = 0 Then
SendSms = False
Exit Function
End If
' Debug.Print Now()
Dim i As Long
For i = 0 To 10000 Step 1
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
DoEvents
Next
' Debug.Print Now()
.Output = strSMSPdu & Chr(26)
SendSms = True
' Debug.Print Now()
Else
SendSms = False
Exit Function
End If
End With
End Function
可以在书上很方便地做标记,及时记下自己的心得体会。 |
|