MSComm1.Output = "ATDT" & sPhone & vbCrLf
    
    t = Timer
    Do While 1
        If Timer > t + Wait Then
            Exit Do
        ElseIf Timer < t And Timer > Wait Then
            Exit Do
        End If
        DoEvents
        If MSComm1.CDHolding = True Then
            Exit Do
        End If
    Loop
    
    If MSComm1.CDHolding = False Then
        ConnectClient = False
        Exit Function
    Else
        ConnectClient = True
        Set itemX = lstRun.ListItems.Add(, , "連接成功！")
        itemX.EnsureVisible
    End If
        
End Function

Private Sub Form_Unload(Cancel As Integer)
    Call HangUp
End Sub

'接收文件,定長數據塊
Private Function GetFile(ByVal FileName As String, ByVal FileL As Long) As Boolean
Dim hJS As Integer, t As Single
Dim JSFileName As String
Dim JSLen As Long
Dim lWriteL As Long '實際要寫入的文件數據長度

    prsFile.Max = FileL
    prsFile.Min = 0
    prsFile.Value = 0
    
    '打開接收文件
    hJS = FreeFile
    JSFileName = GetAppPath & "Jpg\" & FileName
    Open JSFileName For Binary Access Write As hJS
        
    '發送要文件命令
    If SendChar(GIVE_ME_FILE) = False Then
        Set itemX = lstRun.ListItems.Add(, , "發送GIVE_ME_FILE失敗，文件接收失敗")
        itemX.EnsureVisible
        GoTo WrongGetFile
    End If
    
    '接收文件內容，直到完全
    JSLen = 0
    Do While JSLen < FileL
        If FileL - JSLen > SENDDATALENGTH Then
            lWriteL = SENDDATALENGTH
        Else
            lWriteL = FileL - JSLen
        End If
            
        If GetFileData(lWriteL) = False Then
            Set itemX = lstRun.ListItems.Add(, , "文件接收失敗")
            itemX.EnsureVisible
            GoTo WrongGetFile
        End If
        
        ReDim JSARR(1 To lWriteL)
        JSARR = JSFILEDATA
        
        '將字節型數組中的數據寫入已打開的接收文件
        Put hJS, , JSARR
        JSLen = JSLen + lWriteL '本次已累計收到的字節數
        prsFile.Value = JSLen
        
        If JSLen < FileL Then
            '未完，則發送GIVE_ME_FILE
            If SendChar(GIVE_ME_FILE) = False Then
                Set itemX = lstRun.ListItems.Add(, , "繼續發送GIVE_ME_FILE失敗，文件接收失敗")
                itemX.EnsureVisible
                GoTo WrongGetFile
            End If
        Else
            '文件傳輸已結束,關閉接收文件
            If SendChar(I_GET_IT) = False Then
                Set itemX = lstRun.ListItems.Add(, , "繼續發送I_GET_IT失敗，文件接收失敗")
                itemX.EnsureVisible
                GoTo WrongGetFile
            End If
            '延遲
            t = Timer
            Do While Timer < t + 1
                If Timer < t Then
                    Exit Do
                End If
            Loop
            
            Close hJS
            Set itemX = lstRun.ListItems.Add(, , "文件接收成功")
            itemX.EnsureVisible
            prsFile.Value = 0
            GetFile = True

            Exit Function
        End If
    Loop

WrongGetFile:
    Close hJS
    prsFile.Value = 0
    GetFile = False
End Function

Private Sub HangUp()
Dim Ret
    If MSComm1.PortOpen = True Then
        MSComm1.Output = "ATH" & vbCrLf     ' 發送掛機字符串。
        Ret = MSComm1.DTREnable             ' 保存當前設置。
        MSComm1.DTREnable = True            ' 打開 DTR 。
        MSComm1.DTREnable = False           ' 關閉 DTR 。
        MSComm1.DTREnable = Ret             ' 恢復原來的設置。
        MSComm1.PortOpen = False
    End If
End Sub

'向終端發送字符串信息
Private Function SendChar(ByVal s As String) As Boolean
Dim t As Single
Dim vTmp As Variant

    '清空接收緩沖區
    MSComm1.InputLen = 0
    vTmp = MSComm1.Input
    
    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 Then
            MSComm1.Output = s
            SendChar = True
            Exit Function
        End If
        DoEvents
    Loop
    
    SendChar = False
End Function

'接收終端傳來的文本信息,以&*@結尾
Private Function GetReChar() As String
Dim t As Single
Dim JSData As Variant, JSstring As String

    '等待Wait 秒，如果無數據，則錯誤返回空字符串
    JSstring = ""
    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.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
    
    GetReChar = JSstring
End Function

'接收終端傳來的定長文件信息，二進制
Private Function GetFileData(ByVal lWL As Long) As Boolean
Dim t As Single
Dim tmp As Variant

    '轉為二進制模式
    If MSComm1.InputMode = comInputModeText Then
        MSComm1.InputMode = comInputModeBinary
    End If
    
    '等待Wait 秒，如果無數據，則錯誤返回
    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.InBufferCount < lWL Then
        Else
            ReDim tmpARR(1 To lWL)
            JSFILEDATA = tmpARR
            
            MSComm1.InputLen = lWL
            JSFILEDATA = MSComm1.Input
            
            '清空
            MSComm1.InputLen = 0
            tmp = MSComm1.Input
            
            GetFileData = True
            Exit Function
        End If
        DoEvents
    Loop
    
    GetFileData = False
End Function

'分析視頻狀態和待傳記錄數
's=@True@False@RecCount@
Private Function AnalyVandRecCount(ByVal s As String, bV1 As Boolean, bV2 As Boolean) As Integer
Dim iPosi1 As Integer, iPosi2 As Integer
Dim iPosi3 As Integer, iPosi4 As Integer

    iPosi1 = InStr(1, s, "@")
    If iPosi1 <= 0 Then
        AnalyVandRecCount = 0
        Exit Function
    End If
    
    iPosi2 = InStr(iPosi1 + 1, s, "@")
    iPosi3 = InStr(iPosi2 + 1, s, "@")
    iPosi4 = InStr(iPosi3 + 1, s, "@")
    
    bV1 = Mid(s, iPosi1 + 1, iPosi2 - iPosi1 - 1)
    bV2 = Mid(s, iPosi2 + 1, iPosi3 - iPosi2 - 1)
    AnalyVandRecCount = Val(Mid(s, iPosi3 + 1, iPosi4 - iPosi3 - 1))
End Function

'分析文本，返回文件名，并由FL返回文件長度
'sRecText=@行車方向@日期@時間@圖片名稱@文件長度@
'sRecText="@由東向西@2000年3月21日@17:12:34@C1-R1-2000-3-21-17-12-34.Jpg@33068@"
Private Function AnalyRecText(ByVal sRecText As String, FL As Long) As String
Dim sDirection As String, sFile As String
Dim sDay As Date, sTime As Date
Dim nPos1 As Integer, nPos2 As Integer

    nPos1 = InStr(1, sRecText, "@")
    If nPos1 <= 0 Then
        AnalyRecText = ""
        Exit Function
    End If
    
    '行車方向
    nPos2 = InStr(nPos1 + 1, sRecText, "@")
    sDirection = Mid(sRecText, nPos1 + 1, nPos2 - nPos1 - 1)
    
    nPos1 = nPos2
    '日期
    nPos2 = InStr(nPos1 + 1, sRecText, "@")
    sDay = Mid(sRecText, nPos1 + 1, nPos2 - nPos1 - 1)
    
    nPos1 = nPos2
    '時間
    nPos2 = InStr(nPos1 + 1, sRecText, "@")
    sTime = Mid(sRecText, nPos1 + 1, nPos2 - nPos1 - 1)
    
    nPos1 = nPos2
    '圖片文件
    nPos2 = InStr(nPos1 + 1, sRecText, "@")
    sFile = Mid(sRecText, nPos1 + 1, nPos2 - nPos1 - 1)

    nPos1 = nPos2
    '文件長度
    nPos2 = InStr(nPos1 + 1, sRecText, "@")
    FL = Val(Mid(sRecText, nPos1 + 1, nPos2 - nPos1 - 1))
    
    Set itemX = lstViwCapture.ListItems.Add(, , Format(lstViwCapture.ListItems.Count + 1))
    itemX.SubItems(1) = sClientNames(nCurrentClientNo)
    itemX.SubItems(2) = sDirection
    itemX.SubItems(3) = Format(sDay, "Long Date")
    itemX.SubItems(4) = Format(sTime, "Long Time")
    itemX.SubItems(5) = sFile
    Set lstViwCapture.SelectedItem = itemX
    
    AnalyRecText = sFile
End Function

'處理號碼為sClientPhone 的終端工作狀態
Private Sub WrongWorkClient(ByVal nWrong As Integer)
Dim i As Integer

    For i = 1 To frmServer.lstViwClients.ListItems.Count
        Set itemX = frmServer.lstViwClients.ListItems(i)
        If itemX.SubItems(1) = sClientNames(i) Then
            Exit For
        End If
    Next i
    
    itemX.Icon = 1
    itemX.SmallIcon = 1
    
    If nWrong = WRONG_NET Then
        itemX.SubItems(2) = "不通"
    ElseIf nWrong = WRONG_V1 Then
        itemX.SubItems(3) = "損壞"
    Else
        itemX.SubItems(4) = "損壞"
    End If
End Sub

'處理接收到的字符，去掉空格和回車換行符
Private Function HandleData(Data As Variant) As String
Dim i As Long
Dim 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

'新加一條記錄
Private Sub AddNewRec()
Dim rs As Recordset
    
    Set itemX = lstViwCapture.SelectedItem
    '添加新紀錄
    g_nNewRecID = g_nNewRecID + 1
    Set rs = g_myDB.OpenRecordset("tabCaptureRec")
    rs.AddNew
        rs!fldID = g_nNewRecID
        rs!fldPostName = itemX.SubItems(1)
        rs!fldDirection = itemX.SubItems(2)
        rs!fldCapDate = CDate(itemX.SubItems(3))
        rs!fldCapTime = CDate(itemX.SubItems(4))
        rs!fldJpgFile = itemX.SubItems(5)
        rs!fldPrinted = False
    rs.Update
    
    itemX.Tag = g_nNewRecID
    rs.Close
End Sub

'初始化列表
Private Sub InitLstViw()
Dim i As Integer

    lstRun.View = lvwReport
    lstRun.ColumnHeaders.Add , , "運行監視", 5000
    
    lstViwCapture.View = lvwReport
    lstViwCapture.ColumnHeaders.Add , , "No", 360
    lstViwCapture.ColumnHeaders.Add , , "      記錄來源", 2700
    lstViwCapture.ColumnHeaders.Add , , "行駛方向", 1050
    lstViwCapture.ColumnHeaders.Add , , "拍照日期", 1265
    lstViwCapture.ColumnHeaders.Add , , "拍照時間", 1265
    lstViwCapture.ColumnHeaders.Add , , "圖片名稱", 0
    For i = 3 To lstViwCapture.ColumnHeaders.Count
        lstViwCapture.ColumnHeaders(i).Alignment = lvwColumnCenter
    Next i
End Sub

'設置終端數量和各個終端電話號碼、名稱
Public Sub GetClientsSetting()
Dim rs As Recordset, i As Integer

    Set rs = g_myDB.OpenRecordset("Select * from tabPostSettings where fldWork = True", dbOpenSnapshot)
    If rs.EOF Then
        nClientsCount = 0
    Else
        rs.MoveLast
        nClientsCount = rs.RecordCount
        ReDim sClientNames(1 To nClientsCount)
        ReDim sClientPhones(1 To nClientsCount)
        rs.MoveFirst
        For i = 1 To nClientsCount
            sClientPhones(i) = rs!fldPhoneNumber
            sClientNames(i) = rs!fldPostName
            rs.MoveNext
        Next i
    End If
    rs.Close
End Sub

'發送記錄
Private Sub SendRecToMain()
Dim i As Integer, j As Integer
    
    If lstViwCapture.ListItems.Count <= 0 Then
        Exit Sub
    End If
    
    For i = 1 To lstViwCapture.ListItems.Count
        Set itemX = frmServer.lstViwCapture.ListItems.Add(, , Format(frmServer.lstViwCapture.ListItems.Count + 1))
        For j = 1 To 2
            itemX.SubItems(j) = lstViwCapture.ListItems(i).SubItems(j)
        Next j
        
        itemX.SubItems(3) = lstViwCapture.ListItems(i).SubItems(3) & lstViwCapture.ListItems(i).SubItems(4)
        itemX.SubItems(4) = lstViwCapture.ListItems(i).SubItems(5)
        itemX.Tag = lstViwCapture.ListItems(i).Tag
    Next i
    
    lstViwCapture.ListItems.Clear   '發送完畢后清除
End Sub

'禁止關閉窗體
Private Sub RemoveX(hWnd As Long)
Dim hMenu As Long
Dim menuItemCount As Long

    hMenu = GetSystemMenu(hWnd, 0)
    If hMenu Then
        menuItemCount = GetMenuItemCount(hMenu)
        RemoveMenu hMenu, menuItemCount - 1, MF_REMOVE Or MF_BYPOSITION
        RemoveMenu hMenu, menuItemCount - 2, MF_REMOVE Or MF_BYPOSITION
        DrawMenuBar hWnd
    End If
End Sub