📄 frmcmpp.frm
字号:
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form FrmCMPP
Caption = "中国移动通信短信业务"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 '窗口缺省
Begin VB.Timer StateTimer
Interval = 1000
Left = 840
Top = 240
End
Begin VB.TextBox rState
Height = 270
Left = 0
TabIndex = 0
Top = 2880
Width = 4575
End
Begin MSWinsockLib.Winsock WinSocket
Left = 360
Top = 240
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
End
Attribute VB_Name = "FrmCMPP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
'--信息流水号（10进制）--
XuHao = 1#
'--初始化COMMAND_ID-------------------------
'请求连接
CMPP_Connect(0) = &H0
CMPP_Connect(1) = &H0
CMPP_Connect(2) = &H0
CMPP_Connect(3) = &H1
'请求连接应答
CMPP_Connect_REP(0) = &H80
CMPP_Connect_REP(1) = &H0
CMPP_Connect_REP(2) = &H0
CMPP_Connect_REP(3) = &H1
'终止连接
CMPP_Terminate(0) = &H0
CMPP_Terminate(1) = &H0
CMPP_Terminate(2) = &H0
CMPP_Terminate(3) = &H2
'终止连接应答
CMPP_Terminate_REP(0) = &H80
CMPP_Terminate_REP(1) = &H0
CMPP_Terminate_REP(2) = &H0
CMPP_Terminate_REP(3) = &H2
'提交短信
CMPP_Submit(0) = &H0
CMPP_Submit(1) = &H0
CMPP_Submit(2) = &H0
CMPP_Submit(3) = &H4
'提交短信应答
CMPP_Submit_REP(0) = &H80
CMPP_Submit_REP(1) = &H0
CMPP_Submit_REP(2) = &H0
CMPP_Submit_REP(3) = &H4
'短信下发
CMPP_Deliver(0) = &H0
CMPP_Deliver(1) = &H0
CMPP_Deliver(2) = &H0
CMPP_Deliver(3) = &H5
'下发短信应答
CMPP_Deliver_REP(0) = &H80
CMPP_Deliver_REP(1) = &H0
CMPP_Deliver_REP(2) = &H0
CMPP_Deliver_REP(3) = &H5
'发送短信状态查询
CMPP_Query(0) = &H0
CMPP_Query(1) = &H0
CMPP_Query(2) = &H0
CMPP_Query(3) = &H6
'发送短信状态查询应答
CMPP_Query_REP(0) = &H80
CMPP_Query_REP(1) = &H0
CMPP_Query_REP(2) = &H0
CMPP_Query_REP(3) = &H6
'删除短信
CMPP_Cancel(0) = &H0
CMPP_Cancel(1) = &H0
CMPP_Cancel(2) = &H0
CMPP_Cancel(3) = &H7
'删除短信应答
CMPP_Cancel_REP(0) = &H80
CMPP_Cancel_REP(1) = &H0
CMPP_Cancel_REP(2) = &H0
CMPP_Cancel_REP(3) = &H7
'激活测试
CMPP_Active_Test(0) = &H0
CMPP_Active_Test(1) = &H0
CMPP_Active_Test(2) = &H0
CMPP_Active_Test(3) = &H8
'激活测试应答
CMPP_Active_Test_REP(0) = &H80
CMPP_Active_Test_REP(1) = &H0
CMPP_Active_Test_REP(2) = &H0
CMPP_Active_Test_REP(3) = &H8
'---------------------------
WinSocket.RemoteHost = "211.137.134.42"
'WinSocket.RemoteHost = "127.0.0.1"
WinSocket.RemotePort = 7890
WinSocket.Connect
End Sub
Private Sub StateTimer_Timer()
Dim sData() As Byte
Dim mHeader As Message_Header
Select Case WinSocket.State
Case sckClosed
rState.Text = "关闭"
Case sckOpen
rState.Text = "打开"
Case sckListening
rState.Text = "侦听"
Case sckConnectionPending
rState.Text = "连接挂起"
Case sckResolvingHost
rState.Text = "识别主机"
Case sckHostResolved
rState.Text = "已识别主机"
Case sckConnecting
rState.Text = "正在连接"
Case sckConnected
rState.Text = "已连接"
Case sckClosing
rState.Text = "同级人员正在关闭连接"
WinSocket.Close
WinSocket.RemoteHost = "211.137.134.42"
'WinSocket.RemoteHost = "159.226.139.56"
WinSocket.RemotePort = 7890
WinSocket.Connect
Case sckError
rState.Text = "错误"
WinSocket.Close
WinSocket.RemoteHost = "211.137.134.42"
'WinSocket.RemoteHost = "159.226.139.56"
WinSocket.RemotePort = 7890
WinSocket.Connect
End Select
End Sub
Private Sub WinSocket_Connect()
Dim sData() As Byte
Dim mHeader As Message_Header
Dim mConnect As MSG_Connect
Dim Tmp$
Dim sMD5hash As String
Dim R16 As String * 16
Dim R32 As String * 32
Dim i As Integer
'--消息头格式--
'--4 计算消息总长度（含消息头及消息体）
'CopyMemory mHeader.Total_Length(0), CLng(Len(mHeader) + Len(mConnect)), 4
DblToUnInt4 mHeader.Total_Length, Len(mHeader) + Len(mConnect)
'--4 命令或响应类型
CopyMemory mHeader.Command_ID(0), CMPP_Connect(0), 4
CopyMemory CMD(0), CMPP_Connect(0), 4
'--4 消息流水号，顺序累加，步长为1，循环使用
DblToUnInt4 mHeader.Sequence_ID, XuHao
Call ZjXuHao
'CopyMemory mHeader.Sequence_ID(0), CLng(1), 4
'--消息体格式--
'1. CMPP_Connect 请求连接
'--4 Integer 时间戳的明文,由客户端产生,格式为MMDDHHMMSS，即月日时分秒，10位,右对齐
StrTo4UnInt mConnect.Timestamp, Format(Date, "mmdd") + Format(Time, "hhmmss")
'--6 Octet String SP_ID 926021/01001
'CopyMemory mConnect.Source_Addr, "926021", 6
'CopyMemory mConnect.Source_Addr, "01001" + Chr(0), 6
mConnect.Source_Addr = "926021"
'--16 Octet String SP认证码
'用于鉴别ICP。其值通过单向MD5 hash计算得出，表示如下：
'AuthenticatorICP =MD5（Source_Addr+9 字节的0 +shared secret+timestamp）
'Shared secret 由中国移动与ICP事先商定
'timestamp格式为：MMDDHHMMSS，即月日时分秒，10位
Tmp$ = "926021" + String(9, Chr(0))
Tmp$ = Tmp$ + String(2, Chr(&H8))
'Tmp$ = Tmp$ + Format(Date, "mmdd") + Format(Time, "hhmmss")
For i = 0 To 3
Tmp$ = Tmp$ + Chr(mConnect.Timestamp(i))
Next i
'Tmp$ = "123" + Chr(0)
MD5 Tmp$, R16, R32, Len(Tmp$)
sMD5hash = ""
For i = 1 To 16
sMD5hash = sMD5hash + Chr(Val("&H" + Mid(R32, (i - 1) * 2 + 1, 2)))
'mConnect.AuthenticatorSP(i - 1) = Val("&H" + Mid(R32, (i - 1) * 2 + 1, 2))
Next i
'mConnect.AuthenticatorSP = R16
'mConnect.AuthenticatorSP = String(16, Chr(0))
mConnect.AuthenticatorSP = sMD5hash
'--'1 Integer 双方协商的版本号
mConnect.Version = &H12
'--重新分配数组大小---
ReDim sData(CLng(Len(mHeader) + Len(mConnect)) - 1)
CopyMemory sData(0), mHeader, Len(mHeader)
CopyMemory sData(Len(mHeader)), mConnect, Len(mConnect)
For i = 1 To 39
aa = sData(i - 1)
Next i
WinSocket.SendData sData
End Sub
Private Sub WinSocket_DataArrival(ByVal bytesTotal As Long)
Dim sData() As Byte
Dim mHeader As Message_Header
'---------------
Dim mConnect As MSG_Connect '&H00000001 请求连接
Dim mConnect_REP As MSG_Connect_REP '&H80000001 请求连接应答
'Dim mTerminate(3) As msg_te '&H00000002 终止连接
'Dim mTerminate_REP(3) As Byte '&H80000002 终止连接应答
Dim mSubmit As MSG_Submit '&H00000004 提交短信
Dim mSubmit_REP As MSG_Submit_REP '&H80000004 提交短信应答
Dim mDeliver1 As MSG_Deliver1 '&H00000005 短信下发
Dim mDeliver2 As MSG_Deliver2 '&H00000005 短信下发
Dim mDeliver_REP As MSG_Deliver_REP '&H80000005 下发短信应答
Dim mQuery As MSG_Query '&H00000006 发送短信状态查询
Dim mQuery_REP As MSG_Query_REP '&H80000006 发送短信状态查询应答
Dim mCancel As MSG_Cancel '&H00000007 删除短信
Dim mCancel_REP As MSG_Cancel_REP '&H80000007 删除短信应答
'Dim mActive_Test As MSG_Active_Test_REP '&H00000008 激活测试
Dim mActive_Test_REP As MSG_Active_Test_REP '&H80000008 激活测试应答
'---------------
Dim sLow As Long
Dim sHigh As Long
Dim Tmp$
Dim sMD5hash As String
Dim Length As Double
Dim CommandID As Double
Dim SquenceID As Double
ReDim sData(bytesTotal - 1)
'===接收数据===
WinSocket.GetData sData, vbArray + vbByte
'--消息头格式--
CopyMemory mHeader, sData(0), 12
'--4 计算消息总长度（含消息头及消息体）
DblFromUnInt4 mHeader.Total_Length, Length
'--4 命令或响应类型
DblFromUnInt4 mHeader.Command_ID, CommandID
'--4 消息流水号，顺序累加，步长为1，循环使用
DblFromUnInt4 mHeader.Sequence_ID, SquenceID
'--消息体格式--
If mHeader.Command_ID(0) = &H80 Then
Select Case mHeader.Command_ID(3)
Case CMPP_Active_Test_REP(3) '&H80000008 激活测试应答
Tmp$ = "激活测试应答:"
CopyMemory mActive_Test_REP, sData(12), Length - 12
If mActive_Test_REP.Success_Id = 0 Then
Tmp$ = Tmp$ + "成功"
Else
Tmp$ = Tmp$ + "失败"
End If
Case CMPP_Cancel_REP(3) '&H80000007 删除短信应答
Tmp$ = "删除短信应答"
CopyMemory mCancel_REP, sData(12), Length - 12
If mCancel_REP.Success_Id = 0 Then
Tmp$ = Tmp$ + "成功"
Else
Tmp$ = Tmp$ + "失败"
End If
Case CMPP_Connect_REP(3) '&H80000001 请求连接应答
CopyMemory mConnect_REP, sData(12), Length - 12
FrmCMPP.Caption = mConnect_REP.AuthenticatorISMG
Tmp$ = "请求连接应答:" + CStr(mConnect_REP.Version)
Select Case mConnect_REP.Status
Case 0
Tmp$ = Tmp$ + "正确"
Case 1
Tmp$ = Tmp$ + "消息结构错"
Case 2
Tmp$ = Tmp$ + "非法SP_ID"
Case 3
Tmp$ = Tmp$ + "SP认证错"
Case 4
Tmp$ = Tmp$ + "版本太高"
Case Else
Tmp$ = Tmp$ + "其他错误"
End Select
'AuthenticatorISMG 16 Octet String ISMG认证码 ，SP认证出错时，此项为空
'Version 1 Integer 服务器支持的最高版本号
Case CMPP_Query_REP(3) '&H80000006 发送短信状态查询应答
CopyMemory mQuery_REP, sData(12), Length - 12
'Time 8 Octet String 时间(精确至日)
'Query_Type 1 Integer 查询类别0：总数查询1：按业务代码查询
'Query_Code 10 Octet String 查询码
'MT_TLMsg 4 Integer 从SP接收信息总数
'MT_Tlusr 4 Integer 从SP接收用户总数
'MT_Scs 4 Integer 成功转发数量
'MT_WT 4 Integer 待转发数量
'MT_FL 4 Integer 转发失败数量
'MO_Scs 4 Integer 向SP成功送达数量
'MO_WT 4 Integer 向SP待送达数量
'MO_FL 4 Integer 向SP送达失败数量
Case CMPP_Submit_REP(3) '&H80000004 提交短信应答
CopyMemory mSubmit_REP, sData(12), Length - 12
Case CMPP_Terminate_REP(0) '&H80000002 终止连接应答
Tmp$ = "终止连接应答"
End Select
ElseIf mHeader.Command_ID(0) = &H0 Then
Select Case mHeader.Command_ID(3)
Case CMPP_Connect(3)
CopyMemory mConnect, sData(12), Length - 12
Open App.Path + "\data.txt" For Output As #1
Print #1, mConnect.AuthenticatorSP
Print #1, mConnect.Source_Addr
Print #1, mConnect.Timestamp
Print #1, mConnect.Version
Close #1
Case CMPP_Active_Test(3) '&H00000008 激活测试
Tmp$ = "激活测试"
Case CMPP_Deliver(3)
If CMD(0) = CMPP_Submit(0) Then '当CMPP_Deliver为对CMPP_Submit的应答信息时(即状态报告)，信息内容字段格式定义如下：
CopyMemory mDeliver2, sData(12), Length - 12
Else
CopyMemory mDeliver1, sData(12), Length - 12
End If
Case CMPP_Terminate(3) '&H00000002 终止连接
Tmp$ = "终止连接"
End Select
End If
rState.Text = Tmp$
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -