rplyfile.cls

GPS车辆监控,vb代码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "CReplayFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Type Record
    nID As Integer
    dTime As Date
    fLongitude As Double
    fLatitude As Double
    bAlert As Boolean
    fSpeed As Double
    fDirection As Double
End Type

Private m_strFileName As String
Private m_lMaxRecord As Long
Private m_uRecord As Record
Private m_lFileNum As Long
Private Sub bjch(ByVal dd As Integer)
Dim ddd As Integer
Dim ccc As Integer
ddd = MDIMainForm.oTargetManager.GetIndexByName(Val(CfCh))
ccc = MDIMainForm.oTargetManager.GetIndexByID(dd)
If ddd = ccc Then
    Qren = True
Else
    Qren = False
End If
End Sub
Private Function SjBj(ByVal bfjs As String) As Boolean
Dim ddd As String
Dim ccc As String
    ddd = Trim(bfjs)
    For i = 1 To Len(ddd)
      ccc = Mid(ddd, i, 1)
      If ccc = " " Then
         ff = i
         Exit For
      End If
   Next
   sss = Mid(ddd, ff + 1, Len(ddd) - ff)
   shi = ""
   For i = 1 To Len(sss)
       ccc = Mid(sss, i, 1)
       If ccc <> ":" Then
          shi = shi + ccc
       Else
          Exit For
       End If
   Next
   If Val(shi) > Val(CfTotime) Then
      SjBj = True
   Else
      SjBj = False
   End If


End Function
Public Sub wz()
Dim ddd As String
Dim ccc As String
Dim sss As String
Dim shi As String
Dim j As Integer
Dim wzhflag As Boolean
Dim i As Integer
Dim Y As Integer
Do While Not EOF(m_lFileNum)
   Get #m_lFileNum, , m_uRecord
   ddd = m_uRecord.dTime
   'ddd = m_uRecord.fDirection
   For i = 1 To Len(ddd)
      ccc = Mid(ddd, i, 1)
      If ccc = " " Then
         ff = i
         Exit For
      End If
   Next
   sss = Mid(ddd, ff + 1, Len(ddd) - ff)
   shi = ""
   Y = 0
   For i = 1 To Len(sss)
       ccc = Mid(sss, i, 1)
       If ccc <> ":" Then
          shi = shi + ccc
       Else
          Y = Y + 1
          If Y = 2 Then
             Exit For
          End If
       End If
   Next
   If j = 0 Then
      If Val(shi) > Val(CfTotime) Then
           MsgBox "时间选择错误", vbInformation, App.title
           MDIMainForm.oWorkMode.OndutyInit True
      End If
   End If
'   Wzq = Seek(m_lFileNum)
   
   If Val(shi) >= Val(CfTime) Then
       
       If shi <> "" Then
            Wzq = Seek(m_lFileNum)
       Else
            Wzq = 1
       End If
       Exit Do
   End If
   j = j + 1
Loop



Do While Not EOF(m_lFileNum)
   Get #m_lFileNum, , m_uRecord
   ddd = m_uRecord.dTime
   If Len(ddd) > 9 Then
   For i = 1 To Len(ddd)
      ccc = Mid(ddd, i, 1)
      If ccc = " " Then
         ff = i
         Exit For
      End If
   Next
   sss = Mid(ddd, ff + 1, Len(ddd) - ff)
   shi = ""
   Y = 0
   For i = 1 To Len(sss)
       ccc = Mid(sss, i, 1)
       If ccc <> ":" Then
          shi = shi + ccc
       Else
          Y = Y + 1
          If Y = 2 Then
             Exit For
          End If
       End If
   Next
   If Val(shi) > Val(CfTotime) Then
       If shi <> "" Then
       
             Wzh = Seek(m_lFileNum)
             Wzh = Wzh - 2
       Else
          Wzh = GetMaxRecord
          
       End If
      wzhflag = True
      Exit Do
   End If
  End If
Loop
   
If wzhflag = False Then
   Wzh = GetMaxRecord
Else
   wzhflag = False
End If
 'If wz <> 0 Then
  Seek #m_lFileNum, Wzq
  
' End If
 Cfone = False
End Sub
Public Sub SetFileName(ByVal strFileName As String)
    m_strFileName = strFileName
End Sub
Public Function ROpen() As Boolean
    On Error GoTo errhandle
    m_lFileNum = FreeFile
    Open m_strFileName For Random Access Read As #m_lFileNum Len = Len(m_uRecord)
    If LOF(m_lFileNum) Mod Len(m_uRecord) <> 0 Then
        Close #m_lFileNum
        ROpen = False
        Exit Function
    End If
    m_lMaxRecord = LOF(m_lFileNum) \ Len(m_uRecord)
    ROpen = True
    Exit Function
errhandle:
    ROpen = False
End Function
Public Function RWOpen() As Boolean
    On Error GoTo errhandle
    m_lFileNum = FreeFile
    Open m_strFileName For Random Access Read Write As m_lFileNum Len = Len(m_uRecord)
    If LOF(m_lFileNum) Mod Len(m_uRecord) <> 0 Then
        Close #m_lFileNum
        RWOpen = False
        Exit Function
    End If
    m_lMaxRecord = LOF(m_lFileNum) \ Len(m_uRecord)
    RWOpen = True
    Exit Function
errhandle:
    RWOpen = False
End Function
Public Function CloseFile()
    Close #m_lFileNum
End Function

Public Function GetRecord(ByVal oRecord As CRecord) As Integer
    Dim lCurrentRecord As Long
    Dim strCommID As String
    Dim bfsj As String
    Dim bfch As Integer
    Dim i As Integer
    'lCurrentRecord = wz
    
    lCurrentRecord = Seek(m_lFileNum)
    If lCurrentRecord <= Wzh Then
        
        Get #m_lFileNum, , m_uRecord
        'bfsj = str(m_uRecord.dTime)
        bfch = m_uRecord.nID
       ' If Not SjBj(bfsj) Then
          If Cfflag = False Then
            bjch bfch
          End If
        oRecord.dTime = m_uRecord.dTime
        oRecord.nID = m_uRecord.nID
        oRecord.fLongitude = m_uRecord.fLongitude
        oRecord.fLatitude = m_uRecord.fLatitude
        oRecord.bAlert = m_uRecord.bAlert
        oRecord.fSpeed = m_uRecord.fSpeed
        
        oRecord.fDirection = m_uRecord.fDirection
        'MDIMainForm.Caption = oRecord.fDirection
        If oRecord.bAlert = True Then
           cfAlert = True
        End If
        Seek #m_lFileNum, lCurrentRecord
         GetRecord = RT_SUCCESS
        'Else
          'MDIMainForm.oWorkMode.SetModeNone
          'Cfflag = False
          'MsgBox "重放完毕!"
        '  GetRecord = RT_EOF
        'End If
    Else
        GetRecord = RT_EOF
        'MDIMainForm.oWorkMode.SetModeNone
        'Cfflag = False
        'MsgBox "重放完毕!"
    End If
End Function

Public Function GetBuffRecord() As CRecord
    Dim oRecord As New CRecord
    oRecord.dTime = m_uRecord.dTime
    oRecord.nID = m_uRecord.nID
    oRecord.fLongitude = m_uRecord.fLongitude
    oRecord.fLatitude = m_uRecord.fLatitude
    oRecord.bAlert = m_uRecord.bAlert
    oRecord.fSpeed = m_uRecord.fSpeed
    oRecord.fDirection = m_uRecord.fDirection
    Set GetBuffRecord = oRecord
    Set oRecord = Nothing
End Function

Public Sub AddRecord(ByVal oRecord As CRecord)
    On Error GoTo errhandle
    Dim i As Integer
    Dim strCommID As String
    
    GotoEnd
    With oRecord
        m_uRecord.dTime = .dTime
        m_uRecord.nID = .nID
        m_uRecord.fLongitude = .fLongitude
        m_uRecord.fLatitude = .fLatitude
        m_uRecord.bAlert = .bAlert
        m_uRecord.fSpeed = .fSpeed
        m_uRecord.fDirection = .fDirection
    End With
    Put #m_lFileNum, , m_uRecord
    m_lMaxRecord = m_lMaxRecord + 1
    Exit Sub
errhandle:
End Sub

Public Function GotoFirst() As Long
    Seek #m_lFileNum, Wzq
    GotoFirst = RT_SUCCESS
End Function
Public Function GotoLast() As Long
    Seek #m_lFileNum, Wzh
    GotoLast = RT_SUCCESS
End Function
Public Function GotoEnd() As Long
    Seek #m_lFileNum, m_lMaxRecord + 1
    GotoEnd = RT_SUCCESS
End Function
Public Function GotoNext() As Long
    Dim lCurrentRecord As Long
    lCurrentRecord = Seek(m_lFileNum)
    If lCurrentRecord < Wzh Then
        Seek #m_lFileNum, lCurrentRecord + 1
        GotoNext = RT_SUCCESS
    Else
        GotoNext = RT_LOF
    End If
End Function
Public Function GotoPrevious() As Long
    Dim lCurrentRecord As Long
    lCurrentRecord = Seek(m_lFileNum)
    If lCurrentRecord > Wzq Then
        Seek #m_lFileNum, lCurrentRecord - 1
        lCurrentRecord = Seek(m_lFileNum)
        GotoPrevious = RT_SUCCESS
    Else
        GotoPrevious = RT_FOF
    End If
End Function
Public Function GoToRecord(lRecord) As Boolean
    If lRecord <= m_lMaxRecord And lRecord >= 1 Then
        Seek #m_lFileNum, lRecord
        GoToRecord = True
    Else
        GoToRecord = False
    End If
End Function

Public Function GetMaxRecord() As Long
    GetMaxRecord = m_lMaxRecord
End Function

Public Function GetCurrentRecord() As Long
    GetCurrentRecord = Seek(m_lFileNum)
End Function

Private Sub Class_Terminate()
    CloseFile
End Sub