Модераторы: marykone
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Получаем время с удалённого NT Сервера. 
:(
    Опции темы
Azbuka
Дата 7.5.2007, 15:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 55
Регистрация: 20.9.2005

Репутация: нет
Всего: 2



Здесь представлен небольшой пример, возвращающий 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


Автор: Lothar Haensler
http://sources.ru
PM   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Сетевые технологии | Следующая тема »


 




[ Время генерации скрипта: 0.0911 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.