ssCAROのブログ

色んなとこで見つけたプログラムのメモ置き場っぽい

PCの時刻同期を徐々に行う

VB.net

※Windows 10だとユーザーアカウント制御のため時刻合わせが出来ないと思います。
管理者権限で実行する(タスクスケジューラから管理者権限で実行)等の対策が必要です。

PCの時刻同期をすると、設定する時刻にいっきに設定されます。
時刻が進む分には良いかも？しれないけど、時刻が戻るとなると色々問題があったりなかったり。
特にDBを使ってると困ることが多いです。

そのために、時刻同期を徐々に行えるようなプログラムをあちこち探してくっつけて作成してみた。
Windowsのシステムクロックの間隔を早くしたり遅くしたりすることで時刻を調整します。
時間が飛んだりすることがないですが、ぴったり合いません。
時刻が合うまで結構時間がかかります。

パソコンの時計には2種類の時計があります。

  • ハードウェアクロック、リアルタイムクロック(RTC)と呼ばれるマザーボード上で動作している時計。
  • WindowsのOSが管理しているシステムクロックと呼ばれる時計。

Windowsは下記の仕様で動作するようです。
1時間に1回、リアルタイムクロックとシステムクロックの時刻差が60秒以上あるとシステムクロックをリアルタイムクロックに同期させる。

このため、システムクロックの間隔を早くして時刻を調整してもリアルタイムクロックの値に同期し直させる場合があります。
そのため、時刻調整が完了したら、現在時刻でシステムクロックを書き込んでリアルタイムクロックをシステムクロックに合わせる必要があります。

参考ホームページ
コンピュータの電源切る、システムのシャットダウン、再起動、ログオフする
http://dobon.net/vb/dotnet/system/shutdown.html
システム時計の日時を設定する
http://dobon.net/vb/dotnet/system/setlocaltime.html
NTPサーバの現在日時をシステム時計に設定するサンプル(VB.NET)
http://nonsoft.la.coocan.jp/SoftSample/VB.NET/SampleNtpDateTime.html
時刻の後戻りを発生させずにシステム全体の時刻を確実に同期させたい
http://itpro.nikkeibp.co.jp/free/NT/WinReadersOnly/20050315/3/
Windows時計とBIOS時計(RTC)の同期処理の変更について
https://social.technet.microsoft.com/Forums/ja-JP/7d33c109-4d56-4420-be54-e589a890d206/windowsbiosrtc?forum=w7itprogeneralja
Windows の日付および時刻の管理方法
http://support.microsoft.com/kb/232488/ja
高精度イベント タイマがサポートされている Windows Vista ベースのコンピュータで、システム時刻が BIOS 時刻と異なる場合がある
http://support.microsoft.com/kb/946033/ja

<System.Runtime.InteropServices.DllImport("kernel32.dll", SetLastError:=True)>
Private Shared Function SetSystemTimeAdjustment(ByVal dwTimeAdjustment As Integer,
ByVal bTimeAdjustmentDisabled As Boolean) As Integer
End Function

<System.Runtime.InteropServices.DllImport("kernel32.dll", SetLastError:=True)>
Private Shared Function GetSystemTimeAdjustment(ByRef lpTimeAdjustment As Integer,
ByRef lpTimeIncrement As Integer,
ByRef lpTimeAdjustmentDisabled As Boolean) As Integer
End Function

<System.Runtime.InteropServices.StructLayout(System.Runtime.InteropServices.LayoutKind.Sequential)>
Private Structure SystemTime
    Public wYear As Short
    Public wMonth As Short
    Public wDayOfWeek As Short
    Public wDay As Short
    Public wHour As Short
    Public wMinute As Short
    Public wSecond As Short
    Public wMiliseconds As Short
End Structure

<System.Runtime.InteropServices.DllImport("kernel32.dll")>
Private Shared Function SetLocalTime(ByRef sysTime As SystemTime) As Boolean
End Function

'現在のシステム日時を設定する
Private Shared Sub SetNowDateTime(ByVal dt As DateTime)
    'システム日時に設定する日時を指定する
    Dim sysTime As New SystemTime
    sysTime.wYear = dt.Year
    sysTime.wMonth = dt.Month
    sysTime.wDay = dt.Day
    sysTime.wHour = dt.Hour
    sysTime.wMinute = dt.Minute
    sysTime.wSecond = dt.Second
    sysTime.wMiliseconds = dt.Millisecond

    'システム日時を設定する
    SetLocalTime(sysTime)
End Sub

Private m_systemTime As DateTime = DateTime.Now

Public Sub AdjustTime()

    '時刻間隔の情報を取得
    Dim lpTimeAdjustment As Integer = 0
    Dim lpTimeIncrement As Integer = 0
    Dim lpTimeAdjustmentDisabled As Boolean = True
    GetSystemTimeAdjustment(lpTimeAdjustment, lpTimeIncrement, lpTimeAdjustmentDisabled)

    'PCとNTPの時刻を取得
    m_systemTime = DateTime.Now
    Dim ntpTime As DateTime = GetNTPTime()
    Dim ts As TimeSpan = m_systemTime.Subtract(ntpTime)

    Dim dwTimeAdjustment As Integer = 0
    Dim bTimeAdjustmentDisabled As Boolean = False

    'NTP時刻が進んでいるのでクロックを早く
    If ts.TotalMilliseconds >= 0 Then
        dwTimeAdjustment = lpTimeAdjustment * 2
        m_systemTime = m_systemTime.AddMilliseconds(Math.Abs(ts.TotalMilliseconds) * 2.0)
    End If
    'PC時刻が進んでいるのでクロックを遅く
    If ts.TotalMilliseconds < 0 Then
        dwTimeAdjustment = lpTimeAdjustment / 2
        m_systemTime = m_systemTime.AddMilliseconds(Math.Abs(ts.TotalMilliseconds))
    End If

    '時刻変更の権限を取得
    Utility.AdjustToken()
    '時刻間隔を調整
    Dim ret As Integer = SetSystemTimeAdjustment(dwTimeAdjustment, bTimeAdjustmentDisabled)

    '時刻調整用のタイマーを開始
    Dim timer As Timer = New Timer
    AddHandler timer.Tick, New EventHandler(AddressOf AdjustTime_Tick)
    timer.Interval = 1  '10ms以下で動作しないようだけど一応
    timer.Start()

End Sub

Private Sub AdjustTime_Tick(sender As System.Object, e As System.EventArgs)

    If DateTime.Compare(DateTime.Now, m_systemTime) >= 0 Then
        '時刻同期が完了
        DirectCast(sender, Timer).Stop()
        '時刻調整を元の間隔に戻す
        'これをしないと早いままだったり遅いままだったりするので注意
        Dim ret As Integer = SetSystemTimeAdjustment(0, True)
        '現在時刻を書き込みリアルタイムクロックと同期させる
        SetNowDateTime(Datetime.Now)
    End If

End Sub

Private Function GetNTPTime() As DateTime

    ' NTPサーバへの接続用UDP生成
    Dim objSck As System.Net.Sockets.UdpClient
    Dim ipAny As System.Net.IPEndPoint = New System.Net.IPEndPoint(System.Net.IPAddress.Any, 0)
    objSck = New System.Net.Sockets.UdpClient(ipAny)

    ' NTPサーバへのリクエスト送信
    Dim sdat As Byte() = New Byte(47) {}
    sdat(0) = &HB
    objSck.Send(sdat, sdat.GetLength(0), "ntp.nict.jp", 123)

    ' NTPサーバから日時データ受信
    Dim rdat As Byte() = objSck.Receive(ipAny)

    ' 1900年1月1日からの経過時間(日時分秒)
    Dim lngAllS As Long ' 1900年1月1日からの経過秒数
    Dim lngD As Long    ' 日
    Dim lngH As Long    ' 時
    Dim lngM As Long    ' 分
    Dim lngS As Long    ' 秒

    ' 1900年1月1日からの経過秒数計算
    lngAllS = CLng( _
              rdat(40) * Math.Pow(2, (8 * 3)) + _
              rdat(41) * Math.Pow(2, (8 * 2)) + _
              rdat(42) * Math.Pow(2, (8 * 1)) + _
              rdat(43))

    ' 1900年1月1日からの経過(日時分秒)計算
    lngD = lngAllS \ (24 * 60 * 60)   ' 日
    lngS = lngAllS Mod (24 * 60 * 60) ' 残りの秒数
    lngH = lngS \ (60 * 60)           ' 時
    lngS = lngS Mod (60 * 60)         ' 残りの秒数
    lngM = lngS \ 60                  ' 分
    lngS = lngS Mod 60                ' 秒

    ' 現在の日時(DateTime)計算
    Dim dtTime As DateTime = "1900/01/01"
    dtTime = dtTime.AddDays(lngD)
    dtTime = dtTime.AddHours(lngH)
    dtTime = dtTime.AddMinutes(lngM)
    dtTime = dtTime.AddSeconds(lngS)

    ' グリニッジ標準時から日本時間への変更
    dtTime = dtTime.AddHours(9)

    ' システム時計の日時設定
    Return dtTime

End Function

Public Class Utility

    <System.Runtime.InteropServices.DllImport("kernel32.dll", SetLastError:=True)>
    Private Shared Function GetCurrentProcess() As IntPtr
    End Function

    <System.Runtime.InteropServices.DllImport("advapi32.dll", SetLastError:=True)>
    Private Shared Function OpenProcessToken(ByVal ProcessHandle As IntPtr,
    ByVal DesiredAccess As Integer,
    ByRef TokenHandle As IntPtr) As Boolean
    End Function

    <System.Runtime.InteropServices.DllImport("kernel32.dll", SetLastError:=True)>
    Private Shared Function CloseHandle(ByVal hHandle As IntPtr) As Boolean
    End Function

    <System.Runtime.InteropServices.DllImport("advapi32.dll", SetLastError:=True,
        CharSet:=System.Runtime.InteropServices.CharSet.Auto)>
    Private Shared Function LookupPrivilegeValue(ByVal lpSystemName As String,
    ByVal lpName As String,
    ByRef lpLuid As Long) As Boolean
    End Function

    <System.Runtime.InteropServices.StructLayout(
        System.Runtime.InteropServices.LayoutKind.Sequential, Pack:=1)>
    Private Structure TOKEN_PRIVILEGES
        Public PrivilegeCount As Integer
        Public Luid As Long
        Public Attributes As Integer
    End Structure

    <System.Runtime.InteropServices.DllImport("advapi32.dll", SetLastError:=True)>
    Private Shared Function AdjustTokenPrivileges(ByVal TokenHandle As IntPtr,
    ByVal DisableAllPrivileges As Boolean,
    ByRef NewState As TOKEN_PRIVILEGES,
    ByVal BufferLength As Integer,
    ByVal PreviousState As IntPtr,
    ByVal ReturnLength As IntPtr) As Boolean
    End Function

    '時刻変更するためのセキュリティ特権を有効にする
    Public Shared Sub AdjustToken()
        Const TOKEN_ADJUST_PRIVILEGES As Integer = &H20
        Const TOKEN_QUERY As Integer = &H8
        Const SE_PRIVILEGE_ENABLED As Integer = &H2
        Const SE_SYSTEMTIME_NAME As String = "SeSystemtimePrivilege"

        If Environment.OSVersion.Platform <> PlatformID.Win32NT Then
            Return
        End If

        Dim procHandle As IntPtr = GetCurrentProcess()

        'トークンを取得する
        Dim tokenHandle As IntPtr
        OpenProcessToken(procHandle, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, tokenHandle)
        'LUIDを取得する
        Dim tp As New TOKEN_PRIVILEGES()
        tp.Attributes = SE_PRIVILEGE_ENABLED
        tp.PrivilegeCount = 1
        LookupPrivilegeValue(Nothing, SE_SYSTEMTIME_NAME, tp.Luid)
        '特権を有効にする
        AdjustTokenPrivileges(tokenHandle, False, tp, 0, IntPtr.Zero, IntPtr.Zero)

        '閉じる
        CloseHandle(tokenHandle)
    End Sub

End Class

ここまで作ってみたけど、Windows Time サービスで、徐々に時刻を合わせる (Slew モード)を使えば同じことが出来ます。

Windows Time サービスにおける時刻同期の仕組み
http://support2.microsoft.com/kb/2722681/ja