frmcommclient.frm

基于VC++串口编程。经过好长时间的寻找

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form frmCommClient 
   Caption         =   "客户端主动应答"
   ClientHeight    =   6732
   ClientLeft      =   60
   ClientTop       =   348
   ClientWidth     =   7728
   LinkTopic       =   "Form1"
   ScaleHeight     =   6732
   ScaleWidth      =   7728
   StartUpPosition =   2  'CenterScreen
   Begin VB.ListBox lstFile 
      Height          =   816
      Left            =   945
      TabIndex        =   4
      Top             =   5700
      Width           =   3960
   End
   Begin VB.ListBox lstRec 
      Height          =   1776
      Left            =   975
      TabIndex        =   3
      Top             =   3795
      Width           =   6180
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   360
      Left            =   120
      TabIndex        =   0
      Top             =   2940
      Width           =   900
   End
   Begin VB.TextBox Text1 
      Height          =   3225
      Left            =   1170
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   1
      Top             =   105
      Width           =   6420
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   135
      Top             =   240
      _ExtentX        =   995
      _ExtentY        =   995
      _Version        =   393216
      DTREnable       =   -1  'True
      Handshaking     =   2
      InBufferSize    =   2048
      NullDiscard     =   -1  'True
      OutBufferSize   =   2048
      RThreshold      =   1
      InputMode       =   1
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Label1"
      Height          =   195
      Left            =   1155
      TabIndex        =   2
      Top             =   3465
      Width           =   480
   End
End
Attribute VB_Name = "frmCommClient"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'能发多个文件

'自动应答实现连接，连接后进入数据交换状态
'等待主叫方发送g_GIVE_ME_DATA 命令
'超时则断开连接并复位端口
'终端以二进制形式接收服务器发来的所要数据命令

'Timer延时要改************

Public bCommSetOK As Boolean

Const g_WAIT = 60
Const g_SENDDATALENGTH = 768  '发送二进制文件内容块大小

Dim SednArr(1 To g_SENDDATALENGTH) As Byte    '定义字节型数组

'接收服务器所要数据标识
Const g_GIVE_ME_DATA = "@G@"  '给我数据
Const g_GIVE_ME_REC = "@R@"   '给我记录
Const g_GIVE_ME_FILE = "@F@"  '给我文件
Const g_I_GET_IT = "@I@"      '我得到了（一条记录）
Const g_CHAREND = "&*@"       '发给服务器的文本信息结尾符

Dim Connected As Boolean    '当前是否处于连接状态

Private Sub Form_Load()
'初始化端口
    If InitComm = False Then
        MsgBox "端口初始化错误！"
        End
    End If
    
    Call GetRecToSend
    
    Me.Show
End Sub

Private Sub Form_Unload(Cancel As Integer)
'挂断并关闭通讯端口
    Call HangUp
    End
End Sub

'响应通讯端口数据接收事件
Private Sub MSComm1_OnComm()
Dim VARC As Variant, sJS As String
Dim N As Long, t As Single

    If Connected = True Then    '处于连接状态则不响应此事件
        Exit Sub
    End If
    
    Select Case MSComm1.CommEvent
        Case comEvReceive
            N = MSComm1.InBufferCount
            MSComm1.InputLen = 0
            VARC = Space(N)
            VARC = MSComm1.Input
            sJS = HandleData(VARC)
            Text1.SelStart = Len(Text1.Text)
            Text1.SelLength = 0
            Text1.SelText = sJS
            
            If InStr(Text1.Text, "CONNECT") > 0 Or MSComm1.CDHolding = True Then
            '已经建立连接
                Connected = True
                Call EchoOff(MSComm1)           '关掉返回结果码
                Call ResultCodesOff(MSComm1)    '关掉字符会应
                MSComm1.RThreshold = 0          '不再产生字符接收事件

                Call ChangeData         '进入数据交换状态
            End If
        Case Else
    End Select
End Sub

' 初始化通讯端口
Private Function InitComm() As Boolean
Dim commPort  As String
Dim commSettings As String
Dim commHandShaking As String
Dim An As Integer
    
    On Error Resume Next
    If MSComm1.PortOpen = True Then
        MSComm1.PortOpen = False
    End If
    
    commSettings = GetSetting("通讯端口设置", "Properties", "Settings", "")
    Do While commSettings = ""
        Load frmCommProperties
        Set frmCommProperties.frmComm = Me
        Call frmCommProperties.LoadPropertySettings

        frmCommProperties.Show vbModal
        If bCommSetOK = False Then
            An = MsgBox("您必须进行端口设置，否则程序无法运行" & vbCrLf & "重新设置吗？", vbYesNo + vbQuestion, "端口设置错误")
            If An = vbNo Then
                InitComm = False
                Exit Function
            End If
        Else
            Exit Do
        End If
    Loop

    commSettings = GetSetting("通讯端口设置", "Properties", "Settings", "")
    commPort = GetSetting("通讯端口设置", "Properties", "CommPort", "")
    commHandShaking = GetSetting("通讯端口设置", "Properties", "Handshaking", "")
    
    MSComm1.Settings = commSettings
    MSComm1.commPort = commPort
    MSComm1.Handshaking = commHandShaking
    MSComm1.RThreshold = 1  '产生comEvReceive事件
    MSComm1.PortOpen = True
    Connected = False
    
    If Err = 0 Then
        MSComm1.DTREnable = True
        Dim t As Single
        t = Timer + g_WAIT
        Do While Timer < t
            If MSComm1.CTSHolding = True Then
                Exit Do
            End If
            DoEvents
        Loop
        
        If MSComm1.CTSHolding = True Then
            Call EchoOn(MSComm1)            '打开字符回应
            Call ResultCodesOn(MSComm1)     '返回结果码
            Call SpeakerOff(MSComm1)        '关闭扬声器
            Call AnswerAuto(MSComm1)        '自动应答

            Text1.Text = ""
            Label1.Caption = ""
            InitComm = True
        Else
            InitComm = False
        End If
    Else
        InitComm = False
    End If
End Function

'挂断电话连接
Private Sub HangUp()
Dim RET
    If MSComm1.PortOpen = True Then
        Call OffHook(MSComm1)
        RET = MSComm1.DTREnable             ' 保存当前设置。
        MSComm1.DTREnable = True            ' 打开 DTR 。
        MSComm1.DTREnable = False           ' 关闭 DTR 。
        MSComm1.DTREnable = True            ' 打开 DTR 。
        MSComm1.DTREnable = RET             ' 恢复原来的设置。
        Call Reset(MSComm1)                 '
        MSComm1.PortOpen = False
    End If
End Sub

'处理接收到的字符，去掉空格和回车换行符
Private Function HandleData(Data As Variant) As String
Dim i As Long, s As String

    If MSComm1.InputMode = comInputModeBinary Then
        s = StrConv(Data, vbUnicode)
    Else
        s = Data
    End If
    s = Trim(s)
    ' 过滤/处理空格符。
    Do
       i = InStr(s, " ")
       If i Then
          If i = 1 Then
             s = Mid(s, i + 1)
          Else
             s = left(s, i - 1) & Mid(s, i + 1)
          End If
       End If
    Loop While i

    ' 除去换行符。
    Do
       i = InStr(s, Chr$(10))
       If i Then
          s = left$(s, i - 1) & Mid$(s, i + 1)
       End If
    Loop While i
    
    ' 除去回车符。
    Do
       i = InStr(s, Chr$(13))
       If i Then
          s = left$(s, i - 1) & Mid$(s, i + 1)
       End If
    Loop While i
    
    HandleData = s
End Function