从远程NT服务器中读取日期和时间

发表于:2007-07-14来源:作者:点击数: 标签:
[程序语言] Microsoft Visual Basic 4.0,5.0,6.0 [运行平台] WINDOWS [源码来源] http://codeguru.developer.com/vb/articles/1915.shtml [功能描述] 该程序正常执行后,将返回日期和时间值。而如果NetRemoteTOD API调用失败,则显示出错信息。 它将包含所有
[程序语言] Microsoft Visual Basic 4.0,5.0,6.0

[运行平台] 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.ltesting.net