📄 smscontrol1.ctl
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.UserControl UserControl1
ClientHeight = 4800
ClientLeft = 0
ClientTop = 0
ClientWidth = 6075
DefaultCancel = -1 'True
PropertyPages = "SMSControl1.ctx":0000
ScaleHeight = 4800
ScaleWidth = 6075
Begin VB.ComboBox txtDestPhoneNum
Height = 300
Left = 960
TabIndex = 1
Top = 240
Width = 4935
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "清除(&C)"
Height = 495
Left = 3120
TabIndex = 4
Top = 4200
Width = 1215
End
Begin MSCommLib.MSComm MSComm1
Left = 5760
Top = 4200
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin VB.CommandButton cmdSetting
Caption = "设置..."
Height = 495
Left = 1800
TabIndex = 5
Top = 4200
Width = 1215
End
Begin VB.CommandButton cmdSend
Caption = "发送(&S)"
Default = -1 'True
Height = 495
Left = 4440
TabIndex = 3
ToolTipText = "发送（Ctrl+Enter）"
Top = 4200
Width = 1215
End
Begin VB.TextBox txtMsg
Height = 3255
Left = 120
MaxLength = 70
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 2
ToolTipText = "输入短信内容（最多70个汉字）"
Top = 720
Width = 5775
End
Begin VB.Label labTips
Caption = "剩余字数："
Height = 375
Left = 120
TabIndex = 6
Top = 4200
Width = 1575
End
Begin VB.Label Label1
Caption = "收信人："
Height = 375
Left = 120
TabIndex = 0
Top = 240
Width = 855
End
End
Attribute VB_Name = "UserControl1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'事件声明:
Event ValidResult(ByVal ErrorCode As Integer, ByVal ErrorString As String)
Event Hide() 'MappingInfo=UserControl,UserControl,-1,Hide
Attribute Hide.VB_Description = "当控件的 Visible 属性变为 False 时发生。"
Event Show() 'MappingInfo=UserControl,UserControl,-1,Show
Attribute Show.VB_Description = "当控件的 Visible 属性变为 True 时发生。"
Event OnComm() 'MappingInfo=MSComm1,MSComm1,-1,OnComm
Attribute OnComm.VB_Description = "当 CommEvent 属性值改变时发生。"
Event Change() 'MappingInfo=txtMsg,txtMsg,-1,Change
Attribute Change.VB_Description = "当控件内容改变时发生。"
'缺省属性值:
Const m_def_SMSC = "+8613800769500"
'属性变量:
Dim m_SMSC As String
Private Sub cmdCancel_Click()
txtDestPhoneNum.Text = ""
txtMsg.Text = ""
End Sub
Private Sub cmdSend_Click()
Dim msg As SMSPDUClass
Set msg = New SMSPDUClass
If Len(txtDestPhoneNum.Text) = 0 Then
RaiseEvent ValidResult(1, "DestPhoneNumber is Null!")
Exit Sub
End If
If isNum(txtDestPhoneNum.Text) = False Then
RaiseEvent ValidResult(1, "DestPhoneNumber Error!")
Exit Sub
End If
If Len(m_SMSC) > 0 Then
If isNum(m_SMSC) = False Then
RaiseEvent ValidResult(1, "SMSC Error!")
Exit Sub
Else
' msg.SMSC = ServiceNo
End If
End If
msg.DestPhoneNum = txtDestPhoneNum.Text
msg.SMSC = m_SMSC
msg.MSGContent = txtMsg.Text
msg.genPDU
CommOpen
If msg.PDULen > 5 Then
If MSComm1.PortOpen = True Then
SendSms msg.PDU, msg.PDULen
End If
End If
Dim i As Integer
Dim bFound As Boolean
Dim strTemp As String
strTemp = msg.DestPhoneNum
For i = 0 To txtDestPhoneNum.ListCount - 1
If txtDestPhoneNum.List(i) = strTemp Then
bFound = True
Exit For
End If
Next i
If bFound Then
txtDestPhoneNum.RemoveItem i
End If
txtDestPhoneNum.AddItem strTemp, 0
txtDestPhoneNum.ListIndex = 0
Set msg = Nothing
End Sub
Private Sub cmdSetting_Click()
' frmSetting.txtSmsc = m_SMSC
' frmSetting.CmbPortName.ListIndex = MSComm1.CommPort + 1
' frmSetting.cmbBaud.ListIndex = 1
'
' frmSetting.Show vbModal
' Unload frmSetting
' Set frmSetting = Nothing
Dim intPortNum As Integer
intPortNum = CInt(InputBox("输入串口号", "设置", 1))
MSComm1.CommPort = intPortNum
End Sub
Private Sub MSComm1_OnComm()
RaiseEvent OnComm
Dim strATData As String
Dim strGetInfo As String
Dim tmpBuf() As Byte, strTmp As String, strTmpHex As String, i As Integer
On Error Resume Next
Select Case MSComm1.CommEvent
'''''''''''''''''''''''''''''''''''''''
Case comEvReceive
If MSComm1.InputMode = comInputModeBinary Then
tmpBuf = MSComm1.Input
For i = 0 To UBound(tmpBuf)
strTmpHex = Hex(tmpBuf(i))
If Len(strTmpHex) < 2 Then strTmpHex = "0" & strTmpHex
Next i
Else
strTmp = MSComm1.Input
' txtReceived.Text = strTmp & txtReceived.Text
' blTmp = GetDataFromCommPort(strTmp, strATData, strGetInfo)
End If
'''''''''''''''''''''''''''''''''''''''
Case comEventBreak
' Me.Caption = "Modem发出中断信号，希望计算机能等候，请稍候."
MSComm1.PortOpen = False
MSComm1.PortOpen = True
Case comEvCTS
If MSComm1.CTSHolding = True Then 'Modem表示计算机可以发送数据
' Me.Caption = "Modem能够接收计算机数据"
Else 'Modem无法响应计算机数据，可能缓冲区不够
' Me.Caption = "Modem请求计算机暂时不要发送数据"
MSComm1.DTREnable = Not MSComm1.DTREnable
DoEvents
MSComm1.DTREnable = Not MSComm1.DTREnable
End If
Case comEvDSR
If MSComm1.DSRHolding = True Then '当Modem收到计算机已经就绪，Modem表示自己也就绪
' Me.Caption = "Modem可以给计算机发送数据"
'
Else '在计算机发出DTR信号后，Modem可能还没有就绪
' Me.Caption = "Modem还没有初始化完毕"
'
End If
Case comEventFrame
MSComm1.PortOpen = False
MSComm1.PortOpen = True
cmdSend.Enabled = Len(txtDestPhoneNum.Text) And MSComm1.PortOpen
Case comEvRing
' Me.Caption = "检测到振铃变化"
' SetTrayTip Me.Caption
Case comEvCD
' Me.Caption = "检测到载波变化"
' SetTrayTip Me.Caption
Case Else
MsgBox MSComm1.CommEvent
' MSComm1.RTSEnable = Not MSComm1.RTSEnable
' DoEvents
' MSComm1.RTSEnable = Not MSComm1.RTSEnable
'MSComm1.PortOpen = False
'MSComm1.PortOpen = True
End Select
End Sub
Private Sub txtDestPhoneNum_Change()
cmdSend.Enabled = Len(txtDestPhoneNum.Text) 'And MSComm1.PortOpen
End Sub
Private Sub txtDestPhoneNum_DblClick()
txtDestPhoneNum.SelStart = 0
txtDestPhoneNum.SelLength = Len(txtDestPhoneNum.Text)
End Sub
Private Sub txtDestPhoneNum_KeyPress(KeyAscii As Integer)
Dim txtLen As Integer
txtLen = Len(cboPhoneNum.Text)
If txtLen = 0 Then
If KeyAscii = 59 Or KeyAscii = 44 Then
KeyAscii = 0
Exit Sub
End If
End If
Dim char As String
If KeyAscii >= 48 And KeyAscii <= 57 Then
' MsgBox Chr(KeyAscii)
If txtLen > 0 Then
char = Right(cboPhoneNum.Text, 1)
If char = "+" Then
If KeyAscii = Asc("8") Then
Exit Sub
Else
KeyAscii = 0
End If
End If
If char = "8" Then
If txtLen > 1 Then
If Mid(cboPhoneNum.Text, txtLen - 1, 1) = "+" Then
If KeyAscii = Asc("6") Then
Exit Sub
Else
KeyAscii = 0
End If
End If
End If
End If
End If
Else
If KeyAscii = 59 Or KeyAscii = 43 Or KeyAscii = 44 Then
' MsgBox Chr(KeyAscii)
Else
If KeyAscii = 8 Then '退格
Else
KeyAscii = 0
End If
End If
End If
If KeyAscii = 43 Then
If txtLen > 1 Then
char = Right(cboPhoneNum.Text, 1)
If char = ";" Or char = "," Then
Else
KeyAscii = 0
End If
End If
End If
If KeyAscii = 44 Or KeyAscii = 59 Then
char = Right(cboPhoneNum.Text, 1)
If char = "+" Or char = ";" Or char = "," Then
KeyAscii = 0
End If
End If Dim txtLen As Integer
txtLen = Len(cboPhoneNum.Text)
If txtLen = 0 Then
If KeyAscii = 59 Or KeyAscii = 44 Then
KeyAscii = 0
Exit Sub
End If
End If
Dim char As String
If KeyAscii >= 48 And KeyAscii <= 57 Then
' MsgBox Chr(KeyAscii)
If txtLen > 0 Then
char = Right(cboPhoneNum.Text, 1)
If char = "+" Then
If KeyAscii = Asc("8") Then
Exit Sub
Else
KeyAscii = 0
End If
End If
If char = "8" Then
If txtLen > 1 Then
If Mid(cboPhoneNum.Text, txtLen - 1, 1) = "+" Then
If KeyAscii = Asc("6") Then
Exit Sub
Else
KeyAscii = 0
End If
End If
End If
End If
End If
Else
If KeyAscii = 59 Or KeyAscii = 43 Or KeyAscii = 44 Then
' MsgBox Chr(KeyAscii)
Else
If KeyAscii = 8 Then '退格
Else
KeyAscii = 0
End If
End If
End If
If KeyAscii = 43 Then
If txtLen > 1 Then
char = Right(cboPhoneNum.Text, 1)
If char = ";" Or char = "," Then
Else
KeyAscii = 0
End If
End If
End If
If KeyAscii = 44 Or KeyAscii = 59 Then
char = Right(cboPhoneNum.Text, 1)
If char = "+" Or char = ";" Or char = "," Then
KeyAscii = 0
End If
End If Dim txtLen As Integer
txtLen = Len(cboPhoneNum.Text)
If txtLen = 0 Then
If KeyAscii = 59 Or KeyAscii = 44 Then
KeyAscii = 0
Exit Sub
End If
End If
Dim char As String
If KeyAscii >= 48 And KeyAscii <= 57 Then
' MsgBox Chr(KeyAscii)
If txtLen > 0 Then
char = Right(cboPhoneNum.Text, 1)
If char = "+" Then
If KeyAscii = Asc("8") Then
Exit Sub
Else
KeyAscii = 0
End If
End If
If char = "8" Then
If txtLen > 1 Then
If Mid(cboPhoneNum.Text, txtLen - 1, 1) = "+" Then
If KeyAscii = Asc("6") Then
Exit Sub
Else
KeyAscii = 0
End If
End If
End If
End If
End If
Else
If KeyAscii = 59 Or KeyAscii = 43 Or KeyAscii = 44 Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -