添加当前日期标签（Label1），一个命令按钮 （Command1）和五个文本框（Text1-Text5）。其他标签则是可选的。添加以下代码：
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const TIME_ZONE_ID_UNKNOWN As Long = 1
Private Const TIME_ZONE_ID_STANDARD As Long = 1
Private Const TIME_ZONE_ID_DAYLIGHT As Long = 2
Private Const TIME_ZONE_ID_INVALID As Long = &HFFFFFFFF
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 TIME_ZONE_INFORMATION
Bias As Long
StandardName(0 To 63) As Byte 'unicode (0-based)
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(0 To 63) As Byte 'unicode (0-based)
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type
Private Declare Function GetTimeZoneInformation Lib "kernel32" _
(lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Sub Form_Load()
Command1.Caption = "Get Time Zone Bias"
End Sub
Private Sub Command1_Click()
Label1.Caption = Format$(Now, "dddd mmm dd, yyyy hh:mm:ss am/pm")
Text1.Text = GetCurrentTimeZone()
Text2.Text = GetCurrentTimeBias()
Text3.Text = GetCurrentGMTDate()
Text4.Text = GetStandardTimeBias()
Text5.Text = GetDaylightTimeBias()
End Sub
Private Function GetDaylightTimeBias() As String
Dim tzi As TIME_ZONE_INFORMATION
Dim dwBias As Long
Dim tmp As String
Call GetTimeZoneInformation(tzi)
dwBias = tzi.Bias + tzi.DaylightBias
tmp = CStr(dwBias \ 60) & " hours, " & CStr(dwBias Mod 60) & " minutes"
GetDaylightTimeBias = tmp
End Function
Private Function GetStandardTimeBias() As String
Dim tzi As TIME_ZONE_INFORMATION
Dim dwBias As Long
Dim tmp As String
Call GetTimeZoneInformation(tzi)
dwBias = tzi.Bias + tzi.StandardBias
tmp = CStr(dwBias \ 60) & " hours, " & CStr(dwBias Mod 60) & " minutes"
GetStandardTimeBias = tmp
End Function
Private Function GetCurrentTimeBias() As String
Dim tzi As TIME_ZONE_INFORMATION
Dim dwBias As Long
Dim tmp As String
Select Case GetTimeZoneInformation(tzi)
Case TIME_ZONE_ID_DAYLIGHT
dwBias = tzi.Bias + tzi.DaylightBias
Case Else
dwBias = tzi.Bias + tzi.StandardBias
End Select
tmp = CStr(dwBias \ 60) & " hours, " & CStr(dwBias Mod 60) & " minutes"
GetCurrentTimeBias = tmp
End Function
Private Function GetCurrentGMTDate() As String
Dim tzi As TIME_ZONE_INFORMATION
Dim gmt As Date
Dim dwBias As Long
Dim tmp As String
Select Case GetTimeZoneInformation(tzi)
Case TIME_ZONE_ID_DAYLIGHT
dwBias = tzi.Bias + tzi.DaylightBias
Case Else
dwBias = tzi.Bias + tzi.StandardBias
End Select
gmt = DateAdd("n", dwBias, Now)
tmp = Format$(gmt, "dddd mmm dd, yyyy hh:mm:ss am/pm")
GetCurrentGMTDate = tmp
End Function
Private Function GetCurrentTimeZone() As String
Dim tzi As TIME_ZONE_INFORMATION
Dim tmp As String
Select Case GetTimeZoneInformation(tzi)
Case 0: tmp = "Cannot determine current time zone"
Case 1: tmp = tzi.StandardName
Case 2: tmp = tzi.DaylightName
End Select
GetCurrentTimeZone = TrimNull(tmp)
End Function
Private Function TrimNull(item As String)
Dim pos As Integer
'double check that there is a chr$(0) in the string
pos = InStr(item, Chr$(0))
If pos Then
TrimNull = Left$(item, pos - 1)
Else
TrimNull = item
End If
End Function
鄂公网安备 42050402000038号 )
