分享
 
 
 

短信PDU编码类,可以用COMM连MODEM可以方便的发短信.

王朝other·作者佚名  2006-07-04
窄屏简体版  字體: |||超大  

网上有很多利用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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有