Получаем время с удаленного NT Сервера

Получаем время с удаленного NT Сервера

Информационные технологии » Сетевые технологии » Получаем время с удаленного NT Сервера
Здесь представлен небольшой пример, возвращающий VB Date. Данный код возвращает всю информацию о часовом поясе.

Поместите следующий код в стандартный модуль 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("здесь нужно задать имя NT сервера")

MsgBox d

End Sub




http://www.sources.ru/ http://www.sources.ru/

Отзывы (через аккаунты в социальных сетях Вконтакте, Facebook или Google+):

Оставить отзыв с помощью аккаунта ВКонтакте:

Оставить отзыв с помощью аккаунта FaceBook:

Оставить отзыв с помощью аккаунта Google+: