使用VB开发来电显示管理程序

最新推荐文章于 2024-08-08 12:25:00 发布

gdclx

最新推荐文章于 2024-08-08 12:25:00 发布

阅读量1.1k

点赞数

文章标签： vb buffer command object basic hex

本文链接：https://blog.csdn.net/gdclx/article/details/1749820

版权

适合对象：记得来电显示管理器
开发环境：Visual Basic
下载范例：JDDemo1.zip

原始文件：http://www.kosen.com.cn/news/showatc.asp?id=101

源程序：

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   4380
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   4305
   LinkTopic       =   "Form1"
   ScaleHeight     =   4380
   ScaleWidth      =   4305
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2
      Caption         =   "关闭"
      Height          =   375
      Left            =   3240
      TabIndex        =   4
      Top             =   120
      Width           =   855
   End
   Begin RichTextLib.RichTextBox RichTextBox1
      Height          =   3135
      Left            =   240
      TabIndex        =   3
      Top             =   960
      Width           =   3855
      _ExtentX        =   6800
      _ExtentY        =   5530
      _Version        =   393217
      Enabled         =   -1  'True
      TextRTF         =   $"Form1.frx":0000
   End
   Begin MSCommLib.MSComm MSComm1
      Left            =   1800
      Top             =   240
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.CommandButton Command1
      Caption         =   "打开"
      Height          =   375
      Left            =   2280
      TabIndex        =   2
      Top             =   120
      Width           =   855
   End
   Begin VB.ComboBox Combo1
      Height          =   300
      ItemData        =   "Form1.frx":008F
      Left            =   1080
      List            =   "Form1.frx":0091
      TabIndex        =   0
      Text            =   "COM1"
      Top             =   120
      Width           =   975
   End
   Begin VB.Label Label1
      Caption         =   "连接端口"
      Height          =   255
      Left            =   120
      TabIndex        =   1
      Top             =   240
      Width           =   855
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
    With MSComm1
        If .PortOpen Then .PortOpen = False
        .CommPort = Combo1.ListIndex + 1
        .InputLen = 1
        .PortOpen = True
    End With
    With RichTextBox1
        .Text = "Open COM" & CStr(Combo1.ListIndex + 1) & Chr(10)
        .Text = .Text & "Listening" & vbCrLf
    End With
    While MSComm1.PortOpen
        Do
            DoEvents
            If Not MSComm1.PortOpen Then Exit Sub
            Buffer$ = Buffer$ & MSComm1.Input
        Loop Until InStr(Buffer$, Chr(&H55) & Chr(&H55) & Chr(&H55) & Chr(&H55) & Chr(&H55) & Chr(&H55))

        Do
            DoEvents
            s$ = MSComm1.Input
        Loop Until s$ <> ""
        TeleKind% = Asc(s$)
        Do
            DoEvents
            s$ = MSComm1.Input
        Loop Until s$ <> ""
        TeleLen% = Asc(s$)

        i% = 0
        Buffer$ = ""
        Do
            DoEvents
            s$ = MSComm1.Input
            If s$ <> "" Then
                'RichTextBox1.Text = RichTextBox1.Text & " " & Hex$(Asc(s$))
                Buffer$ = Buffer$ & s$
                i% = i% + 1
            End If
        Loop Until i% >= TeleLen%
        Rem 复合数据格式
        If TeleKind% = &H80 Then
            With RichTextBox1
                '.Text = .Text & "复合数据格式 " & vbCrLf
                p% = InStr(Buffer$, Chr(1))
                If p% > 0 Then
                    TLen% = Asc(Mid(Buffer$, p% + 1, 1))
                    .Text = .Text & "来电时间: " & Mid(Buffer$, p% + 2, TLen%) & vbCrLf
                End If
                p% = InStr(Buffer$, Chr(2))
                If p% > 0 Then
                    TLen% = Asc(Mid(Buffer$, p% + 1, 1))
                    .Text = .Text & "来电号码: " & Mid(Buffer$, p% + 2, TLen%) & vbCrLf
                End If
            End With
        End If
        Rem 单数据格式
        If TeleKind% = &H4 Then
            With RichTextBox1
                '.Text = .Text & "单数据格式" & vbCrLf
                .Text = .Text & "来电时间: " & Mid(Buffer$, 1, 8) & vbCrLf
                .Text = .Text & "来电号码: " & Mid(Buffer$, 9, TeleLen% - 8) & vbCrLf
            End With
        End If
        Buffer$ = ""
    Wend
End Sub

Private Sub Command2_Click()
    With MSComm1
        If .PortOpen Then .PortOpen = False
    End With
    With RichTextBox1
        .Text = .Text & "Close" & vbCrLf
    End With
End Sub

Private Sub Form_Load()
    With Combo1
        .Clear
        For i = 1 To 5
          .AddItem ("COM" & CStr(i))
        Next
        .ListIndex = 0
    End With

End Sub