form1.frm

用于GPS数据采集

End If

MSComm2.CommPort = Combo3.ListIndex + 1
MSComm2.Settings = Trim(Combo4.Text) & ",N,8,1"

  With MSComm2
     
     .InputMode = comInputModeBinary
     '设置接收数据模式为二进制形式
     .InputLen = 1
     '设置Input 一次从接收缓冲读取字节数为1
     .InBufferCount = 0  '清除接收缓冲区
    .RThreshold = 1
    '设置接收一个字节产生OnComm事件
    On Error GoTo err:
     If .PortOpen = False Then
    '判断通信口是否打开
        .PortOpen = True       '打开通信口
     End If
  End With
cmdOpen1.Enabled = False
cmdClose1.Enabled = True
Exit Sub
err:
MsgBox err.Description

End Sub

Private Sub cmdOutput_Click()
On Error GoTo err:
Dim i, j As Integer
Dim v(19) As Byte
v(0) = &HFE
v(1) = &H2

j = Len(Trim(txtInput.Text))
If j > 0 Then
For i = 1 To j
v(i + 1) = Asc(Mid(Trim(txtInput.Text), i, 1))
Next
 v(j + 2) = &H22
 v(j + 3) = &HA
 
 If j < 15 Then
  For i = j + 4 To 18
  v(i) = &H0
  Next
End If
 v(19) = &HFE
If MSComm2.PortOpen = False Then
MSComm2.PortOpen = True
End If
  MSComm2.Output = CVar(v)
End If
Exit Sub
err:
  MsgBox "修改APN失败！", vbOKOnly + vbExclamation, "写入站点"

End Sub

Private Sub Command1_Click()
On Error GoTo err:
If Len(txtStation.Text) > 0 Then
Dim i As Integer
Dim upcount As Integer, downcount As Integer
For i = 4 To 255
  UpLng(i) = 0
  UpLat(i) = 0
  DownLng(i) = 0
  DownLat(i) = 0
Next
  UpLng(0) = &HFE
  UpLat(0) = &HFE
  DownLng(0) = &HFE
  DownLat(0) = &HFE
  
  UpLng(1) = &H4
  UpLat(1) = &H4
  DownLng(1) = &H4
  DownLat(1) = &H4
  
  UpLng(2) = &H1
  UpLat(2) = &H2
  DownLng(2) = &H3
  DownLat(2) = &H4
  
  UpLng(256) = &HFE
  UpLat(256) = &HFE
  DownLng(256) = &HFE
  DownLat(256) = &HFE

Dim senstationinfo As String
senstationinfo = txtStation.Text
Dim strtemp As String, strLng As Long, strLat As Long
Dim k1, k2 As Integer
Dim s1, s2, s3 As Integer
k1 = 4
k2 = 2
Dim j, k As Integer
k = 1
j = InStr(1, senstationinfo, "#")
Do While k <> 0
   k = InStr(j + 3, senstationinfo, "#")
   If k > 0 Then
      strtemp = Mid(senstationinfo, j + 1, k - j - 1)
      s1 = InStr(1, strtemp, "|")
      s2 = InStr(s1 + 1, strtemp, "|")
      s3 = InStr(s2 + 1, strtemp, "|")
      strLng = CLng(Mid(strtemp, s1 + 1, s2 - s1 - 1) * 10000)
      strLat = CLng(Mid(strtemp, s2 + 1, s3 - s2 - 1) * 10000)
      upcount = upcount + 1
      For i = 1 To 4
         UpLat(k1) = strLat \ (256 ^ (4 - i))
         k2 = UpLat(k1)
         strLat = strLat - (256 ^ (4 - i)) * k2
         UpLng(k1) = strLng \ (256 ^ (4 - i))
         k2 = UpLng(k1)
         strLng = strLng - (256 ^ (4 - i)) * k2

         k1 = k1 + 1
      Next
   End If
   j = k + 1
Loop


k1 = 4
k2 = 2
k = 1
j = InStr(1, senstationinfo, "@")
Do While k <> 0
   k = InStr(j + 3, senstationinfo, "@")
   If k > 0 Then
      strtemp = Mid(senstationinfo, j + 1, k - j - 1)
      s1 = InStr(1, strtemp, "|")
      s2 = InStr(s1 + 1, strtemp, "|")
      s3 = InStr(s2 + 1, strtemp, "|")
      strLng = CLng(Mid(strtemp, s1 + 1, s2 - s1 - 1) * 10000)
      strLat = CLng(Mid(strtemp, s2 + 1, s3 - s2 - 1) * 10000)
      downcount = downcount + 1
      For i = 1 To 4
         DownLng(k1) = strLng \ (256 ^ (4 - i))
         k2 = DownLng(k1)
         strLng = strLng - (256 ^ (4 - i)) * k2
         DownLat(k1) = strLat \ (256 ^ (4 - i))
         k2 = DownLat(k1)
         strLat = strLat - (256 ^ (4 - i)) * k2
         k1 = k1 + 1
      Next
   End If
   j = k + 1
Loop

If upcount > downcount Then
  UpLng(3) = upcount
  UpLat(3) = upcount
  DownLng(3) = upcount
  DownLat(3) = upcount
Else
  UpLng(3) = downcount
  UpLat(3) = downcount
  DownLng(3) = downcount
  DownLat(3) = downcount
End If
If MSComm2.PortOpen = False Then
MSComm2.CommPort = Combo3.ListIndex + 1
MSComm2.Settings = Trim(Combo4.Text) & ",N,8,1"
MSComm2.PortOpen = True
End If
Form2.Label1.Caption = "正在写入下行站点的经度数据...."
Form2.Label1.ForeColor = &HFF0000
Form2.Show , Me
DoEvents
MSComm2.Output = CVar(UpLng)
DoEvents
Command1.Enabled = False
End If
Exit Sub
err:
MsgBox "导入的文件的数据格式不正确！"
End Sub

Private Sub Command2_Click()
On Error GoTo err:
cdSend.Filter = "Text Files(*.txt)|*.txt"
' 指定缺省的过滤器
cdSend.FilterIndex = 2
' 显示“打开”对话框
cdSend.InitDir = App.Path
cdSend.Flags = cdlOFNHideReadOnly
cdSend.ShowOpen
Dim fs, a
Dim value As String
filename = cdSend.filename
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.OpenTextFile(filename, 1, False)
txtStation.Text = ""
Do While a.AtEndOfStream <> True
  value = a.Readline
  txtStation.Text = txtStation.Text & value & Chr(13) & Chr(10)
Loop
a.Close
Exit Sub
err:
End Sub

Private Sub Form_Load()
Combo1.AddItem "COM1"
Combo1.AddItem "COM2"
Combo1.AddItem "COM3"
Combo1.AddItem "COM4"
Combo1.AddItem "COM5"
Combo1.AddItem "COM6"
Combo1.AddItem "COM7"
Combo1.AddItem "COM8"
Combo1.ListIndex = 0

Combo2.AddItem "110"
Combo2.AddItem "300"
Combo2.AddItem "600"
Combo2.AddItem "1200"
Combo2.AddItem "2400"
Combo2.AddItem "4800"
Combo2.AddItem "9600"
Combo2.AddItem "14400"
Combo2.AddItem "19200"
Combo2.AddItem "38400"
Combo2.AddItem "56000"
Combo2.AddItem "57600"
Combo2.AddItem "115200"
Combo2.AddItem "128000"
Combo2.AddItem "256000"
Combo2.ListIndex = 5
If MSComm1.PortOpen = True Then
 MSComm1.PortOpen = False
End If

Combo3.AddItem "COM1"
Combo3.AddItem "COM2"
Combo3.AddItem "COM3"
Combo3.AddItem "COM4"
Combo3.AddItem "COM5"
Combo3.AddItem "COM6"
Combo3.AddItem "COM7"
Combo3.AddItem "COM8"
Combo3.ListIndex = 0

Combo4.AddItem "110"
Combo4.AddItem "300"
Combo4.AddItem "600"
Combo4.AddItem "1200"
Combo4.AddItem "2400"
Combo4.AddItem "4800"
Combo4.AddItem "9600"
Combo4.AddItem "14400"
Combo4.AddItem "19200"
Combo4.AddItem "38400"
Combo4.AddItem "56000"
Combo4.AddItem "57600"
Combo4.AddItem "115200"
Combo4.AddItem "128000"
Combo4.AddItem "256000"
Combo4.ListIndex = 6
If MSComm2.PortOpen = True Then
 MSComm2.PortOpen = False
End If
    Set HSplitterBar1.UpCtrl = txtStation
    Set HSplitterBar1.DownCtrl = List1
filename = App.Path & "\sendStationInfo.txt"
  Dim str1, str2, str3, str4 As String
  str1 = Format(Now, "yyyy-MM-dd hh:mm")
  str2 = Mid(str1, 3, 2)
  str3 = Mid(str1, 6, 2)
  str4 = Mid(str1, 9, 2)
  
  
  Dim str5, str6 As String
  str5 = "0" & CStr(Hex(CInt(str3)))
  str6 = CStr(Hex(CInt(str4)))
  If Len(str6) = 1 Then
  str6 = "0" & str6
  End If
  txtNo.Text = Trim(str2 & str5 & str6 & "0001")

End Sub

Private Sub Form_Resize()
SSTab1.Height = Form1.Height
SSTab1.Width = Form1.Width
txtStationInfo.Height = Abs(SSTab1.Height - 2400)
txtStationInfo.Width = SSTab1.Width - 100
txtStation.Width = SSTab1.Width - 100
List1.Height = Abs(SSTab1.Height - 1200 - txtStation.Height)
HSplitterBar1.Width = SSTab1.Width - 100
List1.Width = SSTab1.Width - 100
List2.Width = SSTab1.Width - 100
List2.Height = Abs(SSTab1.Height - Frame1.Height - 890)
End Sub

Private Sub HSplitterBar1_EndMoving()
List1.Height = Abs(SSTab1.Height - 1200 - txtStation.Height)
End Sub

Private Sub MSComm1_OnComm()
 Dim i As Integer, count As Integer
 Dim av As Variant, ab() As Byte, s() As String
 On Error Resume Next
 With MSComm1
  If .CommEvent = comEvReceive Then
    '判断MSComm1通信事件
               .RThreshold = 0
           '收到Rthreshold个字节产生的接收事件
           '关闭OnComm事件接收
 
          count = .InBufferCount
      If count >= 1 Then
          '循环等待MSComm1接收缓冲区>=1个字节
      ReDim ab(count) As Byte
      ReDim s(count) As String
       For i = 0 To count - 1
          av = .Input
          ab(i) = av(0)
          s(i) = ChrW(ab(i))
          If s(i) = "$" Then
            strGPS = ""
          End If
          If ab(i) = 13 Then
             If Len(strGPS) > 0 Then
                 Dim j As Integer, gpsHead As String
                 j = InStr(1, strGPS, ",")
                 gpsHead = Mid(strGPS, 1, j - 1)
                 If gpsHead = "$GPRMC" Then
                       Dim k1, k2, k3, k4, k5, k6, k7, k8, k9 As Integer
                       k1 = InStr(j + 1, strGPS, ",")
                       k2 = InStr(k1 + 1, strGPS, ",")
                       k3 = InStr(k2 + 1, strGPS, ",")
                       k4 = InStr(k3 + 1, strGPS, ",")
                       k5 = InStr(k4 + 1, strGPS, ",")
                       k6 = InStr(k5 + 1, strGPS, ",")
                       k7 = InStr(k6 + 1, strGPS, ",")
                       k8 = InStr(k7 + 1, strGPS, ",")
                       k9 = InStr(k8 + 1, strGPS, ",")
                       txtLng.Text = Mid(strGPS, k4 + 1, k5 - k4 - 1)
                       txtLat.Text = Mid(strGPS, k2 + 1, k3 - k2 - 1)
                       txtSpeed.Text = Mid(strGPS, k6 + 1, k7 - k6 - 1)
                       txtStatus.Text = Mid(strGPS, k1 + 1, k2 - k1 - 1)
                       txtTime.Text = translateTime(Mid(strGPS, j + 1, k1 - j - 1), Mid(strGPS, k8 + 1, k9 - k8 - 1))
                       
                 End If
             End If
           End If
          strGPS = strGPS & s(i)
       Next
     End If
   End If
 End With
  MSComm1.RThreshold = 1

End Sub

Private Sub MSComm2_OnComm()
  Dim i As Integer, count As Integer
 On Error Resume Next
 With MSComm2
  If .CommEvent = comEvReceive Then
    '判断MSComm1通信事件
               .RThreshold = 0
           '收到Rthreshold个字节产生的接收事件
           '关闭OnComm事件接收
          count = .InBufferCount
           If count >= 1 Then
          '循环等待MSComm1接收缓冲区>=1个字节
      ReDim ab(count) As Byte
      ReDim s(count) As String
       For i = 0 To count - 1
          av = .Input
          ab(i) = av(0)
          s(i) = Hex(ab(i))
     If Len(Trim(s(i))) <= 1 Then
        s(i) = "0" & s(i)
     End If
       Dim strdata As String
        If ab(i) > 127 Or (ab(i) < 30 And ab(i) <> 14) Then
             
           strdata = " "
       Else
          strdata = ChrW(ab(i))
       End If
        AscData = AscData & strdata
        AscData1 = AscData1 & s(i) & Space(2)
      List1.List(lineId2) = AscData1 & Space(66 - Len(AscData1)) & AscData
        
        If Len(AscData1) = 64 Then
            List1.AddItem ""
            lineId2 = lineId2 + 1
            AscData = ""
            AscData1 = ""
        End If
        
      List1.Selected(List1.ListCount - 1) = True
      If ab(i) = &HD Then
             List2.AddItem ""
             LineId = LineId + 1
      Else
             List2.List(LineId) = List2.List(LineId) & strdata
      End If
      If Len(List2.List(LineId)) = 64 Then
             List2.AddItem ""
             LineId = LineId + 1
      End If
       List2.Selected(List2.ListCount - 1) = True
    Next
   cmdClear.Enabled = True
   End If
  End If
    End With
  If Len(List1.List(lineId2)) = 0 Then
      AscData = ""
      AscData1 = ""
  End If
If count > 3 Then
    For i = 0 To count - 4
        If ab(i) = &HFE And ab(i + 3) = &HFE And ab(i + 1) = &H4 Then
         Select Case ab(i + 2)
             Case &H1
                Form2.Label1.Caption = "正在写入下行站点的纬度数据...."
                MSComm2.Output = CVar(UpLat)
                DoEvents
             Case &H2
                Form2.Label1.ForeColor = &HFF
                Form2.Label1.Caption = "正在写入上行站点的经度数据...."
               MSComm2.Output = CVar(DownLng)
                DoEvents
             Case &H3
                Form2.Label1.Caption = "正在写入上行站点的纬度数据...."
                MSComm2.Output = CVar(DownLat)
                DoEvents
             Case &H4
                Unload Form2
                Command1.Enabled = True
                MsgBox "写入站点经纬度成功！", vbOKOnly + vbExclamation, "写入站点"
        End Select
        Exit For
       End If
    Next
End If
MSComm2.RThreshold = 1
End Sub
Private Sub txtIP_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii <> 8 Then
    If Len(Trim(txtIP(Index).Text)) = 2 And Index < 3 Then
      txtIP(Index + 1).SetFocus
      Exit Sub
    End If
    
    If Len(Trim(txtIP(Index).Text)) = 2 And Index = 3 Then
       cmdIP.SetFocus
       Exit Sub
    End If
End If
End Sub
Private Sub Timer1_Timer()
cmdNo.Enabled = True
Timer1.Enabled = False
End Sub

Private Sub txtNo_GotFocus()
  txtNo.SelStart = Len(txtNo.Text) + 1
End Sub

Private Sub txtNo_KeyPress(KeyAscii As Integer)
If KeyAscii >= 97 And KeyAscii <= 102 Then
     KeyAscii = KeyAscii - 32
  End If
If (KeyAscii < 48 Or (KeyAscii > 57 And KeyAscii < 65) Or (KeyAscii > 70 And KeyAscii < 97) Or KeyAscii > 102) And KeyAscii <> 8 Then
KeyAscii = 0
End If
End Sub