democom.frm

本书源码主要针对目前流行的FTP、HTTP、E-mail、Telnet、ICMP、Modem串口通信编程、拨号网络编程等内容进行详细的讲解

VERSION 5.00
Begin VB.Form frmCommDemo 
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   Caption         =   "串口通信演示"
   ClientHeight    =   4908
   ClientLeft      =   972
   ClientTop       =   1788
   ClientWidth     =   8400
   BeginProperty Font 
      Name            =   "MS Sans Serif"
      Size            =   7.8
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4908
   ScaleWidth      =   8400
   Begin VB.Timer Timer1 
      Interval        =   500
      Left            =   7080
      Top             =   0
   End
   Begin VB.TextBox ShowText 
      Appearance      =   0  'Flat
      BeginProperty Font 
         Name            =   "Fixedsys"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   4095
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   0
      Top             =   600
      Width           =   8175
   End
   Begin VB.Menu MenuConfigure 
      Caption         =   "配置"
   End
   Begin VB.Menu SendMenu 
      Caption         =   "送出"
   End
End
Attribute VB_Name = "frmCommDemo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Form_Load()
    '配置串口对话框
   ' 打开串口
    frmCommcfg.Show 1
    ShowText.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

'重新调整输出和接入文本框的大小
Private Sub Form_Resize()
    ShowText.Move 0, 0, ScaleWidth, ScaleHeight
End Sub

'卸载通信类
Private Sub Form_Unload(Cancel As Integer)
    Set Comm = Nothing
End Sub
'定时器刷新
Private Sub Timer1_Timer()
     If Not (Comm Is Nothing) Then
           'If Comm.be_open Then
          Comm.Detect '串口通信类探测
          'End If
    End If
End Sub

'配置对话框
Private Sub MenuConfigure_Click()
    frmCommcfg.Show 1
End Sub

'文本筐中输入的任何一个字符都会发送出去
Private Sub ShowText_KeyPress(KeyAscii As Integer)
    If Not (Comm Is Nothing) Then
        Comm.CommOutput (Chr$(KeyAscii))
    End If
    KeyAscii = 0
End Sub

'发送一个句子

Private Sub SendMenu_Click()
    Dim dnum$
    If Not (Comm Is Nothing) Then
        ShowText.Text = ""
        dnum$ = InputBox$("写入你要发送的语句", "串口演示")
        Comm.CommOutput dnum$
    End If
End Sub

'接受输入的数据
Public Sub ShowInput(thiscomm As dwCom, commdata As String)
    Dim use$
    Dim cpos%
    If commdata <> "" Then
              
        For cpos% = 1 To Len(commdata$)
            Select Case Asc(Mid$(commdata$, cpos%))
                Case 13
                    use$ = use$ + Chr$(13) + Chr$(10)
                Case 10
                    '舍弃换行符
                Case Else
                    use$ = use$ + Mid$(commdata$, cpos%, 1)
            End Select
        Next cpos%
        ShowText.SelStart = Len(ShowText.Text)
        ShowText.SelLength = 0
        ShowText.SelText = use$
        
        If Len(ShowText.Text) > 4096 Then
            ShowText.Text = Right$(ShowText.Text, 2048)
        End If
        ShowText.SelStart = Len(ShowText.Text)
        
    End If
 
End Sub
'显示串口出错事件
Public Sub CommEvent(thiscomm As dwCom, ev As String)
    ShowText.SelStart = Len(ShowText.Text)
    ShowText.SelText = vbCrLf & ev & vbCrLf
    ShowText.SelStart = Len(ShowText.Text)
End Sub