VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmComServer 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "獲取各崗亭拍照記錄"
   ClientHeight    =   5925
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6930
   BeginProperty Font 
      Name            =   "宋體"
      Size            =   10.5
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmMSComServer.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5925
   ScaleWidth      =   6930
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin MSComctlLib.ProgressBar prsFile 
      Height          =   216
      Left            =   1476
      TabIndex        =   4
      Top             =   2100
      Width           =   5340
      _ExtentX        =   9419
      _ExtentY        =   370
      _Version        =   393216
      Appearance      =   1
   End
   Begin MSComctlLib.ListView lstRun 
      Height          =   1944
      Left            =   1476
      TabIndex        =   3
      Top             =   120
      Width           =   5340
      _ExtentX        =   9419
      _ExtentY        =   3440
      View            =   3
      LabelWrap       =   0   'False
      HideSelection   =   -1  'True
      HideColumnHeaders=   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.CommandButton cmdGetData 
      Caption         =   "獲取"
      Height          =   396
      Left            =   156
      TabIndex        =   2
      Top             =   1344
      Width           =   1140
   End
   Begin MSComctlLib.ListView lstViwCapture 
      Height          =   3432
      Left            =   120
      TabIndex        =   1
      Top             =   2412
      Width           =   6696
      _ExtentX        =   11800
      _ExtentY        =   6059
      LabelWrap       =   0   'False
      HideSelection   =   -1  'True
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.CommandButton cmdHide 
      Cancel          =   -1  'True
      Caption         =   "隱藏"
      Height          =   396
      Left            =   156
      TabIndex        =   0
      Top             =   1848
      Width           =   1140
   End
   Begin VB.Timer timGetData 
      Enabled         =   0   'False
      Interval        =   60000
      Left            =   876
      Top             =   2136
   End
   Begin MSCommLib.MSComm MSComm1 
      Left            =   165
      Top             =   2070
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      CommPort        =   4
      DTREnable       =   -1  'True
      Handshaking     =   2
      InBufferSize    =   2048
      OutBufferSize   =   2048
      RTSEnable       =   -1  'True
      BaudRate        =   56000
      InputMode       =   1
   End
   Begin VB.Image Image1 
      Height          =   1068
      Left            =   192
      Picture         =   "frmMSComServer.frx":030A
      Stretch         =   -1  'True
      Top             =   156
      Width           =   1092
   End
End
Attribute VB_Name = "frmComServer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Const MF_REMOVE = &H1000&
Private Const MF_BYPOSITION = &H400&

'與自動應答連OK
'收不到文件尾問題通過發送端文件尾數據發送后延時得以解決
'收到文件超長，通過從緩沖區中讀定長數據方法得以解決

Public bCommSetOK As Boolean

'終端工作錯誤狀態
Const WRONG_NET = 0
Const WRONG_V1 = 1
Const WRONG_V2 = 2

Const Wait = 30 '
Const SENDDATALENGTH = 768

Const GIVE_ME_DATA = "@G@"
Const GIVE_ME_REC = "@R@"
Const GIVE_ME_FILE = "@F@"
Const I_GET_IT = "@I@"
Const I_GET_ALL_REC = "@A@"
Const CHAREND = "&*@"

Dim nInterval As Integer
Dim nClientsCount As Integer    '終端數量
Dim sClientNames() As String         '終端電話
Dim sClientPhones() As String   '各終端電話號碼
Dim nCurrentClientNo As Integer

Dim JSFILEDATA As Variant
Dim JSARR() As Byte
Dim tmpARR() As Byte

Dim itemX As ListItem

'主動獲取數據
Private Sub cmdGetData_Click()
    'Call GetClientsData
    ConnectClient "8056795"

Dim t As Single
Dim JSData As Variant, JSstring As String

    '等待Wait 秒，如果無數據，則錯誤返回空字符串
    JSstring = ""
    t = Timer
    Do While 1
        If Timer > t + 5 Then
            Exit Do
        End If
        If MSComm1.InBufferCount > 0 Then
            MSComm1.InputLen = 0
            JSData = MSComm1.Input
            JSstring = JSstring & HandleData(JSData)
            If InStr(1, JSstring, CHAREND) > 0 Then
                Exit Do
            End If
        End If
        DoEvents
    Loop
    MsgBox JSstring
    
End Sub

'隱藏窗體
Private Sub cmdHide_Click()
    Me.Hide
End Sub

Private Sub Form_Load()
    Call RemoveX(Me.hWnd)
    
    '初始化端口
    If InitComm = False Then
        MsgBox "端口初始化錯誤！"
        timGetData.Enabled = False
    End If
    
    Call InitLstViw
    timGetData.Enabled = True

End Sub

' 初始化通訊端口
Private Function InitComm() As Boolean
Dim commSettings As String
Dim commPort  As String
Dim commHandShaking As String
Dim an As Integer
Dim t As Single

    On Error Resume Next
    
    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.Settings = "56000,n,8,1"
    MSComm1.commPort = 4
    MSComm1.Handshaking = 2
    
    MSComm1.RThreshold = 0
    MSComm1.PortOpen = True
    
    If Err = 0 Then
        MSComm1.DTREnable = True
        t = Timer
        Do While 1
            If Timer > t + Wait Then
                Exit Do
            ElseIf Timer < t And Timer > Wait Then
                Exit Do
            End If
            If MSComm1.CTSHolding = True Then
                Exit Do
            End If
            DoEvents
        Loop
        
        If MSComm1.CTSHolding = True Then
            MSComm1.Output = "ATQ0" & vbCrLf    ' 返回結果碼
            MSComm1.Output = "ATE1" & vbCrLf    ' 開字符回應
            MSComm1.Output = "ATM1" & vbCrLf    ' 打開揚聲器
'            MSComm1.Output = "ATC1" & vbCrLf
            InitComm = True
        Else
            InitComm = False
        End If
    Else
        InitComm = False
    End If
End Function

'單客戶數據獲取
Private Sub Image1_DblClick()
    If cmdGetData.Enabled = False Then
    '正在獲取數據，不可
    Else
    
    End If
End Sub

Private Sub timGetData_Timer()
    nInterval = nInterval + 1
    If nInterval >= g_nGetDataInterval Then
        Call GetClientsData
    End If
End Sub

' 向各個終端要數據
Private Sub GetClientsData()
Dim i As Integer

    cmdGetData.Enabled = False
'關閉要數據時鐘
    timGetData.Enabled = False
    lstRun.ListItems.Clear
    lstViwCapture.ListItems.Clear
    prsFile.Value = 0
'設置終端數量和各個終端電話號碼、名稱
    Call GetClientsSetting
    
'順次獲取各終端數據
    nCurrentClientNo = 1
    Do While nCurrentClientNo <= nClientsCount
        Call GetClientData(sClientPhones(nCurrentClientNo))
        Set itemX = lstRun.ListItems.Add(, , sClientPhones(nCurrentClientNo) & "數據接收完畢！")
        itemX.EnsureVisible
        DoEvents

Dim t As Single
        t = Timer + 1#
        Do While Timer < t
            DoEvents
        Loop
        
        Call HangUp
        Call InitComm
        
        nCurrentClientNo = nCurrentClientNo + 1
    Loop
    
    Set itemX = lstRun.ListItems.Add(, , "所有數據接收完畢！")
    itemX.EnsureVisible
    
    lstRun.ListItems.Clear
    
'將記錄數據發送到主窗體
    Call SendRecToMain
'打開要數據時鐘
    cmdGetData.Enabled = True
    timGetData.Enabled = True
    g_nGetDataInterval = 0
End Sub

' 向單個終端要數據,對應電話號碼為sPhone
Private Sub GetClientData(ByVal sClientPhone As String)
Dim sVideoandRecCount As String
Dim i As Integer, RecCount As Integer
Dim bV1 As Boolean, bV2 As Boolean

    '與終端建立連接
    If ConnectClient(sClientPhone) = False Then
    '連接失敗，則報警對應終端工作狀態
        Call WrongWorkClient(WRONG_NET)
        Set itemX = lstRun.ListItems.Add(, , "連接失敗")
        itemX.EnsureVisible
    Else
    '連接成功，則發GIVE_ME_DATA命令
        If SendChar(GIVE_ME_DATA) = False Then
            Set itemX = lstRun.ListItems.Add(, , "發送GIVE_ME_DATA失敗")
            itemX.EnsureVisible
        Else
        '發送命令之后，接收視頻和記錄數
            sVideoandRecCount = GetReChar()
            If sVideoandRecCount = "" Then
                Set itemX = lstRun.ListItems.Add(, , "獲取視頻和記錄數失敗")
                itemX.EnsureVisible
            Else '分析視頻和記錄數
                '分析處理視頻和記錄數，返回記錄數
Set itemX = lstRun.ListItems.Add(, , sVideoandRecCount)
itemX.EnsureVisible
                RecCount = AnalyVandRecCount(sVideoandRecCount, bV1, bV2)
                If bV1 = False Then
                    Call WrongWorkClient(WRONG_V1)
                End If
                If bV2 = False Then
                    Call WrongWorkClient(WRONG_V2)
                End If
                
                Set itemX = lstRun.ListItems.Add(, , "記錄數為：" & Format(RecCount))
                itemX.EnsureVisible
                DoEvents
                
                If RecCount > 0 Then
                    '逐條獲取記錄信息
                    For i = 1 To RecCount
                        Set itemX = lstRun.ListItems.Add(, , "獲取第" & Format(i) & "條記錄")
                        itemX.EnsureVisible
                        Call GetRec
                    Next i
                End If
                
                SendChar (I_GET_ALL_REC)
            End If
        End If
    End If
End Sub

' 獲取一條記錄，包括文本和圖片文件
Private Sub GetRec()
Dim FL As Long
Dim sFile As String
Dim sRecText As String

    If SendChar(GIVE_ME_REC) = False Then
        Set itemX = lstRun.ListItems.Add(, , "發送GIVE_ME_REC失敗,記錄獲取失敗")
        itemX.EnsureVisible
        Exit Sub
    End If

    '接收記錄文本信息，并處理
    sRecText = GetReChar()
    If sRecText = "" Then
        Set itemX = lstRun.ListItems.Add(, , "接收記錄文本信息失敗")
        itemX.EnsureVisible
        Exit Sub
    End If
        
    '分析記錄文本信息，新增一條lstviwCapture列表項，并返回圖片文件名
    sFile = AnalyRecText(sRecText, FL)
    If sFile <> "" Then '收到的記錄文本信息正確
        If GetFile(sFile, FL) = True Then
        '文本和文件都接收正確，則形成一條拍照記錄
            Call AddNewRec
        Else
            lstViwCapture.ListItems.Remove lstViwCapture.SelectedItem.Index
            Set itemX = lstRun.ListItems.Add(, , "接收記錄圖片文件失敗")
            itemX.EnsureVisible
        End If
    Else
        Set itemX = lstRun.ListItems.Add(, , "接收記錄文本信息失敗")
        itemX.EnsureVisible
    End If
End Sub

'連接終端，號碼為sPhone
'待試占線情況*****************
Private Function ConnectClient(ByVal sPhone As String) As Boolean
Dim t As Single

    sPhone = Trim(sPhone)
    If MSComm1.PortOpen = False Then
        ConnectClient = False
        Exit Function
    End If
    
    Set itemX = lstRun.ListItems.Add(, , "正在與" & sPhone & "連接...")
    itemX.EnsureVisible