'***************************************************************************
Private Const MAX_COMPUTERNAME_LENGTH As Long = 31
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Const NERR_SUCCESS = 0&
Private Const TIME_ZONE_ID_DAYLIGHT As Long = 2
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 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 NetRemoteTOD Lib "Netapi32" _
(UncServerName As Byte, _
BufferPtr As Long) As Long
Private Declare Function NetApiBufferFree Lib "Netapi32" _
(ByVal lpBuffer As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pTo As Any, uFrom As Any, _
ByVal lSize As Long)
Private Declare Function GetTimeZoneInformation Lib "kernel32" _
(lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Private Declare Function SystemTimeToTzSpecificLocalTime Lib "kernel32" _
(lpTimeZoneInformation As TIME_ZONE_INFORMATION, _
lpUniversalTime As SYSTEMTIME, _
lpLocalTime As SYSTEMTIME) As Long
Function GetDateTimeServer(Server As String) As String
Dim server_date As TIME_OF_DAY_INFO
Dim sServer As String, NewTime As String
server_date = GetRemoteTOD("\\" & Server)
NewTime = DateAdd("s", server_date.tod_elapsedt, #1/1/1970#)
NewTime = DateAdd("n", -server_date.tod_timezone, NewTime)
GetDateTimeServer = NewTime
'DisplayData server_date
End Function
Private Function GetRemoteTOD(ByVal sServer As String) As TIME_OF_DAY_INFO
Dim success As Long
Dim bServer() As Byte
Dim tod As TIME_OF_DAY_INFO
Dim systime_utc As SYSTEMTIME
Dim systime_local As SYSTEMTIME
Dim tzi As TIME_ZONE_INFORMATION
Dim bufptr As Long
If sServer <> vbNullChar Then
If Left$(sServer, 2) <> "\\" Then
bServer = "\\" & sServer & vbNullChar
Else: bServer = sServer & vbNullChar
End If
Else
bServer = sServer & vbNullChar
End If
If NetRemoteTOD(bServer(0), bufptr) = NERR_SUCCESS Then
CopyMemory tod, ByVal bufptr, LenB(tod)
Call GetTimeZoneInformation(tzi)
With systime_utc
.wDay = tod.tod_day
.wDayOfWeek = tod.tod_weekday
.wMonth = tod.tod_month
.wYear = tod.tod_year
.wHour = tod.tod_hours
.wMinute = tod.tod_mins
.wSecond = tod.tod_secs
End With
Call SystemTimeToTzSpecificLocalTime(tzi, systime_utc, systime_local)
With tod
.tod_mins = systime_local.wMinute
.tod_hours = systime_local.wHour
.tod_secs = systime_local.wSecond
.tod_day = systime_local.wDay
.tod_month = systime_local.wMonth
.tod_year = systime_local.wYear
.tod_weekday = systime_local.wDayOfWeek
End With
End If
Call NetApiBufferFree(bufptr)
GetRemoteTOD = tod
End Function
Function GetCom() As String ' untuk mendaptakan nama komputer lokal
Dim dwLen As Long
Dim strString As String
dwLen = MAX_COMPUTERNAME_LENGTH + 1
strString = String(dwLen, "X")
GetComputerName strString, dwLen
strString = Left(strString, dwLen)
GetCom = strString
End Function
Private Sub Form_Load()
MsgBox GetDateTimeServer("ekoaja") ' bisa diganti sesuai dengan nama/ip komputer server
End Sub
Subscribe to email feed
