시간서버 동기화 프로그램

네크 2014.10.06 22:09:35 *: Option Explicit


'
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

 

위에 있는 코드입니다.

압축파일에 코드 및 폼 디자인 있습니다.