frmmain.frm

这是一个简单的串口通信程序,可以实现简单的发送和接受功能,源程序来自网络~

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
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 frmMain 
   Caption         =   "串囗通信"
   ClientHeight    =   5880
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10500
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5880
   ScaleWidth      =   10500
   StartUpPosition =   2  '屏幕中心
   Begin MSCommLib.MSComm MSComm 
      Left            =   9120
      Top             =   840
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin MSComDlg.CommonDialog CommDia 
      Left            =   8400
      Top             =   840
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Frame Frame4 
      Caption         =   "文件信息"
      Height          =   735
      Left            =   120
      TabIndex        =   2
      Top             =   5040
      Width           =   10335
      Begin VB.Label lblFileName 
         BorderStyle     =   1  'Fixed Single
         Height          =   300
         Left            =   120
         TabIndex        =   3
         Top             =   240
         Width           =   10095
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "显示信息"
      Height          =   3975
      Left            =   120
      TabIndex        =   1
      Top             =   960
      Width           =   10335
      Begin RichTextLib.RichTextBox RichTextBox1 
         Height          =   3615
         Left            =   120
         TabIndex        =   12
         Top             =   240
         Width           =   10095
         _ExtentX        =   17806
         _ExtentY        =   6376
         _Version        =   393217
         ScrollBars      =   3
         TextRTF         =   $"frmMain.frx":0000
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "控制区"
      Height          =   735
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   10335
      Begin VB.CommandButton Command9 
         Caption         =   "保存文件"
         Height          =   375
         Left            =   6840
         TabIndex        =   13
         Top             =   240
         Width           =   1095
      End
      Begin VB.CommandButton Command8 
         Caption         =   "清空显示"
         Height          =   375
         Left            =   7920
         TabIndex        =   11
         Top             =   240
         Width           =   1095
      End
      Begin VB.CommandButton Command7 
         Caption         =   "退出"
         Height          =   375
         Left            =   9000
         TabIndex        =   10
         Top             =   240
         Width           =   1215
      End
      Begin VB.CommandButton Command6 
         Caption         =   "接收"
         Height          =   375
         Left            =   5760
         TabIndex        =   9
         Top             =   240
         Width           =   1095
      End
      Begin VB.CommandButton Command5 
         Caption         =   "发送"
         Height          =   375
         Left            =   4680
         TabIndex        =   8
         Top             =   240
         Width           =   1095
      End
      Begin VB.CommandButton Command4 
         Caption         =   "选择文件"
         Height          =   375
         Left            =   3600
         TabIndex        =   7
         Top             =   240
         Width           =   1095
      End
      Begin VB.CommandButton Command3 
         Caption         =   "发送方式"
         Height          =   375
         Left            =   2400
         TabIndex        =   6
         Top             =   240
         Width           =   1215
      End
      Begin VB.CommandButton Command2 
         Caption         =   "设置参数"
         Height          =   375
         Left            =   1320
         TabIndex        =   5
         Top             =   240
         Width           =   1095
      End
      Begin VB.CommandButton Command1 
         Caption         =   "查看文件"
         Height          =   375
         Left            =   120
         TabIndex        =   4
         Top             =   240
         Width           =   1215
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private fileName As String '发送的文件名
Private bytReceiveByte() As Byte
Public intReceiveLen As Integer
Public inputName As String '接收的文件名
Private Sub Command1_Click()

    Dim myPath As String
    Dim fileName() As String
    Dim bool As Boolean
    myPath = App.Path & "\file\"
    bool = GetFileList(myPath, fileName, "*.*")
    If bool = False Then
        RichTextBox1.Text = "file目录中没有任何文件!"
        Exit Sub
    End If
    
    For i = 0 To UBound(fileName)
        RichTextBox1.Text = RichTextBox1.Text & vbCrLf & fileName(i)
    Next i
   
End Sub

Private Sub Command2_Click()
    frmSetting.Show
End Sub

Private Sub Command3_Click()
    frmManner.Show
End Sub
Private Sub Command4_Click()
    CommDia.InitDir = App.Path & "\file"
    CommDia.Filter = "All Files(*.*)|*.*|TexT Files(*.txt)|*.txt|NC Files(*.nc)|*.nc"
    CommDia.ShowOpen
    fileName = Trim(CommDia.FileTitle)
    lblFileName = "你要发送的文件是: " & fileName
End Sub

Private Sub Command5_Click()
    If fileName = "" Then
        MsgBox "请先选择文件!", vbOKOnly, "警告"
        Exit Sub
    End If
    If Not MSComm.PortOpen Then
        MSComm.CommPort = intPort
        MSComm.Settings = strSet
        MSComm.PortOpen = True
    End If
    'RichTextBox1.Text = ""
    'MsgBox MSComm.Settings
    Dim oFso As FileSystemObject
    Dim oText As TextStream
    Dim strSend As String
    Set oFso = New FileSystemObject
    Set oText = oFso.OpenTextFile(App.Path & "\file\" & fileName, ForReading, False, TristateUseDefault)
    'MSComm.PortOpen = True
    Do
        strSend = oText.ReadLine
        
        MSComm.Output = strSend & vbCrLf
        If xianshi = True Then
        
            RichTextBox1.Text = RichTextBox1.Text & vbCrLf & strSend
        'MsgBox strSend
        End If
        'MsgBox MSComm.OutBufferCount
    Loop While oText.AtEndOfStream = False
    'MsgBox MSComm.InBufferCount
    MSComm.PortOpen = False
    oText.Close
    Set oFso = Nothing
    MsgBox "发送完毕!"
End Sub

Private Sub Command6_Click()


    'MsgBox inputName
    If Not MSComm.PortOpen Then
        MSComm.CommPort = intPort
        MSComm.Settings = strSet
        MSComm.PortOpen = True
    End If
    MSComm.InputLen = 0
    MSComm.InputMode = comInputModeText
    MSComm.InBufferCount = 0
    MSComm.RThreshold = 1
End Sub

Private Sub Command7_Click()
    Unload Me
End Sub

Private Sub Command8_Click()
    RichTextBox1.Text = ""
    'lblFileName = ""
    'fileName = ""
End Sub

Private Sub Command9_Click()
    inputName = InputBox("请输入你要保存的文件名!", "文件名称")
    inputName = App.Path & "\file\" & inputName & ".txt"
    RichTextBox1.SaveFile inputName, rtfText
    MsgBox "保存结束!"
End Sub

Private Sub Form_Load()
    xianshi = True
    RichTextBox1.Text = ""
    blnAutoSendFlag = False
    blnReceiveFlag = False
    
    intReceiveLen = 0
    
    intOutMode = 0
    
    intPort = 1
    intTime = 1000
    strSet = "9600,N,8,1"
    MSComm.InBufferSize = 1024
    MSComm.OutBufferSize = 512
    If Not MSComm.PortOpen Then
        MSComm.CommPort = intPort
        MSComm.Settings = strSet
        MSComm.PortOpen = True
    End If
    MSComm.PortOpen = False
    MkDir App.Path & "\file\"
End Sub

Private Sub MSComm_OnComm()
    'MsgBox ""
    Dim bytInput() As Byte
    Dim intInputLen As Integer
    'Dim b As Integer
    'Dim buf As String
    'buf = buf & MSComm.Input
    'b = Asc(Right(buf, 1))
    'If b = 10 Then
    '    RichTextBox1.Text = RichTextBox1.Text & vbCrLf & buf
    '    buf = ""
    'End If
    'msgbox
    Select Case MSComm.CommEvent
        Case comEvReceive
            If Not MSComm.PortOpen Then
                MSComm.CommPort = intPort
                MSComm.Settings = strSet
                MSComm.PortOpen = True
            End If
            MSComm.InputMode = comInputModeText
            intInputLen = MSComm.InBufferCount
            ReDim bytInput(intputlen)
            bytInput = MSComm.Input
            If MSComm.Input = strEnd Then
                MsgBox "接收完毕!"
                lblFileName.Caption = "文件接收完毕!"
                Exit Sub
            End If
            RichTextBox1.Text = RichTextBox1.Text & vbCrLf & MSComm.Input
            
            MSComm.PortOpen = False
    End Select
End Sub
Private Sub InputManage(bytInput() As Byte, intInputLen As Integer)
    Dim n As Integer
    ReDim Preserve bytReceiveByte(intReceiveLen + intInputLen)
    For n = 1 To intInputLen Step 1
        bytReceiveByte(intReceiveLen + n - 1) = bytInput(n - 1)
    Next n
    intReceiveLen = intReceiveLen + intInputLen
End Sub