Pada artikel singkat kali ini saya ingin berbagi sebuah trik yaitu bagaimana cara merubah zona waktu (Time Zone) di PC atau Laptop dengan kode pemograman VB6.
Untuk merubah dan menampilkan zona waktu dengan kode pemogrogram VB secara sederhananya sangat mudah, yaitu Anda cukup menempatkan 1 buah Listbox di Form. Untuk lebih jelasnya perhatikan gambar dibawah ini :
Kemudian copy kode dibawah ini :
Option Explicit
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
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 Type REGTIMEZONEINFORMATION
Bias As Long
StandardBias As Long
DaylightBias As Long
StandardDate As SYSTEMTIME
DaylightDate As SYSTEMTIME
End Type
Private Type TIME_ZONE_INFORMATION
Bias As Long
StandardName(0 To 63) As Byte
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(0 To 63) As Byte
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type
Private Const TIME_ZONE_ID_INVALID = &HFFFFFFFF
Private Const TIME_ZONE_ID_UNKNOWN = 0
Private Const TIME_ZONE_ID_STANDARD = 1
Private Const TIME_ZONE_ID_DAYLIGHT = 2
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Declare Function SetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Const REG_SZ As Long = 1
Private Const REG_BINARY = 3
Private Const REG_DWORD As Long = 4
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_USERS = &H80000003
Private Const ERROR_SUCCESS = 0
Private Const ERROR_BADDB = 1
Private Const ERROR_BADKEY = 2
Private Const ERROR_CANTOPEN = 3
Private Const ERROR_CANTREAD = 4
Private Const ERROR_CANTWRITE = 5
Private Const ERROR_OUTOFMEMORY = 6
Private Const ERROR_ARENA_TRASHED = 7
Private Const ERROR_ACCESS_DENIED = 8
Private Const ERROR_INVALID_PARAMETERS = 87
Private Const ERROR_NO_MORE_ITEMS = 259
Private Const KEY_ALL_ACCESS = &H3F
Private Const REG_OPTION_NON_VOLATILE = 0
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpszValueName As String, ByVal lpdwReserved As Long, lpdwType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Const SKEY_NT = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones"
Const SKEY_9X = "SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones"
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, lpWideCharStr As Any, ByVal cchWideChar As Long) As Long
Private Const CP_ACP = 0
Private Const MB_PRECOMPOSED = &H1
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal numbytes As Long)
Dim SubKey As String
Private Sub Form_Load()
Dim lRetVal As Long, lResult As Long, lCurIdx As Long
Dim lDataLen As Long, lValueLen As Long, hKeyResult As Long
Dim strvalue As String
Dim osV As OSVERSIONINFO
osV.dwOSVersionInfoSize = Len(osV)
Call GetVersionEx(osV)
If osV.dwPlatformId = VER_PLATFORM_WIN32_NT Then
SubKey = SKEY_NT
Else
SubKey = SKEY_9X
End If
lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey, 0, KEY_ALL_ACCESS, hKeyResult)
If lRetVal = ERROR_SUCCESS Then
lCurIdx = 0
lDataLen = 32
lValueLen = 32
Do
strvalue = String(lValueLen, 0)
lResult = RegEnumKey(hKeyResult, lCurIdx, strvalue, lDataLen)
If lResult = ERROR_SUCCESS Then
List1.AddItem Left(strvalue, lValueLen)
End If
lCurIdx = lCurIdx + 1
Loop While lResult = ERROR_SUCCESS
RegCloseKey hKeyResult
Else
List1.AddItem "Could not open registry key"
End If
End Sub
Private Sub List1_DblClick()
Dim TZ As TIME_ZONE_INFORMATION, oldTZ As TIME_ZONE_INFORMATION
Dim rTZI As REGTIMEZONEINFORMATION
Dim bytDLTName(32) As Byte, bytSTDName(32) As Byte
Dim cbStr As Long, dwType As Long
Dim lRetVal As Long, hKeyResult As Long, lngData As Long
lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey & "\" & List1.Text, 0, KEY_ALL_ACCESS, hKeyResult)
If lRetVal = ERROR_SUCCESS Then
lRetVal = RegQueryValueEx(hKeyResult, "TZI", 0&, ByVal 0&, rTZI, Len(rTZI))
If lRetVal = 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
lRetVal = RegQueryValueEx(hKeyResult, "Std", 0&, dwType, bytSTDName(0), cbStr)
If lRetVal = ERROR_SUCCESS Then
Call MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, bytSTDName(0), cbStr, TZ.StandardName(0), 32)
Else
RegCloseKey hKeyResult
Exit Sub
End If
cbStr = 32
dwType = REG_SZ
lRetVal = RegQueryValueEx(hKeyResult, "Dlt", 0&, dwType, bytDLTName(0), cbStr)
If lRetVal = ERROR_SUCCESS Then
Call MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, bytDLTName(0), cbStr, TZ.DaylightName(0), 32)
Else
RegCloseKey hKeyResult
Exit Sub
End If
lRetVal = GetTimeZoneInformation(oldTZ)
If lRetVal = TIME_ZONE_ID_INVALID Then
MsgBox "Error getting original TimeZone Info"
RegCloseKey hKeyResult
Exit Sub
Else
If TZ.DaylightDate.wMonth <> 0 And TZ.DaylightBias <> 0 Then
lRetVal = SetTimeZoneInformation(TZ)
Else
Call CopyMemory(TZ.DaylightName(0), TZ.StandardName(0), 64)
TZ.DaylightBias = 0
lRetVal = SetTimeZoneInformation(TZ)
End If
MsgBox "Time Zone Changed, Click OK to restore"
lRetVal = SetTimeZoneInformation(oldTZ)
End If
End If
RegCloseKey hKeyResult
End If
End Sub
Simpan dan jalankan Project Anda, setelah itu doubel klik zona yang dipilih.
Demikian artikel singkat kali ini tentang cara merubah zona waktu (Time Zone) dengan kode pemograman VB6.
Semoga artikel ini bermanfaat buat kita semua,Amin.
Selamat mencoba semoga berhasil!!
No comments:
Post a Comment