modgarmin.bas

用VB开发的巡检系统基于MAPINFo用VB开发的巡检系统基于MAPINFo很好的

Attribute VB_Name = "modGarmin"
Option Explicit
Public bIsCloseTable_TempTrack As Boolean '是否关闭临时表的标志

'加载GPS设备号
Public Sub Load_GpsID(ByVal rs As ADODB.Recordset, ByVal pCombo As ComboBox)

    Dim strSql As String
    strSql = "select GpsID from tbl_Gps order by GpsID asc"
    
    Set rs = New ADODB.Recordset
    
    rs.Open strSql, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
    Do Until rs.EOF
        pCombo.AddItem rs("GpsID")
        rs.MoveNext
    Loop
    
    If pCombo.ListCount > 0 Then pCombo.Text = pCombo.List(0)
    rs.Close
End Sub

'创建显示轨迹时使用的临时表
Sub CreateTable_TempTrack()
    Dim col(3) As String, coltype(3) As String
    col(1) = "ID"
    col(2) = "RecTime"
    col(3) = "ObjType"
    coltype(1) = "Integer"
    coltype(2) = "Char(30)"
    coltype(3) = "Char(10)"
    CreateTable App.Path + "\TempMap\", "tmpTrack.Tab", col, coltype, 3 '？？？？创建方法？？？？？？？不明白
    
End Sub


'//返回文件的目录路径
Function ReturnDirPath(ByVal sFilePath As String) As String
    Dim leng As Integer
    Dim I As Integer, j As Integer, s As String
    Dim sResult As String
    leng = Len(sFilePath)
    For I = leng To 1 Step -1
        s = Mid$(sFilePath, I, 1)
        If s = "\" Then
            j = j + 1
            sResult = Mid$(sFilePath, 1, leng - j)
            Exit For
        Else
            j = j + 1
        End If
    Next
    ReturnDirPath = sResult
End Function

'解析经纬度坐标（度）
Function GetLatOrLong(ByVal sDest As String, ByVal iTag As Byte) As Double
    Dim n As Integer, lg As Integer, pos As Integer
    Dim sResult As String, dLat As Double, dLong As Double
    lg = Len(sDest)
    If iTag = 0 Then
        pos = InStr(1, sDest, "E")
        sResult = Mid$(sDest, 2, lg - pos)
        dLat = Val(Mid$(sResult, 1, 2)) + Val(Mid$(sResult, 3)) / 60
        GetLatOrLong = dLat
    ElseIf iTag = 1 Then
        pos = InStr(1, sDest, "E")
        sResult = Mid$(sDest, pos + 1)
        dLong = Val(Mid$(sResult, 1, 3)) + Val(Mid$(sResult, 4)) / 60
        GetLatOrLong = dLong
    End If
End Function


'//deal with garmin data file (wcs)处理garmin数据格式文件--Trackpoint
'//根据garmin的数据进行处理，然后在地图上实时移动目标
'//数据：hddd°mm.mmm'
'//参数：Garmin数据文件
Function DealWith_GarminData_Trackpoint(ByVal pGpsID As String, ByVal tmpFile As String, ByVal pListView As MSComctlLib.ListView) As Double
    Dim strline As String, strHeadID As String, strChr() As String
    Dim lenStrLine As Integer, I As Integer, n As Integer, chrOne As String, cou As Integer
    Dim dLatitude As Double, dLongitude As Double '纬度、经度
    Dim sRecTime As String, lngTpTag As Double, mStar As Integer
    Dim tp_num As Long '轨迹点个数
    Dim rs As New ADODB.Recordset, strSql As String, strInsert As String
    Dim tmpTrackFile As String '临时文件（待轨迹跟踪处理）
    
    Dim lstItem As MSComctlLib.ListItem
        
      ''######################刘登杰
    If tmpFile = "" Then '防止指定文件为空而无法打开
    MsgBox "请指定数据文件！", vbInformation + vbOKOnly, "提示"
    DealWith_GarminData_Trackpoint = -9999 '返回错误处理数
    Exit Function
    End If
    
    On Error Resume Next
    Kill (App.Path + "\Track.tmp")
    
    ''######################刘登杰
    On Error GoTo err_lab
    
    tmpTrackFile = App.Path + "\Track.tmp"
    'If Dir(tmpTrackFile, vbDirectory) = "" Then
    '    MkDir tmpTrackFile
    'End If
    pListView.ListItems.Clear
    
    Open tmpFile For Input As #1
    Open tmpTrackFile For Output As #2
    Print #2, pGpsID
    Do Until EOF(1)
        Line Input #1, strline
        'Debug.Print strline
        strHeadID = Mid$(strline, 1, Len("Trackpoint"))
        If UCase$(strHeadID) = UCase$("Trackpoint") Then
             lenStrLine = Len(strline)
             For I = 1 To lenStrLine
                chrOne = Mid$(strline, I, 1)
                If Asc(chrOne) = vbKeyTab Then
                    If n > 0 Then
                        cou = cou + 1
                        ReDim Preserve strChr(cou)
                        strChr(cou - 1) = Trim(Mid$(strline, I - n, n))
                        'Debug.Print strChr(cou - 1)
                        n = 0
                    End If
                Else
                    n = n + 1
                End If
             Next
             cou = 0: n = 0
             '//Waypoint
             If UCase$(strChr(0)) = UCase$("Trackpoint") Then
                tp_num = tp_num + 1
                dLatitude = GetLatOrLong(strChr(1), 0) 'latitude
                dLongitude = GetLatOrLong(strChr(1), 1) 'longitude
                sRecTime = CDate(strChr(2))
                lngTpTag = Format(sRecTime, "YYYYMMDDHHMMSS")
                
                mStar = 4 '//星数大于3
                'Debug.Print strPointID, dLatitude, dLongitude
                
                '写入信息库(判断是否已经处理过当前的数据)
                Set rs = Nothing
                strSql = "select * from tbl_GPS_RecData where GpsID='" & pGpsID & "' and tpTag=" & lngTpTag
                rs.Open strSql, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
                If rs.RecordCount > 0 Then
                    rs.Delete adAffectCurrent
                    strInsert = "Insert into tbl_GPS_RecData(GpsID,Latitude,Longitude,RecTime,Star,TpTag) values('" _
                            & pGpsID & "'," & dLatitude & "," & dLongitude & ",'" & sRecTime & "'," & mStar & "," & lngTpTag & ")"
                    gblCn.Execute strInsert
                Else
                    strInsert = "Insert into tbl_GPS_RecData(GpsID,Latitude,Longitude,RecTime,Star,TpTag) values('" _
                            & pGpsID & "'," & dLatitude & "," & dLongitude & ",'" & sRecTime & "'," & mStar & "," & lngTpTag & ")"
                    gblCn.Execute strInsert
                End If
                rs.Close
                
                '写入临时文件
                'Print #2, tp_num & "," & dLatitude & "," & dLongitude & "," & sRecTime
                Print #2, tp_num, dLatitude, dLongitude, sRecTime
                 
                '写入listview
                With pListView
                    Set lstItem = .ListItems.Add(, , tp_num)
                    lstItem.SubItems(1) = dLongitude
                    lstItem.SubItems(2) = dLatitude
                    lstItem.SubItems(3) = sRecTime
                End With
             End If
        End If
    Loop
    Close #1
    Close #2
    
    
    ''#################刘登杰
    tmpFile = "" ' 释放空间，备其他程序正确调用
     ''#################刘登杰
     
     
    DealWith_GarminData_Trackpoint = tp_num
    Exit Function
err_lab:
    MsgBox Err.Description, vbInformation, "提示"
    
  '###刘登杰
    '如果文件打开，关闭文件
       
    On Error Resume Next
    Close #1
    Close #2
      '如果文件打开，关闭文件
      
'###刘登杰
    DealWith_GarminData_Trackpoint = -9999
End Function