网上找来的代码自己修改之后放到这里的。

参考地址：

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