Private Type SystemTime
wYear As Integer
wMonth As Integer
wWeekday As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Private Type TimeZoneInformation
Bias As Long
StandardName As String * 32
StandardDate As SystemTime
StandardBias As Long
DaylightName As String * 32
DaylightDate As SystemTime
DaylightBias As Long
End Type
Private Declare Function apiGetTimeZoneInformation Lib "kernel32" Alias "GetTimeZoneInformation" (ByRef lpTimeZone As Any) As Long
Private Declare Function apiSystemTimeToTzSpecificLocalTime Lib "kernel32" Alias "SystemTimeToTzSpecificLocalTime" (ByRef lpTimeZone As Any, ByRef lpUTCTime As Any, ByRef lpLocalTime As Any) As Long
Private Declare Function apiTzSpecificLocalTimeToSystemTime Lib "kernel32" Alias "TzSpecificLocalTimeToSystemTime" (ByRef lpTimeZone As Any, ByRef lpLocalTime As Any, ByRef lpUTCTime As Any) As Long
Public Function GetTimeZoneInfo(Optional ByRef ZoneDelta As Long, Optional ByRef ZoneName As String, Optional ByRef ZoneCode As String) As Long
Dim Z As TimeZoneInformation, ret As Long
ret = apiGetTimeZoneInformation(Z)
If ret = (-1&) Then Exit Function
ZoneDelta = Z.Bias
ZoneName = StrConv(Z.StandardName, vbFromUnicode)
Select Case ZoneDelta
Case 0
ZoneCode = "GMT"
Case Is < 0
ZoneCode = "GMT+" & Format$(Abs(ZoneDelta) \ 60, "00") & Format$(Abs(ZoneDelta) Mod 60, "00")
Case Is > 0
ZoneCode = "GMT-" & Format$(Abs(ZoneDelta) \ 60, "00") & Format$(Abs(ZoneDelta) Mod 60, "00")
End Select
GetTimeZoneInfo = -ZoneDelta
End Function
Public Function TimeLocal2UTC(ByVal LocalTime As Date) As Date
Dim Z As TimeZoneInformation, U As SystemTime, L As SystemTime, ret As Long
'TzSpecificLocalTimeToSystemTime unavailable on Windows 2000
'Start patch
ret = apiGetTimeZoneInformation(Z)
If ret = (-1&) Then TimeLocal2UTC = LocalTime: Exit Function
TimeLocal2UTC = DateAdd("n", Z.Bias, LocalTime)
Exit Function
'End patch
With L
.wYear = Year(LocalTime)
.wMonth = Month(LocalTime)
.wDay = Day(LocalTime)
.wWeekday = Weekday(LocalTime) - 1
.wHour = Hour(LocalTime)
.wMinute = Minute(LocalTime)
.wSecond = Second(LocalTime)
.wMilliseconds = 0
End With
ret = apiTzSpecificLocalTimeToSystemTime(ByVal 0&, L, U)
If ret = 0& Then TimeLocal2UTC = LocalTime: Exit Function
TimeLocal2UTC = DateSerial(U.wYear, U.wMonth, U.wDay) + TimeSerial(U.wHour, U.wMinute, U.wSecond)
End Function
Public Function TimeUTC2Local(ByVal UTCTime As Date) As Date
Dim Z As TimeZoneInformation, U As SystemTime, L As SystemTime, ret As Long
With U
.wYear = Year(UTCTime)
.wMonth = Month(UTCTime)
.wDay = Day(UTCTime)
.wWeekday = Weekday(UTCTime) - 1
.wHour = Hour(UTCTime)
.wMinute = Minute(UTCTime)
.wSecond = Second(UTCTime)
.wMilliseconds = 0
End With
ret = apiSystemTimeToTzSpecificLocalTime(ByVal 0&, U, L)
If ret = 0& Then TimeUTC2Local = UTCTime: Exit Function
TimeUTC2Local = DateSerial(L.wYear, L.wMonth, L.wDay) + TimeSerial(L.wHour, L.wMinute, L.wSecond)
End Function
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
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 Sub Form_Load()
Dim SysTime As SYSTEMTIME
Me.AutoRedraw = True
GetSystemTime SysTime
Me.Print "The System Date is:" & SysTime.wMonth & "-" & SysTime.wDay & "-" & SysTime.wYear
Me.Print "The System Time is:" & SysTime.wHour & ":" & SysTime.wMinute & ":" & SysTime.wSecond
End Sub
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 23