⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form1.vb

📁 从指定GPS端口获取GPS数据按设定发送到指定手机上!
💻 VB
📖 第 1 页 / 共 2 页
字号:
        Me.Controls.Add(Me.Label18)
        Me.Controls.Add(Me.Label17)
        Me.Controls.Add(Me.Label16)
        Me.Controls.Add(Me.Label15)
        Me.Controls.Add(Me.Label14)
        Me.Controls.Add(Me.Label13)
        Me.Controls.Add(Me.Label10)
        Me.Controls.Add(Me.Label9)
        Me.Controls.Add(Me.Label8)
        Me.Controls.Add(Me.Label7)
        Me.Controls.Add(Me.Label6)
        Me.Controls.Add(Me.Label4)
        Me.Controls.Add(Me.Label3)
        Me.Controls.Add(Me.Label2)
        Me.Controls.Add(Me.Label1)
        Me.Menu = Me.MainMenu1
        Me.Text = "GPS监控器"

    End Sub

#End Region
    Public Class dcb
        Friend DCBlength As UInt32
        Friend BaudRate As UInt32
        Friend fBinary As UInt32
        Friend fParity As UInt32
        Friend fOutxCtsFlow As UInt32
        Friend fOutxDsrFlow As UInt32
        Friend fDtrControl As UInt32
        Friend fDsrSensitivity As UInt32
        Friend fTXContinueOnXoff As UInt32
        Friend fOutX As UInt32
        Friend fInX As UInt32
        Friend fErrorChar As UInt32
        Friend fNull As UInt32
        Friend fRtsControl As UInt32
        Friend fAbortOnError As UInt32
        Friend fDummy2 As UInt32
        Friend wReserved As UInt32
        Friend XonLim As UInt32
        Friend XoffLim As UInt32
        Friend ByteSize As Byte
        Friend Parity As Byte
        Friend StopBits As Byte
        Friend XonChar As Char
        Friend XoffChar As Char
        Friend ErrorChar As Char
        Friend EofChar As Char
        Friend EvtChar As Char
        Friend wReserved1 As UInt16
    End Class

    <DllImport("coredll.dll")> _
    Private Shared Function CreateFile _
    (ByVal lpFileName As String, _
     ByVal dwDesiredAccess As Integer, _
     ByVal dwShareMode As Integer, _
     ByVal lpSecurityAttributes As Integer, _
     ByVal dwCreationDisposition As Integer, _
     ByVal dwFlagAndAttributes As Integer, _
     ByVal hTemplateFile As Integer) As Integer
    End Function

    <DllImport("coredll.dll")> _
    Private Shared Function GetCommState _
    (ByVal hFile As Integer, _
     ByVal mdcb As dcb) As Integer
    End Function

    <DllImport("coredll.dll")> _
    Private Shared Function SetCommState _
    (ByVal hFile As Integer, _
     ByVal mdcb As dcb) As Integer
    End Function

    <DllImport("coredll.dll")> _
    Private Shared Function ReadFile _
    (ByVal hFile As Integer, _
     ByVal Buffer() As Byte, _
     ByVal nNumberOfBytesToRead As Integer, _
     ByRef lpNumberOfBytesRead As Integer, _
     ByRef lpOverlapped As Integer) As Integer
    End Function

    <DllImport("coredll.dll")> _
    Private Shared Function CloseHandle _
    (ByVal hObject As Integer) As Integer
    End Function

    Dim inoutfileHandler As Long
    Dim numReadWrite As Integer
    Dim t1 As System.Threading.Thread
    Dim stopThread As Boolean = False
    Dim gpsdata() As String
    Dim i, ii, iii, iiii As Integer
    Dim pdcb As dcb

    Public Sub openPort()
        Dim ioPort As Short = 6
        inoutfileHandler = CreateFile _
        ("COM" & ioPort & ":", _
         &HC0000000, 0, 0, 3, 0, 0)
        pdcb = New dcb
        '设置波特率
        GetCommState(inoutfileHandler, pdcb)
        pdcb.BaudRate.Parse("9600")
        SetCommState(inoutfileHandler, pdcb)

        stopThread = False
        t1 = New Threading.Thread _
        (AddressOf receiveLoop)
        t1.Start()
    End Sub
    Public Sub closePort()
        stopThread = True
        CloseHandle(inoutfileHandler)
    End Sub

    Public Sub receiveLoop()
        Dim inbuff(100) As Byte
        Dim retCode As Integer = ReadFile _
        (inoutfileHandler, _
         inbuff, _
         inbuff.Length, _
         numReadWrite, _
         0)
        Application.DoEvents()
        While True
            If retCode = 0 Or stopThread Then
                Exit While
            Else
                Dim updateDelegate As New _
                 myDelegate _
                 (AddressOf displayReceivedMessage)

                updateDelegate.Invoke _
                (byteArrayToString(inbuff))
                ReDim inbuff(100)
                retCode = ReadFile(inoutfileHandler, inbuff, inbuff.Length, numReadWrite, 0)
                Application.DoEvents()
            End If
        End While
    End Sub

    Public Delegate Sub myDelegate(ByVal str As String)

    Public Function stringToByteArray _
    (ByVal str As String) As Byte()
        Dim s As Char()
        s = str.ToCharArray
        Dim b(s.Length - 1) As Byte
        Dim i As Integer
        For i = 0 To s.Length - 1
            b(i) = Convert.ToByte(s(i))
        Next
        Return b
    End Function

    Function byteArrayToString _
    (ByVal b() As Byte) As String
        Dim str As String
        Dim enc As System.Text.ASCIIEncoding
        enc = New System.Text.ASCIIEncoding
        str = enc.GetString(b, 0, b.Length())
        Return str
    End Function

    Public Sub displayReceivedMessage(ByVal str As String)
        '输出数据
        If str.Length > 0 Then
            If str.IndexOf("$GPRMC") > 0 Then
                str = Mid(str, str.IndexOf("$GPRMC") + 1, str.Length - str.IndexOf("$GPRMC"))
                TextBox1.Text = str
                gpsdata = Split(str, ",", -1)
                Label5.Text = "数据:" & UBound(gpsdata)
                If UBound(gpsdata) > 9 Then
                    Label13.Text = Mid(gpsdata(1), 1, 2) + 8 & ":" & Mid(gpsdata(1), 3, 2) & ":" & Mid(gpsdata(1), 5, 2)
                    If gpsdata(2) = "A" Then
                        Label14.Text = "正常"
                    Else
                        Label14.Text = "出错"
                    End If
                    Label15.Text = gpsdata(3)
                    Label16.Text = gpsdata(4)
                    Label17.Text = gpsdata(5)
                    Label18.Text = gpsdata(6)
                    Label19.Text = gpsdata(7)
                    Label20.Text = gpsdata(8)
                    Label21.Text = "20" & Mid(gpsdata(9), 5, 2) & "年" & Mid(gpsdata(9), 3, 2) & "月" & Mid(gpsdata(9), 1, 2) & "日"
                End If
            End If
        End If
    End Sub

    Private Sub MenuItem1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem1.Click
        openPort()
        MenuItem1.Enabled = False
        MenuItem2.Enabled = True
    End Sub

    Private Sub MenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem2.Click
        closePort()
        MenuItem1.Enabled = True
        MenuItem2.Enabled = False
    End Sub

    Private Sub MenuItem3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItem3.Click
        Me.Close()
    End Sub

    Private Sub 操作_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles 操作.Click

    End Sub

    Private Sub TextReceive_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs)

    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        openPort()
        MenuItem1.Enabled = False
        MenuItem2.Enabled = True
        i = 0
        ii = 0
        iii = 0
        iiii = 0
    End Sub

    Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged

    End Sub

    Private Sub Label5_ParentChanged(ByVal sender As System.Object, ByVal e As System.EventArgs)

    End Sub

    Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick
        i = i + 1
        If (Label14.Text = "正常") Then
            If Val(Label19.Text) * 3.6 > 10 Then
                SMS.SendMessage("1388888888", "经度:" & Label17.Text & " 纬度:" & Label15.Text & " 速度:" & Label19.Text)
                ii = ii + 1
                Label23.Text = ii
            Else
                iiii = iiii + 1
                If iii > 6 Then
                    SMS.SendMessage("1388888888", "经度:" & Label17.Text & " 纬度:" & Label15.Text & " 速度:" & Label19.Text)
                    iii = 0
                End If
            End If
        Else
            iii = iii + 1
            If iii > 60 Then
                SMS.SendMessage("1388888888", "GPS出错,最后一次经度:" & Label17.Text & " 纬度:" & Label15.Text & " 速度:" & Label19.Text)
                iii = 0
            End If
        End If
        Label22.Text = i
    End Sub

    Private Sub Label19_ParentChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Label19.ParentChanged

    End Sub

    Private Sub Label21_ParentChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Label21.ParentChanged

    End Sub
End Class

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -