form1.frm

这是一个通过手机串口实现短信发送的实例

ErrorUnicode:
    MsgBox "Error:" & Err & "." & vbCrLf & Err.Description
End Sub

Private Sub Form_GotFocus()
    '注意 只有不包含任何可接收焦点的控件的窗体，才能接收焦点
End Sub

Private Sub Form_Load()
    Dim blRet As Boolean
    Dim i As Integer
    Dim nTmp As Long
    
    blRet = LoadInitSettings
    
    ReDim ary_strTask(0 To 31)
    
    For i = 0 To 15
        ary_nCommandFlag(i) = 2 ^ (15 - i)
    Next i
    
    With CmbPortName
        .Clear
        .AddItem "COM1"
        .AddItem "COM2"
        .AddItem "COM3"
        .AddItem "COM4"
        .AddItem "COM5"
        .AddItem "COM6"
        .AddItem "COM7"
        .AddItem "COM8"
        .ListIndex = 0
    End With
    txtSMS.Text = ""
    
    With cmbCallMelody
        .Clear
        .AddItem "Ringin"
        .AddItem "Kite"
        .AddItem "Snow"
        .AddItem "Incoming"
        .AddItem "CCTVNews"
        .AddItem "ColdWind"
        .AddItem "Fog"
        .AddItem "SpringRain"
        .AddItem "Wolf"
        .AddItem "水乡"
        .ListIndex = 3
    End With
    
    With cmbSMSMelody
        .Clear
        .AddItem "Ringin"
        .AddItem "Kite"
        .AddItem "Snow"
        .AddItem "Incoming"
        .AddItem "CCTVNews"
        .AddItem "ColdWind"
        .AddItem "Fog"
        .AddItem "SpringRain"
        .AddItem "Wolf"
        .AddItem "水乡"
        .ListIndex = 2
    End With
    
    With cmbBaud
        .Clear
        .AddItem "4800"
        .AddItem "9600"
        .AddItem "19200"
        .AddItem "38400"
        .AddItem "57600"
        .AddItem "115200"
        .ListIndex = 1
    End With
    If blRet Then
        cmbBaud.Text = g_SysInfo.Baud
        CmbPortName.ListIndex = g_SysInfo.CommPort
        cmbCallMelody.ListIndex = g_SysInfo.CallMelody
        cmbSMSMelody.ListIndex = g_SysInfo.SMSMelody
        cmbCSCA.Text = g_SysInfo.ServiceNo
        txtDestNO.Text = g_SysInfo.DestNo
        chkClock.Value = IIf(g_SysInfo.Clock, vbChecked, vbUnchecked)
        txtClock.Visible = g_SysInfo.Clock
        tmrClock.Enabled = g_SysInfo.Clock
        txtClock.Text = g_SysInfo.ClockSet
        '13661193377, 13811055271
    End If
    
    If WindowState = vbMinimized Then
        LastState = vbNormal
    Else
        LastState = WindowState
    End If

  '  AddToTray Me, mnuTray
   ' SetTrayIcon LoadPicture(App.Path & "\Cells.ico")
    n_CaptionCount = 0
    SetTrayTip Me.Caption
    
'    Me.Caption = App.hInstance
    'nTmp = GetForegroundWindow()
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    
    Select Case UnloadMode
        Case vbFormControlMenu          ' 0 用户从窗体上的“控件”菜单中选择“关闭”指令。
            Me.WindowState = vbMinimized
            Cancel = True
        Case vbFormCode                 ' 1 Unload 语句被代码调用。
            g_SysInfo.Baud = cmbBaud.Text
            g_SysInfo.CommPort = CmbPortName.ListIndex
            g_SysInfo.CallMelody = cmbCallMelody.ListIndex
            g_SysInfo.SMSMelody = cmbSMSMelody.ListIndex
            g_SysInfo.ServiceNo = cmbCSCA.Text
            g_SysInfo.DestNo = txtDestNO.Text
            g_SysInfo.Clock = IIf(chkClock.Value = vbChecked, True, False)
            g_SysInfo.ClockSet = txtClock.Text
            Call SaveInitSettings
            ' Important! Remove the tray icon.
           ' RemoveFromTray
            Cancel = False
        Case vbAppWindows               ' 2 当前 Microsoft Windows 操作环境会话结束。
            MsgBox "Windows OS"
            Cancel = False
        Case vbAppTaskManager           ' 3 Microsoft Windows 任务管理器正在关闭应用程序。
            MsgBox "TaskManager"
            Cancel = False
        Case vbFormMDIForm              ' 4 MDI 子窗体正在关闭，因为 MDI 窗体正在关闭。
            MsgBox "FormForm"
            Cancel = False
        Case vbFormOwner                ' 5 因为窗体的所有者正在关闭，所以窗体也在关闭。
            MsgBox "FormOwner"
            Cancel = False
    End Select
'    End
End Sub
' Enable the correct tray menu items.
Private Sub Form_Resize()
    Select Case WindowState
        Case vbMinimized
            mnuTrayMinimize.Enabled = False
            mnuTrayRestore.Enabled = True
            Me.Hide
            App.TaskVisible = False
        Case vbMaximized
            mnuTrayMinimize.Enabled = True
            mnuTrayRestore.Enabled = True
        Case vbNormal
            mnuTrayMinimize.Enabled = True
            mnuTrayRestore.Enabled = False
            tmrICONSms.Enabled = False
            tmrICONCall.Enabled = False
            SetTrayIcon LoadPicture(App.Path & "\Cells.ico")
    End Select

    If WindowState <> vbMinimized Then
        Me.Visible = True
        If App.TaskVisible = False Then App.TaskVisible = True
        LastState = WindowState
    End If
End Sub

Private Sub mnuFileExit_Click()
    Unload Me
End Sub

Private Sub lstSMS_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton And lstSMS.ListCount > 0 Then
        PopupMenu mnuListRtClick, , , , mnuListRtClickShow
    End If
End Sub

Private Sub mnuListRtClickCopy_Click()
    Dim objSMSTmp As SMSDef
    Dim strTmp As String
On Error Resume Next
    
    If lstSMS.ListCount > 0 And UBound(obj_ArySMSList) > 0 Then
        objSMSTmp = obj_ArySMSList(lstSMS.ListIndex + 1)
        strTmp = Format(objSMSTmp.ReachDate, "YYYY-MM-DD") & " " & Format(objSMSTmp.ReachTime, "HH:MM:SS") & vbTab & objSMSTmp.SourceNo & vbCrLf
        strTmp = strTmp & "-------------------------------------" & vbCrLf
        strTmp = strTmp & objSMSTmp.SmsMain
        Clipboard.Clear
        Clipboard.SetText strTmp
    End If
End Sub

Private Sub mnuListRtClickDel_Click()
    Dim nU As Long, n As Long
    Dim smsTmp As SMSDef
    Dim i As Integer, iSelect As Integer
    
On Error Resume Next
    
    nU = UBound(obj_ArySMSList)
    If lstSMS.ListCount > 0 And nU > 0 Then
        iSelect = lstSMS.ListIndex + 1
        smsTmp = obj_ArySMSList(iSelect)
        n = smsTmp.SmsIndex
        
        If MSComm1.PortOpen = True Then
            nU = MsgBox("将要从SIM卡中删除第" & n & "条短信，确认吗？", vbYesNo + vbDefaultButton1)
            If nU = vbYes Then
                MSComm1.Output = "AT+CMGD=" & n & vbCr
                n_CaptionCount = 0
                Me.Caption = "已删除第" & n & "条短信"
                SetTrayTip Me.Caption
            End If
        End If
    End If
    
End Sub

Private Sub mnuListRtClickDelAll_Click()
    Dim nRet As Long
    
    If MSComm1.PortOpen = True Then
        nRet = MsgBox("将要从SIM卡中删除所有已读短信，确认吗？", vbYesNo + vbDefaultButton1)
        If nRet = vbYes Then
            MSComm1.Output = "AT+CMGD=1,1" & vbCr
        End If
    End If
End Sub

Private Sub mnuListRtClickDelList_Click()
    Dim nU As Long, n As Long
    Dim smsTmp As SMSDef
    Dim i As Integer, iSelect As Integer
    
On Error Resume Next
    
    nU = UBound(obj_ArySMSList)
    If lstSMS.ListCount > 0 And nU > 0 Then
        iSelect = lstSMS.ListIndex + 1
        For i = iSelect + 1 To nU
            smsTmp = obj_ArySMSList(i)
            obj_ArySMSList(i - 1) = smsTmp
        Next i
        
        nU = nU - 1
        If nU > 0 Then
            ReDim Preserve obj_ArySMSList(1 To nU)
            With lstSMS
                .Clear
                For n = 1 To nU
                    .AddItem obj_ArySMSList(n).SmsIndex & "." & obj_ArySMSList(n).SourceNo
                Next n
            End With
        Else
            ReDim obj_ArySMSList(0 To 0)
            lstSMS.Clear
        End If
    
        n_CaptionCount = 0
        Me.Caption = "已从列表删除第" & iSelect & "条短信"
        SetTrayTip Me.Caption
        
    End If
    
End Sub

Private Sub mnuListRtClickReply_Click()
    Dim nU As Long, n As Long
    Dim smsTmp As SMSDef
    Dim i As Integer, iSelect As Integer
    
On Error Resume Next
    
    nU = UBound(obj_ArySMSList)
    If lstSMS.ListCount > 0 And nU > 0 Then
        smsTmp = obj_ArySMSList(lstSMS.ListIndex + 1)
        n = smsTmp.SmsIndex
        
        If MSComm1.PortOpen = True Then
            txtDestNO.Text = smsTmp.SourceNo
            txtSMS.SetFocus
        End If
    End If
    
End Sub

Private Sub mnuListRtClickShow_Click()
    Call lstSMS_DblClick
End Sub

Private Sub mnuRichTxRtClickCopy_Click()
    Clipboard.Clear
    Clipboard.SetText txtUnicode.SelText
End Sub

Private Sub mnuRichTxRtClickCut_Click()
    Clipboard.Clear
    Clipboard.SetText txtUnicode.SelText
    txtUnicode.SelText = ""
End Sub

Private Sub mnuRichTxRtClickDel_Click()
    txtUnicode.SelText = ""
End Sub

Private Sub mnuRichTxRtClickPaste_Click()
    txtUnicode.SelText = Clipboard.GetText
End Sub

Private Sub mnuRichTxRtClickSelectAll_Click()
    txtUnicode.SelStart = 0
    txtUnicode.SelLength = Len(txtUnicode.Text)
End Sub

Private Sub mnuSystemQuit_Click()
    Call cmdExit_Click
End Sub

Private Sub mnuTrayClose_Click()
    Unload Me
End Sub

Private Sub mnuTrayMinimize_Click()
    WindowState = vbMinimized
End Sub

Private Sub mnuTrayRestore_Click()
    SendMessage hWnd, WM_SYSCOMMAND, _
        SC_RESTORE, 0&
End Sub

Private Sub lstSMS_DblClick()
    Dim objSMSTmp As SMSDef
On Error Resume Next
    
    If lstSMS.ListCount > 0 And UBound(obj_ArySMSList) > 0 Then
        objSMSTmp = obj_ArySMSList(lstSMS.ListIndex + 1)
        txtUnicode.Text = Format(objSMSTmp.ReachDate, "YYYY-MM-DD") & " " & Format(objSMSTmp.ReachTime, "HH:MM:SS") & vbTab & objSMSTmp.SourceNo & vbCrLf
        txtUnicode.Text = txtUnicode.Text & "-------------------------------------" & vbCrLf
        txtUnicode.Text = txtUnicode.Text & objSMSTmp.SmsMain
        txtUnicode.BackColor = &HFFFFC0
    End If
End Sub

Private Sub MMCNewSMS_Done(NotifyCode As Integer)
    
    On Error GoTo ErrorPlay
    Static nStaCountPlaySnd As Long
    
    '如果成功播放完一遍
    If NotifyCode = 1 Then
        MMCNewSMS.Command = "Close"
        g_nCountPlaySnd = g_nCountPlaySnd - 1
        'nStaCountPlaySnd = nStaCountPlaySnd - 1
        If g_nCountPlaySnd < 0 Then g_nCountPlaySnd = 0
        'If nStaCountPlaySnd < 0 Then nStaCountPlaySnd = 0
    
        '如果播放完一遍还有播放序列
        If g_nCountPlaySnd > 0 Then
        'If nStaCountPlaySnd > 0 Then
            MMCNewSMS.Command = "open"
            MMCNewSMS.Command = "play"
        ElseIf g_nCountPlaySnd = 0 Then
        'ElseIf nStaCountPlaySnd = 0 Then
            If UCase(MMCNewSMS.Command) <> "CLOSE" Then MMCNewSMS.Command = "close"
        End If
    End If
    Exit Sub
ErrorPlay:
    MsgBox "播放音乐发生错误。" & vbCrLf & "==================" & vbCrLf & Err & vbCrLf & "-------------" & vbCrLf & Err.Description
    If UCase(MMCNewSMS.Command) <> "CLOSE" Then MMCNewSMS.Command = "close"
End Sub

Private Sub MSComm1_OnComm()

    Dim blTmp As Boolean
    Dim strATData As String
    Dim strGetInfo As String
    Dim iMusicPlayTimes As Integer
    Dim blNeedPlayMusic As Boolean
    Dim iWhichMusic As Integer

    Dim tmpBuf() As Byte, strTmp As String, strTmpHex As String, i As Integer

On Error Resume Next
    Select Case MSComm1.CommEvent
        
        '''''''''''''''''''''''''''''''''''''''
        Case comEvReceive
            If g_blIsHexCommData Then
                tmpBuf = MSComm1.Input
                
                For i = 0 To UBound(tmpBuf)
                    strTmpHex = Hex(tmpBuf(i))
                    If Len(strTmpHex) < 2 Then strTmpHex = "0" & strTmpHex