'
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Private Declare Function SetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) As Long
Dim T1 As Double
Dim T2 As Double
Dim T3 As Double
Dim T4 As Double
Private Sub Command1_Click()
With Winsock1
If .State <> sckClosed Then
.Close
End If
' NTP(Version4)는 포트번호 123, UDP 프로토콜을 이용한다.
' NTP Server (http://time.ewha.net/#public_time_server 참고)
' - ntp.ewha.net (이대부속 초등학교)
' - time.windows.com (MS)
.Protocol = sckUDPProtocol ' NTP
.RemoteHost = "ntp.ewha.net" ' NTP Server
.RemotePort = 123 ' NTP port - 123
.Bind
End With
' 요청 전문 전송
Dim NTPHeader(47) As Byte
NTPHeader(0) = &HB
Winsock1.SendData NTPHeader
' 시작 시간
T1 = GetUTC
End Sub
Private Sub Form_Load()
Timer1.Interval = 100
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
lblPC.Caption = Format$(Now, "YYYY/MM/DD HH:MM:SS")
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim sData() As Byte
Dim bytTimeStamp(7) As Byte
Dim t As Double
Dim d As Double
Dim CurrTime As Double
Dim tmpDate As Date
Dim st As SYSTEMTIME
Dim i As Integer
T4 = GetUTC
Winsock1.GetData sData
Winsock1.Close
' 표준시간은 RFC 2030에 명시된 공식에 의해 계산되었습니다.
For i = 0 To 7
bytTimeStamp(i) = sData(32 + i)
Next
T2 = GetTimeStampToUTC(bytTimeStamp)
For i = 0 To 7
bytTimeStamp(i) = sData(40 + i)
Next
T3 = GetTimeStampToUTC(bytTimeStamp)
d = (T4 - T1) - (T2 - T3)
t = ((T2 - T1) + (T3 - T4)) / 2
CurrTime = t + GetUTC
tmpDate = DateAdd("s", Int(CurrTime) - 2145830400, #1/1/1968#)
st.wMilliseconds = CInt((CurrTime - Fix(CurrTime)) * 1000)
If Check1.Value = 1 Then
With st
.wDay = Day(tmpDate)
.wHour = Hour(tmpDate)
.wMinute = Minute(tmpDate)
.wMonth = Month(tmpDate)
.wSecond = Second(tmpDate)
.wYear = Year(tmpDate)
End With
SetSystemTime st
End If
' 한국 표준시간으로 변환 (GTM+9)
tmpDate = DateAdd("h", 9, tmpDate)
lblStandard.Caption = Format$(tmpDate, "YYYY/MM/DD HH:MM:SS") & "." & Format$(st.wMilliseconds, "000")
lblInfo.Caption = "네트워크 지연 : " & CStr(Fix3(d)) & " sec" & vbCrLf & _
"오차 (표준시간 - PC): " & CStr(Fix3(t)) & " sec"
End Sub
Private Function GetUTC() As Double
Dim st As SYSTEMTIME
GetSystemTime st
With st
GetUTC = DateDiff("s", #1/1/1900#, CDate(DateSerial(.wYear, .wMonth, .wDay) & " " & TimeSerial(.wHour, .wMinute, .wSecond))) + CDbl(.wMilliseconds) / 1000
End With
End Function
Private Function GetTimeStampToUTC(ByRef bytTimeStamp() As Byte) As Double
Dim dblDate As Double
Dim dblTime As Double
dblDate = bytTimeStamp(0) * 256 ^ 3 + bytTimeStamp(1) * 256 ^ 2 + bytTimeStamp(2) * 256 ^ 1 + bytTimeStamp(3) * 256 ^ 0
dblTime = bytTimeStamp(4) * 256 ^ 3 + bytTimeStamp(5) * 256 ^ 2 + bytTimeStamp(6) * 256 ^ 1 + bytTimeStamp(7) * 256 ^ 0
GetTimeStampToUTC = dblDate + dblTime / 4294967296#
End Function
Private Function Fix3(ByVal Num As Double) As Double
Num = Num * 1000
Num = Fix(Num)
Num = Num / 1000
Fix3 = Num
End Function
비베 6으로 만들어진 거네여
실력이 부족해 해가 안가네여..
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1
BorderStyle = 1 '단일 고정
Caption = "Form1"
ClientHeight = 2115
ClientLeft = 45
ClientTop = 330
ClientWidth = 8055
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2115
ScaleWidth = 8055
StartUpPosition = 2 '화면 가운데
Begin VB.Timer Timer1
Left = 810
Top = 1200
End
Begin VB.CommandButton Command1
Caption = "표준시간"
BeginProperty Font
Name = "굴림"
Size = 9.75
Charset = 129
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 5970
TabIndex = 0
Top = 1470
Width = 1815
End
Begin VB.CheckBox Check1
Caption = "표준시간에 맞추기"
BeginProperty Font
Name = "굴림"
Size = 9.75
Charset = 129
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 3900
TabIndex = 2
Top = 1590
Width = 2295
End
Begin MSWinsockLib.Winsock Winsock1
Left = 360
Top = 1200
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.Label lblInfo
BeginProperty Font
Name = "굴림"
Size = 9.75
Charset = 129
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 465
Left = 1800
TabIndex = 7
Top = 870
Width = 5985
End
Begin VB.Label lblStandard
BeginProperty Font
Name = "굴림"
Size = 9.75
Charset = 129
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 1800
TabIndex = 6
Top = 540
Width = 5985
End
Begin VB.Label lblPC
BeginProperty Font
Name = "굴림"
Size = 9.75
Charset = 129
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 1800
TabIndex = 5
Top = 210
Width = 5985
End
Begin VB.Label Label3
Alignment = 1 '오른쪽 맞춤
Caption = "시간정보 :"
BeginProperty Font
Name = "굴림"
Size = 9.75
Charset = 129
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 330
TabIndex = 4
Top = 870
Visible = 0 'False
Width = 1425
End
Begin VB.Label Label2
Alignment = 1 '오른쪽 맞춤
Caption = "표준시간 :"
BeginProperty Font
Name = "굴림"
Size = 9.75
Charset = 129
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 330
TabIndex = 3
Top = 540
Width = 1425
End
Begin VB.Label Label1
Alignment = 1 '오른쪽 맞춤
Caption = "PC 시간 :"
BeginProperty Font
Name = "굴림"
Size = 9.75
Charset = 129
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 330
TabIndex = 1
Top = 210
Width = 1425
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
위에 있는 코드입니다.
압축파일에 코드 및 폼 디자인 있습니다.
