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