Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing MainForm.frm (13.46 KB)
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form MainForm
BorderStyle = 1 'Fixed Single
Caption = "Atomic Time Syncronization"
ClientHeight = 4710
ClientLeft = 45
ClientTop = 435
ClientWidth = 6030
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "MainForm.frx":0000
MaxButton = 0 'False
ScaleHeight = 4710
ScaleWidth = 6030
StartUpPosition = 2 'CenterScreen
Begin VB.Timer DelayTimer
Enabled = 0 'False
Interval = 1000
Left = 360
Top = 0
End
Begin VB.CommandButton Command3
Caption = "S&et System Time"
Enabled = 0 'False
Height = 375
Left = 120
TabIndex = 7
ToolTipText = "Change the system time to the atomic time"
Top = 2160
Width = 2055
End
Begin VB.CommandButton Command2
Caption = "Close"
Default = -1 'True
Height = 375
Left = 4560
TabIndex = 11
Top = 4200
Width = 1335
End
Begin VB.Frame Frame2
Caption = "Startup Settings"
Height = 1215
Left = 120
TabIndex = 15
Top = 2760
Width = 5775
Begin VB.TextBox txtDelay
Enabled = 0 'False
Height = 315
Left = 2160
MaxLength = 4
TabIndex = 10
Text = "2"
Top = 720
Width = 615
End
Begin VB.CheckBox chkStartupSync
Caption = "Sy&ncronize system time with the atomic clock on startup"
Height = 255
Left = 240
TabIndex = 8
Top = 360
Width = 5295
End
Begin VB.Label Label6
Caption = "(minutes)"
Height = 255
Left = 2880
TabIndex = 16
Top = 780
Width = 855
End
Begin VB.Label Label5
Caption = "Syncronization &delay:"
Height = 255
Left = 515
TabIndex = 9
Top = 780
Width = 1575
End
End
Begin VB.CommandButton Command1
Caption = "&Retrieve Atomic Time"
Height = 375
Left = 120
TabIndex = 6
ToolTipText = "Retreive the atomic time from the selected server"
Top = 1680
Width = 2055
End
Begin MSWinsockLib.Winsock WSTime
Left = 0
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 393216
RemotePort = 13
End
Begin VB.Frame Frame1
Caption = "Atomic Time Settings"
Height = 1335
Left = 120
TabIndex = 12
Top = 120
Width = 5775
Begin VB.TextBox txtPort
BackColor = &H8000000F&
Height = 315
Left = 4560
Locked = -1 'True
MaxLength = 5
TabIndex = 5
Text = "13"
Top = 720
Width = 975
End
Begin VB.ComboBox cboGMT
Height = 315
ItemData = "MainForm.frx":0442
Left = 1200
List = "MainForm.frx":0444
Style = 2 'Dropdown List
TabIndex = 3
Top = 720
Width = 2175
End
Begin VB.ComboBox cboServer
Height = 315
Left = 1200
Style = 2 'Dropdown List
TabIndex = 1
Top = 360
Width = 4335
End
Begin VB.Label Label3
Caption = "&Port:"
Height = 255
Left = 3960
TabIndex = 4
Top = 765
Width = 495
End
Begin VB.Label Label2
Caption = "&GMT Decal:"
Height = 255
Left = 240
TabIndex = 2
Top = 765
Width = 855
End
Begin VB.Label Label1
Caption = "&Server:"
Height = 255
Left = 240
TabIndex = 0
Top = 400
Width = 615
End
End
Begin VB.Image IconImg
Height = 480
Left = 120
Picture = "MainForm.frx":0446
ToolTipText = "AtomicTimeSync is Copyright � 1999 - 2001 Jason's PC Software"
Top = 4180
Width = 480
End
Begin VB.Label lblStatus
AutoSize = -1 'True
Height = 195
Left = 840
TabIndex = 17
Top = 4320
Width = 45
End
Begin VB.Label lblAtomicTime
Alignment = 2 'Center
Caption = "(not retrieved)"
Height = 255
Left = 2280
TabIndex = 14
Top = 2160
Width = 3615
End
Begin VB.Label Label4
Alignment = 2 'Center
Caption = "Atomic Time:"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 2280
TabIndex = 13
Top = 1920
Width = 3615
End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ServerName(11) As String
Dim ServerIp(11) As String
Dim ServerLocation(11) As String
Dim bStartupMode As Boolean
Dim nMin As Long
Private Const RegAppRoot = "Software\AtomicTimeSync\"
Private Function ApplyGMT(BaseATM, GMT As Integer)
Dim sHours As String
Dim iHours As Single
Dim sRest As String
sHours = Mid(BaseATM, 1, 2)
sRest = Mid(BaseATM, 3, 6)
iHours = Val(sHours) + GMT
If iHours < 0 Then
sHours = CStr(24 + iHours)
Else
iHours = iHours Mod 24
sHours = CStr(iHours)
End If
If Len(sHours) <> 2 Then sHours = "0" & sHours
ApplyGMT = sHours & sRest
End Function
Private Sub cboGMT_Click()
WSTime.Close
lblAtomicTime.Caption = "(not retrieved)"
lblStatus.Caption = ""
Command3.Enabled = False
End Sub
Private Sub cboServer_Click()
WSTime.Close
lblAtomicTime.Caption = "(not retrieved)"
lblStatus.Caption = ""
Command3.Enabled = False
End Sub
Private Sub chkStartupSync_Click()
If chkStartupSync.Value = 0 Then
txtDelay.Enabled = False
Else
txtDelay.Enabled = True
End If
End Sub
Private Sub Command1_Click()
On Error Resume Next
lblStatus.Caption = "Status: Connecting to server..."
WSTime.Close
WSTime.RemoteHost = ServerName(cboServer.ListIndex)
WSTime.Connect
If Err.Number <> 0 Then
lblStatus.Caption = "Status: Error Occurred."
If bStartupMode = True Then End
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
Time = lblAtomicTime
Command3.Enabled = False
If bStartupMode = True Then End
End Sub
Private Sub DelayTimer_Timer()
nMin = nMin + 1
If nMin = Val(txtDelay.Text) Then
DelayTimer.Enabled = False
Command1_Click
End If
End Sub
Private Sub Form_Load()
Dim i As Integer
Dim lRegData As Long
Dim bRegErr As Boolean
ServerName(0) = "time-a.nist.gov"
ServerIp(0) = "129.6.15.28"
ServerLocation(0) = "NIST, Gaithersburg, Maryland"
ServerName(1) = "time-b.nist.gov"
ServerIp(1) = "129.6.15.29"
ServerLocation(1) = "NIST, Gaithersburg, Maryland"
ServerName(2) = "time-a.timefreq.bldrdoc.gov"
ServerIp(2) = "132.163.4.101"
ServerLocation(2) = "NIST, Boulder, Colorado"
ServerName(3) = "time-b.timefreq.bldrdoc.gov"
ServerIp(3) = "132.163.4.102"
ServerLocation(3) = "NIST, Boulder, Colorado"
ServerName(4) = "time-c.timefreq.bldrdoc.gov"
ServerIp(4) = "132.163.4.103"
ServerLocation(4) = "NIST, Boulder, Colorado"
ServerName(5) = "utcnist.colorado.edu"
ServerIp(5) = "128.138.140.44"
ServerLocation(5) = "University of Colorado, Boulder"
ServerName(6) = "time.nist.gov"
ServerIp(6) = "192.43.244.18"
ServerLocation(6) = "NCAR, Boulder, Colorado"
ServerName(7) = "time-nw.nist.gov"
ServerIp(7) = "131.107.1.10"
ServerLocation(7) = "Microsoft, Redmond, Washington"
ServerName(8) = "nist1.datum.com"
ServerIp(8) = "209.0.72.7"
ServerLocation(8) = "Datum, San Jose, California"
ServerName(9) = "nist1.dc.certifiedtime.com"
ServerIp(9) = "216.200.93.8"
ServerLocation(9) = "Abovnet, Virginia"
ServerName(10) = "nist1.nyc.certifiedtime.com"
ServerIp(10) = "208.184.49.9"
ServerLocation(10) = "Abovnet, New York City"
ServerName(11) = "nist1.sjc.certifiedtime.com"
ServerIp(11) = "208.185.146.41"
ServerLocation(11) = "Abovnet, San Jose, California"
For i = 0 To 11
cboServer.AddItem "[" & ServerName(i) & "] " & ServerLocation(i), i
Next i
For i = 12 To 1 Step -1
cboGMT.AddItem "[GMT -" & i & " h.]"
Next i
cboGMT.AddItem "[GMT +0]"
For i = 1 To 12
cboGMT.AddItem "[GMT +" & i & " h.]"
Next i
nMin = 0
lRegData = GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "ServerIndex", bRegErr)
If (lRegData < 0 Or lRegData > 11) Or bRegErr Then lRegData = 0
cboServer.ListIndex = CInt(lRegData)
lRegData = GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "GMTIndex", bRegErr)
If (lRegData < 0 Or lRegData > 12) Or bRegErr Then lRegData = 7
cboGMT.ListIndex = CInt(lRegData)
lRegData = GetRegDWORD(HKEY_LOCAL_MACHINE, RegAppRoot, "Delay", bRegErr)
If (lRegData < 1 Or lRegData > 9999) Or bRegErr Then lRegData = 2
txtDelay.Text = CStr(lRegData)
If GetRegString(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run\", "AtomicTimeSync") <> "" Then
chkStartupSync.Value = 1
If Command = "-startup" Then
bStartupMode = True
Visible = False
DelayTimer.Enabled = True
End If
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Val(txtDelay.Text) < 1 Then
Cancel = True
MsgBox "Enter a number greater than zero.", vbExclamation
txtDelay.SetFocus
txtDelay.SelStart = 0
txtDelay.SelLength = Len(txtDelay.Text)
Exit Sub
End If
SaveRegDWORD HKEY_LOCAL_MACHINE, RegAppRoot, "ServerIndex", CLng(cboServer.ListIndex)
SaveRegDWORD HKEY_LOCAL_MACHINE, RegAppRoot, "GMTIndex", CLng(cboGMT.ListIndex)
SaveRegDWORD HKEY_LOCAL_MACHINE, RegAppRoot, "Delay", CLng(Val(txtDelay.Text))
If chkStartupSync.Value = 1 Then
SaveRegString HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run\", "AtomicTimeSync", """" + LCase(App.Path + IIf(Right(App.Path, 1) <> "\", "\", "")) + App.EXEName + ".exe"" -startup"
Else
DeleteValue HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\Run\", "AtomicTimeSync"
End If
End Sub
Private Sub txtDelay_KeyPress(KeyAscii As Integer)
If KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 8 Then Exit Sub
KeyAscii = 0
End Sub
Private Sub txtDelay_LostFocus()
txtDelay.Text = Val(txtDelay.Text)
End Sub
Private Sub WSTime_DataArrival(ByVal bytesTotal As Long)
Dim sRecvData As String
WSTime.GetData sRecvData
lblAtomicTime.Caption = ApplyGMT(Mid(sRecvData, 17, 8), cboGMT.ListIndex - 12)
Command3.Enabled = True
WSTime.Close
lblStatus.Caption = "Status: Atomic time successfully received."
If bStartupMode = True Then Command3_Click
End Sub
Private Sub WSTime_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
lblStatus.Caption = "Status: Winsock Error: " + Description
If bStartupMode = True Then End
End Sub