ssCAROのブログ

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

PC(Windows 10)の時刻を設定するために盾マークのexeを作成

Windows 10になってからではないけど、システム時刻をプログラムから合わせるにはユーザーアカウント制御を何とかするか、管理者権限で実行するかしないと出来なくなった。

タスクスケジューラに登録して管理者で実行する方法もあるみたい。

ユーザーアカウント制御の実行を聞かれるのはしょうがないと諦めて右クリックして"管理者として実行"をしなくても良いように盾マークのexeを作成することにした。
参考URL:再試行でDebugできない~VS2015

次のプログラムを「NTPサーバの現在日時をシステム時計に設定するサンプル(VB.NET)」を転記しています。
タイムサーバーは、time.windows.com です。

Public Class Form1

    ' システム時計の日時設定APIの引数
    <System.Runtime.InteropServices.StructLayout(System.Runtime.InteropServices.LayoutKind.Sequential)>
    Public 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

    ' システム時計の日時設定APIの定義
    <System.Runtime.InteropServices.DllImport("kernel32.dll")>
    Public Shared Function SetLocalTime(ByRef sysTime As SystemTime) As Boolean
    End Function

    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click

        ' 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), "time.windows.com", 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)

        ' 現在の日時表示
        System.Diagnostics.Trace.WriteLine(dtTime)

        ' システム時計の日時設定
        SetSysTime(dtTime)

    End Sub

    ' システム時計の日時設定
    Private Sub SetSysTime(ByVal dtm As DateTime)
        Dim sTime As New SystemTime
        sTime.wYear = dtm.Year
        sTime.wMonth = dtm.Month
        sTime.wDay = dtm.Day
        sTime.wHour = dtm.Hour
        sTime.wMinute = dtm.Minute
        sTime.wSecond = dtm.Second
        sTime.wMiliseconds = dtm.Millisecond
        SetLocalTime(sTime)
    End Sub

End Class

ソリューション エクスプローラーからプロジェクトを右クリックして[追加]→[新しい項目]をクリックする。
"アプリケーション マニフェスト ファイル"を選択して追加する。
app.manifestにある次行を変更する。(コメントされているのをコピーして貼り付けると良い)
変更前:<requestedExecutionLevel level="asInvoker" uiAccess="false" />
変更後:<requestedExecutionLevel level="requireAdministrator" uiAccess="false" />
f:id:ssCARO:20200630152608p:plain

ソリューションをリビルドしたらexeに盾マークが付いている。
このexeを実行すると、ユーザーアカウント制御が聞かれるので"はい"を押す。