Tweet
SUB UTCtoSystemTime(BYVAL t AS DWORD,st AS SYSTEMTIME)
LOCAL b AS BYTE PTR
LOCAL utc AS QUAD
LOCAL lt AS QUAD
utc=(t* 10000000) + 116444736000000000
FileTimeToLocalFileTime BYVAL VARPTR(utc), BYVAL VARPTR(lt)
FileTimeToSystemTime BYVAL VARPTR(lt), st
END SUB
FUNCTION utcConvert(BYVAL utc AS DWORD) AS STRING
LOCAL syst AS SYSTEMTIME
LOCAL dt$
LOCAL h$
UTCtoSystemTime utc, syst
dt$= FORMAT$(syst.wmonth,"##")+"/"+FORMAT$(syst.wday,"##")+"/"+FORMAT$(syst.wyear,"####")
REPLACE " " WITH "0" IN dt$
h$=FORMAT$(syst.whour,"##")+":"+FORMAT$(syst.wminute,"##")+":"+FORMAT$(syst.wsecond,"##")
REPLACE " " WITH "0" IN h$
FUNCTION = dt$+"/"+h$
END FUNCTION
Function FileDateTime(ft As FileTime) As String Local st As SystemTime Local zText As Asciiz * 255 Local Temp As String ' -- Convert the file time from UTC to local time FileTimeToLocalFileTime ft, ft ' -- Convert the file time into a compatible system time FileTimeToSystemTime ft, st ' -- Create a date string using the local settings GetDateFormat %LOCALE_USER_DEFAULT, %DATE_SHORTDATE, st, ByVal %NULL, zText, 255 Temp = zText ' -- Create a time string using the local settings GetTimeFormat %LOCALE_USER_DEFAULT, %TIME_NOSECONDS, st, ByVal %NULL, zText, 255 ' -- Return the file date and time Function = Temp + " " + zText End Function
If IsTrue SetTimePrivilege Then
Result = SendMessage(%HWND_BROADCAST, %WM_TIMECHANGE, 0, 0)
Result = SetSystemTime(st)
End if
'-----------------------------------------------------------------------------------
Function CheckAtomicTime(lserv As String,wPort As Long,aTimeOut As Long,Delay As Double, st As SYSTEMTIME) Export As String
Local buffer As String
Local lpbuf As String
Local UTCTime As String
Local vbdate As Double
Dim Start As Dword
Dim Stopp As Dword
Dim QT As QuadFILETIME
lserv = Extract$(Ltrim$(lserv), Any " (")
'51468 99-10-17 05:12:27 15 0 0 888.6 UTC(NIST) *
'Record your starttime In milliseconds
Start = TimeGetTime()
Tcp Open Port wPort At lserv As #1 TIMEOUT aTimeOut
Do
Tcp Recv #1, 1600, buffer
lpbuf = lpbuf + buffer
Loop While Len(buffer)
Tcp Close #1
lpbuf = Trim$(lpbuf, $LF)
Replace $LF With $CRLF In lpbuf
UTCTime = Trim$(lpbuf, $LF)
Function = UTCTime
Delay = TimeGetTime - Delay
vbDate = StrToVbDate(Parse$(UTCTime, Any " ",2) + " " + Parse$(UTCTime, Any " ",3))
VariantTimeToSystemTime vbDate, st
Stopp = TimeGetTime()
'Convert your Atomic time into a SYSTEMTIME structure ST
'FILETIME returns 100's of NANOSECONDS so you have to adjust
'Delay To reflect this resulotion
Delay = (Stopp - Start)* 10000
'convert your Atomic time In ST To FileTime In QT
SystemTimeToFileTime ST,QT
'Now Add the delay To the Quad-element that overlay the FILETIME-struct
QT.qdTime = QT.qdTime + Delay
'Convert back To SYSTEMTIME
FileTimeToSystemTime QT,ST
Delay = Delay\10000
End Function
'-----------------------------------------------------------------------------------
Function RFC868Time()Export As Dword
Local VarTime As Double
Local st As SYSTEMTIME
Local hh&, mm&, ss&
GetSystemTime st 'GMT Time!
hh& = st.wHour * 3600
st.wHour = 0
mm& = st.wMinute * 60
st.wMinute = 0
ss& = st.wSecond
st.wSecond = 0
SystemTimeToVariantTime st,VarPtr(VarTime)
Function = (Int(VarTime)-2) * 86400 + HH& + MM& + SS&
End Function
'-----------------------------------------------------------------------------------
Sub RFC868toSystemTime(ByVal t As Dword, st As SYSTEMTIME) Export
'b = Return From Port 37 time server
'receive the time as a 32 bit binary number
'To use: RFC868toSystemTime CVDWD(b), st
Local b As Byte Ptr
Local utc As Quad
Local lt As Quad
' Gotta reverse the bytes for the internet
b = VarPtr(t)
Swap @b[0], @b[3]
Swap @b[1], @b[2]
utc = t
utc = (utc * 10000 * 1000) + (94354848 * 100000 * 10000)
FileTimeToLocalFileTime ByVal VarPtr(utc), ByVal VarPtr(lt)
FileTimeToSystemTime ByVal VarPtr(lt), st
End Sub
'-----------------------------------------------------------------------------------
'"Wed, 13 Oct 1999 15:07:52 -0700"
'The "-0700" is the offset From GMT (seven hours In this Case).
Function InetTime() Export As String
Local tz As TIME_ZONE_INFORMATION
Local d As Asciiz * 64
Local t As Asciiz * 64
Local z As String
GetDateFormat %LOCALE_USER_DEFAULT, %NULL, ByVal %NULL, "ddd',' d MMM yyyy", d, 64
GetTimeFormat %LOCALE_USER_DEFAULT, %NULL, ByVal %NULL, "HH':'mm':'ss", t, 64
GetTimeZoneInformation tz
If tz.bias < 0 Then
tz.bias = Abs(tz.bias)
z = ""
Else
z = "-"
End If
tz.bias = (tz.bias \ 60) * 100 + (tz.bias Mod 60)
z = z & Format$(tz.bias, "0000")
Function = d & " " & t & " " & z
End Function
'===================================<Time Conversion Functions to SYSTEMTIME>==================
Function uString(ByVal x As String)Export As String
Local y As String
Local n As Integer
If Len(x) Then
For n = 1 To Len(x)
y = y + Mki$(Asc(x, n))
Next n
End If
Function = y
End Function
'------------------------------------------------------------------------------
Function StrToVbDate(ByVal dt As String) Export As Double
Local x As Long
Local y As String
Local vbdate As Double
dt = uString(dt)
If IsFalse(VarDateFromStr(ByVal StrPtr(dt), 0, 0, vbdate)) Then
Function = vbdate
End If
End Function
'-----------------------------------------------------------------------------------
Function VbDateToStr(ByVal vbdate As Double) Export As String
Local d As Asciiz * 64
Local dt As String
Local st As SYSTEMTIME
Local tDay As Asciiz * 64
Local tTime As Asciiz * 64
VariantTimeToSystemTime vbdate, st
GetDateFormat %LOCALE_USER_DEFAULT,%DATE_SHORTDATE, st, ByVal %NULL, tDay, 64
GetTimeFormat %LOCALE_USER_DEFAULT, %TIME_FORCE24HOURFORMAT,st, ByVal %NULL, tTime, 64
Function = tDay + " " + tTime
End Function
'-----------------------------------------------------------------------------------
'Under NT you will need to adjust the time
Function SetTimePrivilege() Export As Long
Local hdlProcessHandle As Long
Local hToken As Long
Local tmpLuid As LUID
Local tp As TOKEN_PRIVILEGES
Local tpNewButIgnored As TOKEN_PRIVILEGES
Local BufferLength As Long
Local lBufferNeeded As Long
%TOKEN_ADJUST_PRIVILEGES = &H20
%TOKEN_QUERY = &H8
%SE_PRIVILEGE_ENABLED = &H2
hdlProcessHandle = GetCurrentProcess()
OpenProcessToken hdlProcessHandle, (%TOKEN_ADJUST_PRIVILEGES Or %TOKEN_QUERY), hToken
' Get the LUID for setSystemTime privilege.
LookupPrivilegeValue "", "SeSystemtimePrivilege",tmpLuid
tp.PrivilegeCount = 1
' One privilege to set
tp.Privileges(1).pLuid = tmpLuid
tp.Privileges(1).Attributes=%SE_PRIVILEGE_ENABLED
' Enable the SetSystemTime privilege in the access token of this process.
BufferLength = SizeOf(tpNewButIgnored)
Function= AdjustTokenPrivileges( ByVal hToken,ByVal 0,tp,ByVal BufferLength ,tpNewButIgnored,lBufferNeeded)
End Function
'-----------------
Comment