网上找来的代码自己修改之后放到这里的。
参考地址：
http://www.pcppc.cn/kaifa/VBjiaocheng/kaifa_18010.html
http://www.itqoo.com/programme/ASPNET/200609/1489.html
http://topic.csdn.net/t/20060812/21/4945572.html
http://bbs.pdafans.com/viewthread.php?tid=154187
Imports System.Runtime.InteropServices
Public Class Form1
Private StrInfo As String = ""
Private StrX As String = ""
Private StrY As String = ""
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
_
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
_
Private Shared Function GetCommState _
(ByVal hFile As Integer, _
ByVal mdcb As dcb) As Integer
End Function
_
Private Shared Function SetCommState _
(ByVal hFile As Integer, _
ByVal mdcb As dcb) As Integer
End Function
_
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
_
Private Shared Function WriteFile _
(ByVal hFile As Integer, _
ByVal Buffer() As Byte, _
ByVal nNumberOfBytesToWrite As Integer, _
ByRef lpNumberOfBytesWritten As Integer, _
ByVal lpOverlapped As Integer) As Boolean
End Function
_
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 pdcb As New dcb
Public Sub openPort()
Dim ioPort As Short = 4
inoutfileHandler = CreateFile("COM" & ioPort & ":", &HC0000000, 0, 0, 3, 0, 0)
'设置波特率
GetCommState(inoutfileHandler, pdcb)
pdcb.BaudRate.Parse("4800")
SetCommState(inoutfileHandler, pdcb)
stopThread = False
t1 = New Threading.Thread(AddressOf receiveLoop)
t1.Start()
End Sub
Public Sub receiveLoop()
Dim inbuff(300) 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(300)
retCode = ReadFile(inoutfileHandler, inbuff, inbuff.Length, numReadWrite, 0)
Application.DoEvents()
End If
End While
End Sub
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 Delegate Sub myDelegate(ByVal str As String)
Public Sub displayReceivedMessage(ByVal str As String)
If str.Length > 0 Then
'MessageBox.Show(str)
'MessageBox.Show(GetGPS(str, "X") & " " & GetGPS(str, "Y"))
StrInfo = StrInfo + str
StrX = GetGPS(str, "X")
StrY = GetGPS(str, "Y")
If StrX <> "" And StrX <> "-1" And StrX <> "V" Then
MessageBox.Show("成功获得数据 经度" & StrX & " 纬度" & StrY)
stopThread = True
CloseHandle(inoutfileHandler)
End If
End If
End Sub
Private Sub MnuOpenPort_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MnuOpenPort.Click
Call openPort()
End Sub
Private Sub MnuShow_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MnuShow.Click
TxtInfo.Text = StrInfo
TxtGPS.Text = StrX & " " & StrY
End Sub
Private Sub MnuClosePort_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MnuClosePort.Click
stopThread = True
CloseHandle(inoutfileHandler)
End Sub
Private Function GetGPS(ByVal sGpsStr As String, ByVal sFindStr As String)
Dim HanderStr As String = "$GPRMC" 'GPS串头
Dim FindHander As Integer = sGpsStr.IndexOf(HanderStr)
If FindHander < 0 Then
Return "-1"
Else
sGpsStr = sGpsStr.Substring(FindHander, sGpsStr.Length - FindHander)
Dim ArryTmp() As String = sGpsStr.Split(",")
Try
If ArryTmp(2) = "V" Then
Return "V" '信号不好
Else
Select Case sFindStr
Case "X" '返回经度
Return DM2DD(ArryTmp(5))
Case "Y" '返回纬度
Return DM2DD(ArryTmp(3))
Case "T"
Return ArryTmp(9) & " " & ArryTmp(1)
Case "V"
Return Convert.ToString(Convert.ToDouble(ArryTmp(7)) * 1.852)
End Select
End If
Catch ex As Exception
Return "V"
End Try
End If
End Function
Public Function DM2DD(ByVal DegreeMinutes As String) As String
'转换NMEA协议的“度分”格式为十进制“度度”格式
Dim sDegree As String
Dim sMinute As String
Dim sReturn As String = ""
If DegreeMinutes.IndexOf(".") = 4 Then
DegreeMinutes = DegreeMinutes.Replace(".", "")
Dim sDegree1 As Double = Convert.ToDouble(DegreeMinutes.Substring(0, 2))
Dim sDegree2 As Double = Convert.ToDouble(DegreeMinutes.Substring(2, DegreeMinutes.Length - 2))
Dim sTmp As String = Convert.ToString(sDegree2 / 60)
sDegree2 = Convert.ToDouble(sTmp.Substring(0, sTmp.Length))
sDegree2 = sDegree2 / 10000
sDegree = Convert.ToString(sDegree1 + sDegree2)
If (sDegree.Length > 11) Then
sDegree = sDegree.Substring(0, 11)
End If
sReturn = sDegree
ElseIf DegreeMinutes.IndexOf(".") = 5 Then
DegreeMinutes = DegreeMinutes.Replace(".", "")
Dim sMinute1 As Double = Convert.ToDouble(DegreeMinutes.Substring(0, 3))
Dim sMinute2 As Double = Convert.ToDouble(DegreeMinutes.Substring(3, DegreeMinutes.Length - 2))
Dim sTmp As String = Convert.ToString(sMinute2 / 60)
sMinute2 = Convert.ToDouble(sTmp.Substring(0, sTmp.Length))
sMinute2 = sMinute2 / 10000
sMinute = Convert.ToString(sMinute1 + sMinute2)
If sMinute.Length > 10 Then
sMinute = sMinute.Substring(0, 10)
sReturn = sMinute
End If
End If
Return sReturn
End Function
End Class
