smscontrol1.ctl

通过手机串口发送短信的VB控件代码,在NOKIA等手机上已经通过测试.

'            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
'            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
End Sub

Private Sub txtMsg_Change()
    RaiseEvent Change
    labTips.Caption = "剩余字数：" & CStr(70 - Len(txtMsg.Text))
    
    
End Sub

Private Sub UserControl_GotFocus()
    txtDestPhoneNum.SetFocus
End Sub

Private Sub UserControl_Hide()
    RaiseEvent Hide
    
End Sub

Private Sub UserControl_Initialize()

        With MSComm1
            .CommPort = 1
            .RThreshold = 1
            .SThreshold = 0
            .Handshaking = comNone
            
            
            .Settings = "9600" & ",N,8,1"
'            .PortOpen = True
'            CmbPortName.Enabled = False
        End With
        
    cmdSend.Enabled = Len(txtDestPhoneNum.Text) And MSComm1.PortOpen

    
End Sub

Public Function SMSSend(ByVal SMSContent As String, _
                        ByVal DestNo As String, _
                        Optional ByVal ServiceNo As String) As Boolean
    
    Dim msg As SMSPDUClass
    Set msg = New SMSPDUClass
    
    If Len(DestNo) = 0 Then
        RaiseEvent ValidResult(1, "DestPhoneNumber is Null!")
        SMSSend = False
        Exit Function
        
    End If
    If isNum(DestNo) = False Then
        RaiseEvent ValidResult(1, "DestPhoneNumber Error!")
        SMSSend = False
        Exit Function
    End If
    
    If Len(ServiceNo) > 0 Then
        If isNum(ServiceNo) = False Then
            RaiseEvent ValidResult(1, "SMSC Error!")
            SMSSend = False
            Exit Function
        Else
'            msg.SMSC = ServiceNo
        End If
    End If
    
    
    If Len(ServiceNo) = 0 Then
    
        msg.genPDU SMSContent, DestNo
        
    Else
    
        msg.genPDU SMSContent, DestNo, ServiceNo
    End If
    
    If msg.PDULen > 5 Then
        If MSComm1.PortOpen = True Then
            SMSSend = SendSms(msg.PDU, msg.PDULen)
        Else
            SMSSend = False
        End If
        
    Else
        SMSSend = False
    End If
    
    
    
        
    
    
    Set msg = Nothing
End Function

Private Function SendSms(ByVal strSMSPdu As String, ByVal SMSLen As Integer) As Boolean
On Error GoTo errSend
    CommOpen
    
    With MSComm1
        If .PortOpen = True Then
'            Debug.Print Now()
            If SMSLen > 5 Then
                .Output = "AT+CMGF=0" & vbCr
                DoEvents
                DoEvents
                DoEvents
                DoEvents
                DoEvents
                .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 20000 Step 1
                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
    Exit Function
errSend:
    RaiseEvent ValidResult(Err.Number, Err.Description)
End Function



Private Sub UserControl_InitProperties()

    m_SMSC = m_def_SMSC
On Error Resume Next
'    SmsInit 1, "9600,n,8,1"
        With MSComm1
            .CommPort = 1
            .RThreshold = 1
            .SThreshold = 0
            .Handshaking = comNone
            .InputMode = comInputModeText
            .InputLen = 0
            
            .Settings = "9600" & ",N,8,1"
'            .PortOpen = True
'            CmbPortName.Enabled = False
        End With
        
        On Error GoTo ErrHandle
'        UserControl.BackColor = AmbientProperties.BackColor
'        UserControl.ForeColor = AmbientProperties.ForeColor
'
'        UserControl.Font = AmbientProperties.Font
 
'    If MSComm1.PortOpen Then
'
'        MSComm1.Output = "ATE0" + Chr(13) + Chr(10)
'        MSComm1.RThreshold = 1
'        MSComm1.Output = "AT+CMGF=1" + Chr(13) + Chr(10)
'        MSComm1.Output = "AT+CSMP=4,167,0,8" + Chr(13) + Chr(10)
''上边两行语句作为联机是初始化用的命令
'    End If

ErrHandle:
   RaiseEvent ValidResult(Err.Number, Err.Description)
   
   
    
End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    If Shift = vbCtrlMask And KeyCode = vbEnter Then
        Call cmdSend_Click
        
    End If
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

'    cmdCancel.Cancel = PropBag.ReadProperty("Cancel", True)
    MSComm1.CommPort = PropBag.ReadProperty("CommPort", 1)
'    Set txtMsg.Font = PropBag.ReadProperty("Font", Ambient.Font)
'    txtMsg.FontBold = PropBag.ReadProperty("FontBold", 0)
'    txtMsg.FontItalic = PropBag.ReadProperty("FontItalic", 0)
''    txtMsg.FontName = PropBag.ReadProperty("FontName", "")
''    txtMsg.FontSize = PropBag.ReadProperty("FontSize", 0)
'    UserControl.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
'    UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
'    cmdSend.Default = PropBag.ReadProperty("Default", True)
'    UserControl.BackStyle = PropBag.ReadProperty("BackStyle", 1)
'    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
'    UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
'    txtMsg.Text = PropBag.ReadProperty("Text", "")
''    cmdSend.Value = PropBag.ReadProperty("Value", 0)
    MSComm1.Settings = PropBag.ReadProperty("Settings", "9600,n,8,1")
''    MSComm1.Output = PropBag.ReadProperty("Output", 0)
'    MSComm1.OutBufferSize = PropBag.ReadProperty("OutBufferSize", 512)
'    MSComm1.SThreshold = PropBag.ReadProperty("SThreshold", 0)
'    UserControl.Appearance = PropBag.ReadProperty("Appearance", 1)
'    MSComm1.DTREnable = PropBag.ReadProperty("DTREnable", True)
'    MSComm1.EOFEnable = PropBag.ReadProperty("EOFEnable", False)
'    MSComm1.Handshaking = PropBag.ReadProperty("Handshaking", 0)
'    txtMsg.IMEMode = PropBag.ReadProperty("IMEMode", 0)
'    MSComm1.InBufferCount = PropBag.ReadProperty("InBufferCount", 0)
'    MSComm1.InBufferSize = PropBag.ReadProperty("InBufferSize", 1024)
''    MSComm1.Input = PropBag.ReadProperty("Input", 0)
'    MSComm1.InputLen = PropBag.ReadProperty("InputLen", 0)
'    MSComm1.InputMode = PropBag.ReadProperty("InputMode", 0)
'    MSComm1.RThreshold = PropBag.ReadProperty("RThreshold", 0)
'    MSComm1.RTSEnable = PropBag.ReadProperty("RTSEnable", False)
'    MSComm1.NullDiscard = PropBag.ReadProperty("NullDiscard", False)
    txtDestPhoneNum.Text = PropBag.ReadProperty("DestPhoneNumber", "")
    txtMsg.Text = PropBag.ReadProperty("MsgText", "")
    m_SMSC = PropBag.ReadProperty("SMSC", m_def_SMSC)
    
    
'    MSComm1.Input = PropBag.ReadProperty("Input", 0)
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

'    Call PropBag.WriteProperty("Cancel", cmdCancel.Cancel, True)
    Call PropBag.WriteProperty("CommPort", MSComm1.CommPort, 1)
'    Call PropBag.WriteProperty("Font", txtMsg.Font, Ambient.Font)
'    Call PropBag.WriteProperty("FontBold", txtMsg.FontBold, 0)
'    Call PropBag.WriteProperty("FontItalic", txtMsg.FontItalic, 0)
''    Call PropBag.WriteProperty("FontName", txtMsg.FontName, "")
''    Call PropBag.WriteProperty("FontSize", txtMsg.FontSize, 0)
'    Call PropBag.WriteProperty("ForeColor", UserControl.ForeColor, &H80000012)
'    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
'    Call PropBag.WriteProperty("Default", cmdSend.Default, True)
'    Call PropBag.WriteProperty("BackStyle", UserControl.BackStyle, 1)
'    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
'    Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 0)
'    Call PropBag.WriteProperty("Text", txtMsg.Text, "")
''    Call PropBag.WriteProperty("Value", cmdSend.Value, 0)
    Call PropBag.WriteProperty("Settings", MSComm1.Settings, "9600,n,8,1")
''    Call PropBag.WriteProperty("Output", MSComm1.Output, 0)
'    Call PropBag.WriteProperty("OutBufferSize", MSComm1.OutBufferSize, 512)
'    Call PropBag.WriteProperty("SThreshold", MSComm1.SThreshold, 0)
'    Call PropBag.WriteProperty("Appearance", UserControl.Appearance, 1)
'    Call PropBag.WriteProperty("DTREnable", MSComm1.DTREnable, True)
'    Call PropBag.WriteProperty("EOFEnable", MSComm1.EOFEnable, False)
'    Call PropBag.WriteProperty("Handshaking", MSComm1.Handshaking, 0)
'    Call PropBag.WriteProperty("IMEMode", txtMsg.IMEMode, 0)
'    Call PropBag.WriteProperty("InBufferCount", MSComm1.InBufferCount, 0)
'    Call PropBag.WriteProperty("InBufferSize", MSComm1.InBufferSize, 1024)
''    Call PropBag.WriteProperty("Input", MSComm1.Input, 0)
'    Call PropBag.WriteProperty("InputLen", MSComm1.InputLen, 0)
'    Call PropBag.WriteProperty("InputMode", MSComm1.InputMode, 0)
'    Call PropBag.WriteProperty("RThreshold", MSComm1.RThreshold, 0)
'    Call PropBag.WriteProperty("RTSEnable", MSComm1.RTSEnable, False)
'    Call PropBag.WriteProperty("NullDiscard", MSComm1.NullDiscard, False)
    Call PropBag.WriteProperty("DestPhoneNumber", txtDestPhoneNum.Text, "")
    Call PropBag.WriteProperty("MsgText", txtMsg.Text, "")
    Call PropBag.WriteProperty("SMSC", m_SMSC, m_def_SMSC)
    
'    Call PropBag.WriteProperty("Input", MSComm1.Input, 0)
End Sub
'注意！不要删除或修改下列被注释的行！
'MappingInfo=cmdCancel,cmdCancel,-1,Cancel
Public Property Get Cancel() As Boolean
Attribute Cancel.VB_Description = "指出命令按钮是否为窗体的“取消”按钮。"
    Cancel = cmdCancel.Cancel
End Property

Public Property Let Cancel(ByVal New_Cancel As Boolean)
    cmdCancel.Cancel() = New_Cancel
    PropertyChanged "Cancel"
End Property

'注意！不要删除或修改下列被注释的行！
'MappingInfo=MSComm1,MSComm1,-1,CommPort