タイムゾーンの取得と変更          <TOP>


Windows9x系と、WindowsNT系ではレジストリの位置が異なるため、バージョンにより切り替えています。

GetTimeZoneInformation タイムゾーン情報を取得
SetTimeZoneInformation タイムゾーン情報を設定
RegOpenKeyEx レジストリのキーのハンドルを確保
RegQueryValueEx (RegQueryValueExString)レジストリの値を取得
RegEnumKey 指定された開いているレジストリーキーのサブキーを列挙
RegCloseKey レジストリのハンドルを解放
MultiByteToWideChar ANSI文字列をUnicode文字列に変換
CopyMemory ある位置から別の位置にメモリブロックを移動

 

例では、起動時に世界のタイムゾーンがListBoxに表示され、ダブルクリックした項目のタイムゾーンに切り替わる状態を表しています。

「日付と時刻のプロパティ」は、表示された状態で切り替わるものではありません。

 
'================================================================
'= タイムゾーンの取得と変更
'=(SetTimeZoneInformation.bas)
'================================================================
#include "Windows.bi"

#define VER_PLATFORM_WIN32_NT 2         'WINDOWSNT、2000、XP
#define VER_PLATFORM_WIN32_WINDOWS 1    'WINDOWS9x

Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion      As Long
    dwMinorVersion      As Long
    dwBuildNumber       As Long
    dwPlatformId        As Long
    szCSDVersion        As String * 128
End Type

' オペレーティングシステムの種類やバージョンに関する情報を取得
Declare Function Api_GetVersionEx& Lib "Kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO)

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

Type REGTIMEZONEINFORMATION
    Bias         As Long
    StandardBias As Long
    DaylightBias As Long
    StandardDate As SYSTEMTIME
    DaylightDate As SYSTEMTIME
End Type

Type TIME_ZONE_INFORMATION
    Bias As Long
    StandardName(63) As Byte            'ユニコード文字列取得のため使用
    StandardDate     As SYSTEMTIME
    StandardBias     As Long
    DaylightName(63) As Byte            'ユニコード文字列取得のため使用
    DaylightDate     As SYSTEMTIME
    DaylightBias     As Long
End Type

#define TIME_ZONE_ID_INVALID &HFFFFFFFF
#define TIME_ZONE_ID_UNKNOWN 0
#define TIME_ZONE_ID_STANDARD 1
#define TIME_ZONE_ID_DAYLIGHT 2

' タイムゾーン情報を取得
Declare Function Api_GetTimeZoneInformation& Lib "kernel32" Alias "GetTimeZoneInformation" (lpTimeZoneInformation As TIME_ZONE_INFORMATION)

' タイムゾーン情報を設定
Declare Function Api_SetTimeZoneInformation& Lib "kernel32" Alias "SetTimeZoneInformation" (lpTimeZoneInformation As TIME_ZONE_INFORMATION)

#define REG_SZ 1                        'ヌル終端文字列
#define REG_BINARY 3                    'バイナリデータ
#define REG_DWORD 4                     '32ビットの数値
#define HKEY_CLASSES_ROOT -2147483648   '拡張子に関する情報や、それらとアプリケーションとの関連づけに関する情報
#define HKEY_CURRENT_USER -2147483647   '現在Windowsにログインしているユーザーの情報
#define HKEY_LOCAL_MACHINE -2147483646  'PCを利用するユーザーに共通の設定情報
#define HKEY_USERS -2147483645          'Windowsを利用するユーザー個別の情報

#define ERROR_SUCCESS 0                 '正常終了の戻り値を示す
#define ERROR_BADDB 1                   '
#define ERROR_BADKEY 2                  '
#define ERROR_CANTOPEN 3                '
#define ERROR_CANTREAD 4                '
#define ERROR_CANTWRITE 5               '
#define ERROR_OUTOFMEMORY 6             '
#define ERROR_ARENA_TRASHED 7           '
#define ERROR_ACCESS_DENIED 8           '
#define ERROR_INVALID_PARAMETERS 87     '
#define ERROR_NO_MORE_ITEMS 259         '
#define KEY_ALL_ACCESS &H3F             'レジストリに対するすべての権限を許可
#define REG_OPTION_NON_VOLATILE 0       '

' レジストリのキーのハンドルを確保
Declare Function Api_RegOpenKeyEx& Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey&, ByVal lpSubKey$, ByVal ulOptions&, ByVal samDesired&, phkResult&)

' レジストリの値を取得
Declare Function Api_RegQueryValueEx& Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey&, ByVal lpszValueName$, ByVal lpdwReserved&, lpdwType&, lpData As Any, lpcbData&)

' レジストリの値を取得
Declare Function Api_RegQueryValueExString& Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey&, ByVal lpValueName$, ByVal lpReserved&, lpType&, ByVal lpData$, lpcbData&)

' 指定された開いているレジストリーキーのサブキーを列挙
Declare Function Api_RegEnumKey& Lib "advapi32" Alias "RegEnumKeyA" (ByVal hKey&, ByVal dwIndex&, ByVal lpName$, ByVal cbName&)

' レジストリのハンドルを解放
Declare Function Api_RegCloseKey& Lib "advapi32" Alias "RegCloseKey" (ByVal hKey&)

#define SKEY_NT "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones"
#define SKEY_9X "SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones"

' ANSI文字列をUnicode文字列に変換
Declare Function Api_MultiByteToWideChar& Lib "kernel32" Alias "MultiByteToWideChar" (ByVal CodePage&, ByVal dwFlags&, lpMultiByteStr As Any, ByVal cchMultiByte&, lpWideCharStr As Any, ByVal cchWideChar&)

#define CP_ACP 0
#define MB_PRECOMPOSED &H1

' ある位置から別の位置にメモリブロックを移動
Declare Sub CopyMemory Lib "Kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length&)

Var Shared List1 As Object

List1.Attach GetDlgItem("List1") : List1.SetFontSize 14
List1.SetWindowSize 210, 90

Var Shared SubKey As String

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var CurIdx As Long
    Var DataLen As Long
    Var ValueLen As Long
    Var hKey As Long
    Var strvalue As String
    Var osV As OSVERSIONINFO
    Var Ret As Long

    osV.dwOSVersionInfoSize = Len(osV)
    Ret = Api_GetVersionEx(osV)
    If osV.dwPlatformId = VER_PLATFORM_WIN32_NT Then
        SubKey = SKEY_NT
    Else
        SubKey = SKEY_9X
    End If

    Ret = Api_RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey, 0, KEY_ALL_ACCESS, hKey)

    If Ret = ERROR_SUCCESS Then
        CurIdx = 0
        DataLen = 32
        ValueLen = 32
        Do
            strvalue = String$(ValueLen, 0)
            Ret = Api_RegEnumKey(hKey, CurIdx, strvalue, DataLen)

            If Ret = ERROR_SUCCESS Then
                List1.AddString Left$(strvalue, ValueLen)
            End If
            CurIdx = CurIdx + 1
        Loop While Ret = ERROR_SUCCESS
        Ret = Api_RegCloseKey(hKey)
    Else
        List1.AddString "Could not open registry key"
    End If
End Sub

'================================================================
'=
'================================================================
Declare Sub List1_DblClick edecl ()
Sub List1_DblClick()
    Var TZ As TIME_ZONE_INFORMATION
    Var oldTZ As TIME_ZONE_INFORMATION
    Var rTZI As REGTIMEZONEINFORMATION
    Var bytDLTName(32) As Byte
    Var bytSTDName(32) As Byte
    Var cbStr As Long
    Var dwType As Long
    Var hKey As Long
    Var lngData As Long
    Var Ret As Long

    Ret = Api_RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey & "\" & List1.GetText(List1.GetCursel), 0, KEY_ALL_ACCESS, hKey)

    If Ret = ERROR_SUCCESS Then
        Ret = Api_RegQueryValueEx(hKey, "TZI", 0&, ByVal 0&, rTZI, Len(rTZI))
        If Ret = ERROR_SUCCESS Then
            TZ.Bias = rTZI.Bias
            TZ.StandardBias = rTZI.StandardBias
            TZ.DaylightBias = rTZI.DaylightBias
            TZ.StandardDate = rTZI.StandardDate
            TZ.DaylightDate = rTZI.DaylightDate
            cbStr = 32
            dwType = REG_SZ

            Ret = Api_RegQueryValueEx(hKey, "Std", 0, dwType, bytSTDName(0), cbStr)

            If Ret = ERROR_SUCCESS Then
                Ret = Api_MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, bytSTDName(0), cbStr, TZ.StandardName(0), 32)
            Else
                Ret = Api_RegCloseKey(hKey)
                Exit Sub
            End If

            cbStr = 32
            dwType = REG_SZ

            Ret = Api_RegQueryValueEx(hKey, "Dlt", 0, dwType, bytDLTName(0), cbStr)
            If Ret = ERROR_SUCCESS Then
                Ret = Api_MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, bytDLTName(0), cbStr, TZ.DaylightName(0), 32)
            Else
                Ret = Api_RegCloseKey(hKey)
                Exit Sub
            End If

            Ret = Api_GetTimeZoneInformation(oldTZ)

            If Ret = TIME_ZONE_ID_INVALID Then
                A% = MessageBox("", "Error getting original TimeZone Info", 0, 2)
                Ret = Api_RegCloseKey(hKey)
                Exit Sub
            Else
                If TZ.DaylightDate.wMonth <> 0 And TZ.DaylightBias <> 0 Then
                    Ret = Api_SetTimeZoneInformation(TZ)
                Else
                    CopyMemory TZ.DaylightName(0), TZ.StandardName(0), 64
                    TZ.DaylightBias = 0
                    Ret = Api_SetTimeZoneInformation(TZ)
                End If
                A% = MessageBox("", "タイムゾーンを変更しました!" & Chr$(13, 10) &  "「OK」クリックで元に戻ります。", 0, 2)
                Ret = Api_SetTimeZoneInformation(oldTZ)
            End If
        End If

        Ret = Api_RegCloseKey(hKey)
    End If
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End