frmmain.frm

使用串口获取标准GPS卫星时间的VB代码 1 获取GPS时间字串 2 演算UTC和当地时间差 3 纠正系统时间和卫星时间差 注:误差精度在5秒内(和计算机时钟以及GPS信号干扰有关)

VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form frmMain 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Get GPS Time Service"
   ClientHeight    =   2280
   ClientLeft      =   6045
   ClientTop       =   6015
   ClientWidth     =   5505
   DrawMode        =   1  'Blackness
   DrawStyle       =   3  'Dash-Dot
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2280
   ScaleWidth      =   5505
   ShowInTaskbar   =   0   'False
   Begin MSCommLib.MSComm mscGPS 
      Left            =   1680
      Top             =   1680
      _ExtentX        =   1005
      _ExtentY        =   1005
      _Version        =   393216
      DTREnable       =   -1  'True
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "EXIT"
      Height          =   495
      Left            =   120
      TabIndex        =   7
      Top             =   1680
      Width           =   975
   End
   Begin VB.Frame fraMain 
      Height          =   1575
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   5415
      Begin VB.Label lblLocal 
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BorderStyle     =   1  'Fixed Single
         ForeColor       =   &H80000008&
         Height          =   495
         Left            =   1080
         TabIndex        =   6
         Top             =   840
         Width           =   4095
      End
      Begin VB.Label lblGPSinfo 
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         BorderStyle     =   1  'Fixed Single
         ForeColor       =   &H80000008&
         Height          =   495
         Left            =   1080
         TabIndex        =   5
         Top             =   240
         Width           =   4095
      End
      Begin VB.Label Label2 
         Caption         =   "Local Time"
         Height          =   255
         Left            =   120
         TabIndex        =   4
         Top             =   960
         Width           =   975
      End
      Begin VB.Label Label1 
         Caption         =   "GPS Time"
         Height          =   255
         Left            =   120
         TabIndex        =   3
         Top             =   360
         Width           =   735
      End
   End
   Begin VB.CommandButton cmdSetTime 
      Caption         =   "SetTime"
      Height          =   495
      Left            =   4440
      TabIndex        =   1
      Top             =   1680
      Width           =   975
   End
   Begin VB.CommandButton cmdAuto 
      Caption         =   "Auto"
      Height          =   495
      Left            =   3240
      TabIndex        =   0
      Top             =   1680
      Width           =   975
   End
   Begin VB.Timer TimRun 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   1200
      Top             =   1680
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim iCount As Long
Private Sub cmdAuto_Click()
    With Me
        
        If .TimRun.Enabled = False Then
            
            .cmdAuto.Caption = "Pause"
            .TimRun.Enabled = True
                
        
        Else
            
            .cmdAuto.Caption = "Auto"
            .TimRun.Enabled = False
        
        End If
    
    End With
    
End Sub

Private Sub cmdExit_Click()
    
    End

End Sub

Private Sub cmdSetTime_Click()
    
    Dim tdate As Date
    
    Me.cmdSetTime.Enabled = True
    
    Call cmdAuto_Click
    
    cmdAuto.Enabled = False
    
        
    tdate = UTC.UTCtoLocal(UTC.GetGpsTime)
    
    If UTC.SetLTime(tdate) = 1 Then
       
       Me.lblGPSinfo = "服务器与GPS:" & UTC.GetGpsTime & "时间同步成功！"
    
    Else
        
        Me.lblGPSinfo = "GPS时间未获取！"
    
    End If
    
    cmdAuto.Enabled = True
    
    Call cmdAuto_Click
    
    iCount = 0
    
    
End Sub

Private Sub Form_Load()
    
    
    Me.TimRun.Enabled = False
    
    
    With Me
        
        .lblGPSinfo = UTCTime
        .lblLocal = LocalTime
        .mscGPS.Settings = "4800,n,8,1"
        .mscGPS.InputLen = 0
    
    End With
        
    
    iCount = 0
    Me.TimRun.Enabled = True
End Sub


Private Sub TimRun_Timer()
    
    Me.lblLocal = Now
    
    If iCount < 3600 Then
       
        iCount = iCount + 1
    
    Else
        
        Call cmdSetTime_Click
    
    End If
    
    
End Sub