[運行平臺] WINDOWS
[源碼來源] http://codeguru.developer.com/vb/articles/1915.shtml
[功能描述]
該程序正常執行后，將返回日期和時間值。而如果NetRemoteTOD API調用失敗，則顯示出錯信息。
它將包含所有的時區信息。把下列代碼加入到標準的BAS模塊中。
option Explicit
'
'
private Declare Function NetRemoteTOD Lib "Netapi32.dll" ( _
tServer as Any, pBuffer as Long) 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 TIME_ZONE_INFORMATION
Bias as Long
StandardName(32) as Integer
StandardDate as SYSTEMTIME
StandardBias as Long
DaylightName(32) as Integer
DaylightDate as SYSTEMTIME
DaylightBias as Long
End Type
'
private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation as TIME_ZONE_INFORMATION) as Long
'
private Declare Function NetApiBufferFree Lib "Netapi32.dll" (byval lpBuffer as Long) as Long
'
private Type TIME_OF_DAY_INFO
tod_elapsedt as Long
tod_msecs as Long
tod_hours as Long
tod_mins as Long
tod_secs as Long
tod_hunds as Long
tod_timezone as Long
tod_tinterval as Long
tod_day as Long
tod_month as Long
tod_year as Long
tod_weekday as Long
End Type
'
private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination as Any, Source as Any, byval Length as Long)
'
'
public Function getRemoteTOD(byval strServer as string) as date
'
Dim result as date
Dim lRet as Long
Dim tod as TIME_OF_DAY_INFO
Dim lpbuff as Long
Dim tServer() as Byte
'
tServer = strServer & vbNullChar
lRet = NetRemoteTOD(tServer(0), lpbuff)
'
If lRet = 0 then
CopyMemory tod, byval lpbuff, len(tod)
NetApiBufferFree lpbuff
result = DateSerial(tod.tod_year, tod.tod_month, tod.tod_day) + _
TimeSerial(tod.tod_hours, tod.tod_mins - tod.tod_timezone, tod.tod_secs)
getRemoteTOD = result
else
Err.Raise Number:=vbObjectError + 1001, _
Description:="cannot get remote TOD"
End If
'
End Function
要運行該程序，通過如下方式調用。
private Sub Command1_Click()
Dim d as date
'
d = GetRemoteTOD("your NT server name goes here")
MsgBox d
End Sub
延伸閱讀
文章來源于領測軟件測試網 http://www.kjueaiud.com/
