main.frm

vb实现串口通信 文件传送系统

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "Mswinsck.ocx"
Begin VB.Form Main 
   Caption         =   "文件传送"
   ClientHeight    =   7350
   ClientLeft      =   4740
   ClientTop       =   3510
   ClientWidth     =   6390
   LinkTopic       =   "frmMain"
   ScaleHeight     =   7350
   ScaleWidth      =   6390
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   4440
      TabIndex        =   18
      Top             =   240
      Width           =   1215
   End
   Begin VB.CommandButton Command5 
      Caption         =   "串口设置"
      Height          =   375
      Left            =   2760
      TabIndex        =   16
      Top             =   240
      Width           =   975
   End
   Begin VB.CommandButton Command2 
      Caption         =   "关闭串口"
      Height          =   375
      Left            =   1560
      TabIndex        =   12
      Top             =   240
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "打开串口"
      Height          =   375
      Left            =   240
      TabIndex        =   11
      Top             =   240
      Width           =   1095
   End
   Begin VB.Frame Frame1 
      Caption         =   "文件传送"
      Height          =   2175
      Left            =   240
      TabIndex        =   3
      Top             =   4320
      Width           =   5895
      Begin VB.CommandButton Command4 
         Caption         =   "日志"
         Height          =   375
         Left            =   4080
         TabIndex        =   15
         Top             =   1680
         Width           =   1095
      End
      Begin VB.CommandButton send 
         Caption         =   "传送"
         Height          =   375
         Left            =   600
         TabIndex        =   10
         Top             =   1680
         Width           =   1215
      End
      Begin VB.CommandButton save 
         Caption         =   "..."
         Height          =   375
         Left            =   4680
         TabIndex        =   9
         Top             =   1080
         Width           =   975
      End
      Begin VB.CommandButton open 
         Caption         =   "..."
         Height          =   375
         Left            =   4680
         TabIndex        =   8
         Top             =   360
         Width           =   975
      End
      Begin VB.TextBox txtSend1 
         Height          =   375
         Left            =   1560
         TabIndex        =   7
         Top             =   360
         Width           =   2655
      End
      Begin VB.TextBox txtReceive1 
         Height          =   375
         Left            =   1560
         TabIndex        =   6
         Top             =   1080
         Width           =   2655
      End
      Begin VB.OptionButton option2 
         Caption         =   "接收文件"
         Height          =   375
         Left            =   240
         TabIndex        =   5
         Top             =   960
         Width           =   1215
      End
      Begin VB.OptionButton option1 
         Caption         =   "发送文件"
         Height          =   375
         Left            =   240
         TabIndex        =   4
         Top             =   360
         Width           =   1335
      End
      Begin MSWinsockLib.Winsock Winsock1 
         Left            =   2640
         Top             =   1560
         _ExtentX        =   741
         _ExtentY        =   741
         _Version        =   393216
      End
   End
   Begin VB.Frame Frame3 
      Caption         =   "发送信息"
      Height          =   3375
      Left            =   240
      TabIndex        =   0
      Top             =   720
      Width           =   5895
      Begin VB.TextBox tt 
         Height          =   1935
         Left            =   1560
         TabIndex        =   14
         Top             =   1200
         Width           =   4095
      End
      Begin VB.CommandButton Command3 
         Caption         =   "接收"
         Height          =   375
         Left            =   240
         TabIndex        =   13
         Top             =   1200
         Width           =   975
      End
      Begin VB.CommandButton xSend 
         Caption         =   "发送"
         Height          =   375
         Left            =   240
         TabIndex        =   2
         Top             =   360
         Width           =   975
      End
      Begin VB.TextBox tc 
         Height          =   375
         Left            =   1560
         TabIndex        =   1
         Top             =   360
         Width           =   4095
      End
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   2040
      Top             =   6600
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      CancelError     =   -1  'True
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   2640
      Top             =   6600
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.Label Label1 
      Caption         =   "IP:"
      Height          =   375
      Left            =   4080
      TabIndex        =   17
      Top             =   240
      Width           =   375
   End
End
Attribute VB_Name = "Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'************************************************
Dim intCommPort As Long         '串口号
Dim strCommSettings As String   '串口设置
Dim intOutBufferSize As Long    '发送缓冲区大小
Dim intInBufferSize As Long     '接收缓冲区大小

Dim blnShowFlag As Boolean      '显示或隐藏文件传输窗体标志

Dim intColorSet() As Long       '用于记录消息显示的格式
Dim intArrayCount As Long       '用于记录消息显示的格式
'************************************************

Private Sub Command3_Click()
     If MSComm1.PortOpen = True Then
        MSComm1.PortOpen = False
    End If
    MSComm1.Settings = "9600,N,8,1"
    MSComm1.PortOpen = True
    abc = MSComm1.Input
    tt.Text = abc
    MSComm1.PortOpen = False
End Sub

Private Sub Command4_Click()
rizhi.Show
End Sub

Private Sub Command5_Click()
config.Show

End Sub

'************************************************
'传输文件
'响应“开始传输”按钮
'************************************************

Private Sub send_Click()
    On Error GoTo FileError
    
    If blnFileTransFlag = True And intCommFlag = 1 Then
        
        intCommFlag = 8
            Call FileSendManager(0)
        intCommFlag = 1
    End If
    
FileError:                           '错误处理
    
    
    Select Case Err.Number
        Case 53
            MsgBox ("文件没有找到!")
    End Select
    If intCommFlag > 0 Then
        intCommFlag = 1
    Else
        
        MsgBox ("串口没有打开!")
    End If
    
End Sub


Private Sub cmdFileSend_Click()

End Sub

'************************************************
'发送信息
'响应“发送”按钮，发送信息
'************************************************

Public Sub xSend_Click()
abc = tc.Text
    If MSComm1.PortOpen = True Then
    MSComm1.PortOpen = False
    End If
    MSComm1.Settings = "9600,N,8,1"
    MSComm1.PortOpen = True
    MSComm1.Output = abc
    MSComm1.PortOpen = False
End Sub

'************************************************
'打开
'打开标准对话框，选择待发送的文件
'************************************************
Private Sub open_Click()
    On Error GoTo Cancel
    Call option1_Click
    Main.CommonDialog1.ShowOpen
    strFileName = Main.CommonDialog1.FileTitle
    strFileDirectary = Main.CommonDialog1.FileName
    txtSend1.Text = strFileDirectary
Cancel:
End Sub

'************************************************
'保存
'打开标准对话框，选择保存文件的路径
'************************************************
Public Sub save_Click()
    On Error GoTo Cancel
    Call option2_Click
    Main.CommonDialog1.ShowSave
    strFileDirectary = Main.CommonDialog1.FileName
    strFileName = Main.CommonDialog1.FileTitle
    txtReceive1.Text = strFileDirectary
Cancel:
End Sub

'**************************************************
'打开串口，打开串行口并向用户显示相关信息
'**************************************************
Private Sub Command1_Click()
If MSComm1.PortOpen = True Then
    MSComm1.PortOpen = False
    End If
    MSComm1.Settings = "9600,N,8,1"
    MSComm1.RThreshold = 1
    MSComm1.PortOpen = True
    'MSComm1.InputLen = 0
    intCommFlag = 1
End Sub

'************************************************
'关闭串口
'************************************************
Private Sub Command2_Click()
    Call CommPortClose
    intCommFlag = 0
End Sub

'*************************************************
'配置串口
'响应菜单，打开参数设置窗体
'*************************************************
Private Sub ConfigPort_Click()
    frmConfig.Show
End Sub


'************************************************
'主窗体初始化
'加载主窗体，并对串口、标准对话框及进度条进行初始化设置
'************************************************
Private Sub Form_Load()
Text1 = Winsock1.LocalIP
If MSComm1.PortOpen = False Then
MSComm1.PortOpen = True
End If
'abc = 0
    blnShowFlag = True
    Main.Height = 7000
    Call SetComm("9600,N,8,1", 2, 4096)                 '串口设置
    intInBufferSize = 4096
    intOutBufferSize = 2048
    intCommFlag = 0                                     '初始系统状态
    Main.CommonDialog1.Flags = &H200000 Or &H2     '初始化标准对话框
    Main.CommonDialog1.CancelError = True
    blnFileTransFlag = False                            '初始发送接收标志
    intArrayCount = 0
End Sub

'*************************************************
'设置串行口
'为参数设置提供公共接口
'*************************************************
Public Sub SetComm(strSet As String, intPort As Long, intOutBuffer As Long)
    strCommSettings = strSet
    intCommPort = intPort
    intOutBufferSize = intOutBuffer
End Sub

'*************************************************
'获取串行口设置
'返回串口设置（波特率等）
'*************************************************
Public Function GetSettings() As String
    GetSettings = strCommSettings
End Function

'**************************************************
'获取当前串口号
'**************************************************
Public Function GetCommPort() As Long
    GetCommPort = intCommPort
End Function


'**************************************************
'获取当前发送缓冲区大小
'
'**************************************************
Public Function GetOutBuffer() As Long
    GetOutBuffer = intOutBufferSize
End Function


'*************************************************
'打开串行口
'
'*************************************************
Public Sub CommPortOpen()
    On Error GoTo PortError
    MSComm1.CommPort = intCommPort                        '设置串行口号
    If MSComm1.PortOpen = True Then
        MSComm1.PortOpen = False
    End If
    MSComm1.Settings = strCommSettings                    '设置波特率.奇偶校验位.数据位和停止位
    MSComm1.InBufferSize = intInBufferSize                '设置接收缓冲区的字节长度
    MSComm1.InBufferCount = 0                             '清除接收缓冲区数据
    MSComm1.OutBufferSize = intOutBufferSize              '设置发送缓冲区字节长度
    MSComm1.OutBufferCount = 0                            '清除发送缓冲区数据
    MSComm1.RThreshold = 1                                '每次接收到字符即产生OnComm事件
    MSComm1.Handshaking = comRTSXOnXOff
    Main.MSComm1.InputLen = 100
    MSComm1.PortOpen = True
PortError:
    Select Case Err.Number
        Case 8005
            MsgBox ("该串口已经被占用,请换其它串口!")
    End Select
End Sub

'*************************************************
'关闭串行口
'
'*************************************************


Public Sub CommPortClose()
    Dim strTemp As String
    If MSComm1.PortOpen = True Then
        MSComm1.PortOpen = False
        strTemp = "设置:关闭串行口!"
        Call ReceiveDisplay(strTemp, 3)
    Else
        strTemp = "设置:串行口已关闭!"
        Call ReceiveDisplay(strTemp, 3)
    End If
End Sub

'*************************************************
'MSComm事件处理
'响应MSComm事件作出相关处理
'*************************************************
Private Sub MSComm1_OnComm()
    Select Case Main.MSComm1.CommEvent
        Case comEvReceive
            If intCommFlag = 1 Then
                Call InputManager
                intCommFlag = 1
            End If
    End Select
End Sub

'*************************************************
'选择接收
'准备接收文件
'*************************************************
Private Sub option2_Click()
    option2.Value = True
    blnFileTransFlag = False
End Sub

'*************************************************
'选择发送
'准备发送文件
'*************************************************
Private Sub option1_Click()
    option1.Value = True
    blnFileTransFlag = True
End Sub


'************************************************
'响应按键
'实现利用回车键即可发送消息的功能
'************************************************

Private Sub tc_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
      Call Main.xSend_Click
    End If
End Sub

'************************************************
'信息显示处理
'记录发送接收及串口设置信息，保存显示格式（颜色）
'************************************************
Public Sub ReceiveDisplay(strAdd As String, intColor As Long)
    intArrayCount = intArrayCount + 2               '收到新信息,信息记录计数增加
    ReDim Preserve intColorSet(intArrayCount)       '重定义纪录数组,保留原有数据
End Sub