net time \\exchange1
Tweet
FUNCTION SetNetTime(BYVAL MServ$) EXPORT AS LONG
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' This small function adjusts the local machine time to
' one that the user selects, usually the server.
' If the server's name is known, skip the inputbox$ command
' Names it can use:
' \\acer500
' \\Tower 800 *note* the space in the name
' \\tower 800 *note* Caps not required.
'It uses NET.EXE
'In DOS go to c:\Windows and type: NET /? for additional information
'tested on: Win Me
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
LOCAL RetVal AS LONG
LOCAL NetName$, Ans$
Ans$ = MServ$
IF MServ$ = "" THEN
Ans$ = INPUTBOX$("I will reset this local machine's time to your main computer." & _
$CRLF & "What is your main computer's network name?" & $CRLF & $CRLF & _
"(e.g. \\Big Guy)", "Bare Point Systems")
END IF
IF Ans$ = "" THEN EXIT FUNCTION
NetName$ = "NET TIME """ + Ans$ + """ /SET /YES"
RetVal = SHELL(NetName$, 0)
END FUNCTION
#COMPILE EXE
#INCLUDE "wsock32.inc"
FUNCTION PBMAIN() AS LONG
hUdp& = FREEFILE
UDP OPEN PORT 7 AS hUdp&
DIM Greg AS ASCIIZ * 100
HOST ADDR "24.178.89.211" TO ip&
DO
UDP SEND hUdp&, AT ip&, 7, "Yoga"
PRINT "cycle"
LOOP
CLOSE hUdp&
END FUNCTION
#COMPILE EXE
FUNCTION PBMAIN() AS LONG
hupd& = FREEFILE
UDP OPEN AS hupd&
PRINT "."
DO
UDP RECV hupd&, FROM ipvar&, ipport&, buffer$
PRINT ".";Buffer$
LOOP
END FUNCTION
UDP RECV Syntax UDP RECV fnum&, FROM ipvar&, pnumvar&, buffer$ Remarks Receive any bytes from the fnum& UDP port and place them in buffer$. The IP address that sent the packet is placed into the ipvar& variable along with the port number destination in the pnumvar& variable. If a time-out occurred, an error 24 (Device Timeout) is generated.
'Function CheckAtomicTime
'This function takes a server and checks the Atomic clock on Port wPort.
'Network delays are calculated here, but also returned for display.
'aTimeout is in milliseconds, so for 30 seconds use 30000
'A SYSTEMTIME structure is also returned.
'The function returns a string containing the time in NIST format.
'-----------------------------------------------------------------------------------
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
Dim Pc As Long
Pc& = SetPriorityClass(GetCurrentProcess(), %HIGH_PRIORITY_CLASS)
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 #hTcp TIMEOUT aTimeOut
Do
Tcp Recv #hTcp, 1600, buffer
lpbuf = lpbuf + buffer
Loop While Len(buffer)
Tcp Close #hTcp
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
'NIST TIME SERVER (Nuclear)
'51468 99-10-17 05:12:27 15 0 0 888.6 UTC(NIST) *
If Right$(UTCTime,2) = "* " Then
Local UTCDate As String
Local UTCTimeOnly As String
UTCDate = Parse$(UTCTime, Any " ",2)
UTCTimeOnly = Parse$(UTCTime, Any " ",3)
' Convert date and time to a SYSTEMTIME structure using a date VARIANT
vbDate = StrToVbDate(UTCDate + " " + UTCTimeOnly)
VariantTimeToSystemTime vbDate, st
ElseIf Len(UTCTime) = 5 Then
RFC868toSystemTime CvDwd(UTCTime), st
'ElseIf
'Internet Time Server
'"Wed, 13 Oct 1999 15:07:52 -0700"
ElseIf Len(UTCTime) < 2 Then
Function = Date$ + " DEBUG:"
Exit Function
End If
'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) - 50000 'subtract 50ms NIST network delay
'Convert back To SYSTEMTIME
FileTimeToSystemTime QT,ST
Delay = Delay \ 10000
End Function
'-----------------------------------------------------------------------------------
'
'
'
'
'
'
'
'====================================================================================================================================
'Function STtoNISTTime(st As SYSTEMTIME)
'Converts a SYSTEMTIME structure to a String structure
'in the format of an NIST Time Server per Daytime Protocol (RFC-867)
'It is approximately 99% accurate in comparison to a real NIST server
'All functions below this function support this function and are required.
'Copyright (c) 2000 Computer Creations Software
'Status - Freeware, modify at your use
'-----------------------------------------------------------------------------
'JJJJJ YR-MO-DA HH:MM:SS TT L H msADV UTC(NIST) OTM
'where:
'JJJJJ is the Modified Julian Date (MJD). The MJD is the last five digits of the Julian Date, which is simply a count of the number of days since January 1, 4713 B.C. To get the Julian Date, add 2.4 million to the MJD.
'YR-MO-DA is the date. It shows the last two digits of the year, the month, And the current day of month.
'HH:MM:SS is the time In hours, minutes, And seconds. The time is always sent As Coordinated Universal Time (UTC).
'An offset needs To be applied To UTC To obtain Local time.
'For example, Mountain Time In the U. S. is 7 hours behind UTC during Standard Time, And 6 hours behind UTC during Daylight Saving Time.
'TT is a two digit code (00 To 99) that indicates whether the United States is On Standard Time (ST) Or Daylight Saving Time (DST).
'It also indicates when ST Or DST is approaching. This code is Set To 00 when ST is In effect, Or To 50 when DST is In
'effect. During the month In which the time change actually occurs, this number will decrement every day Until the change occurs.
'For example, during the month of October, the U.S. changes From DST To ST. On October 1, the number will change From 50 To
'the actual number of days Until the time change.
'It will decrement by 1 every day Until the change occurs At 2 a.m. Local time when the value is 1. Likewise,
'the spring change is At 2 a.m. Local time when the value reaches 51.
'L is a one-digit code that indicates whether a leap second will be added Or subtracted At midnight On the last day of the current month.
'If the code is 0, no leap second will occur this month. If the code is 1, a positive leap second will be added At
'the End of the month. This means that the last minute of the month will contain 61 seconds instead of 60. If the code is 2,
'a second will be deleted On the last day of the month. Leap seconds occur At a rate of about one per year. They are used To
'correct For irregularity In the earth's rotation. The correction is made just before midnight UTC (not local time).
'H is a health digit that indicates the health of the server. If H=0, the Server is healthly. If H=1, Then the Server is operating
'properly but its time may be In Error by Up To 5 seconds. This State should change To fully healthy within 10 minutes. If
'H=2, Then the Server is operating properly but its time is known To be wrong by more than 5 seconds. If H=3, Then a
'hardware Or software failure has occurred And the amount of the time Error is unknown.
'msADV displays the number of milliseconds that NIST advances the time code To partially compensate For network delays.
'The advance is currently Set To 50.0 milliseconds.
'The Label UTC(NIST) is contained In every time code. It indicates that you are receiving Coordinated Universal Time (UTC)
'From the National Institute of Standards And Technology (NIST).
'OTM (On-time marker) is an asterisk (*). The time values sent by the time code refer To the arrival time of the OTM.
'In other words, If the time code says it is 12:45:45, this means it is 12:45:45 when the OTM arrives.
'==============================================================================
Function STtoNISTTime(UseLeapSecond As Long, PingTime As Double)Export As String
Local lt As SYSTEMTIME
Local tzInfo As TIME_ZONE_INFORMATION
Local D1 As Asciiz * 64
Local op As String 'OutPut
Local d As String 'dash -Repetitively used, make a string
Local sp As String 'Space
Local c As String 'Colon
Local z As String 'Zero
Local lTmp As Long
Local ltSecs As Long 'Adjustment in seconds that were made
Local tzResult As Long
Dim Pc As Long
Pc& = SetPriorityClass(GetCurrentProcess(), %HIGH_PRIORITY_CLASS)
%ADVANCE_TIME_FOR_NETWORKDELAY = 50 'nano seconds for the QuadTime
d = "-"
sp = " "
c = ":"
z = "0"
GetSystemTime lt 'GMT Time
GetDateFormat %LOCALE_USER_DEFAULT, %NULL, ByVal %NULL, "MMddyyyy", D1, 64
'Modified Julian Date
op = Ltrim$(Str$(ModifiedJulianDate(Val(D1)))) + " " '51468
'51468 99-10-17 05:12:27 15 0 0 888.6 UTC(NIST) *
'Do Date in YY-MM-DD Format
op = Op + Right$(Format$(lt.wyear,"00"),2) + d
Op = Op + Format$(lt.wmonth,"00") + d
Op = Op + Format$(lt.wday,"00") + sp
'Do Time in HH:MM:SS time format
Op = Op + Format$(lt.whour,"00") + c
Op = Op + Format$(lt.wminute,"00") + c
Op = Op + Format$(lt.wsecond,"00")
tzResult = GetTimeZoneInformation(tzinfo)
Select Case tzResult
Case %TIME_ZONE_ID_DAYLIGHT
If lt.wmonth = %October And lt.wDay < DateOfLastSundayOfOctober(lt.wYear) Then
Op = Op + sp + Format$(DateOfLastSundayOfOctober(lt.wyear) - lt.wday,"00")
Else
Op = Op + sp + "50"
End If
Case %TIME_ZONE_ID_UNKNOWN, %TIME_ZONE_ID_INVALID
Op = Op + sp + "00" + sp
Case %TIME_ZONE_ID_STANDARD
'Now how long until DST if in APRIL
If lt.wMonth = %April And lt.wday < DateofFirstSundayOfApril(lt.wYear) Then
Op = Op + sp + Format$(DateofFirstSundayOfApril(lt.wYear) - lt.wDay,"00")
Else
Op = Op + sp + "00"
End If
End Select
'
'If Adjust Leap Second is true Then
'Op = Op + sp + "1" + sp
'Else 'This code is not yet complete..
Op = Op + sp + Trim$(Str$(UseLeapSecond))
'Do server health now, as a PC time MAY be off by 5 seconds, you MUST use a 1
Op = Op + sp' + Trim$(Str$(GetHealthOfServer))
'Now add 50 millisecond network delay and calculate time based on that
If PingTime = 0 Then PingTime = %ADVANCE_TIME_FOR_NETWORKDELAY
Op = Op + sp + Format$(PingTime,"000.0")
Op = Op + " UTC(NIST) *"
Function = Op
End Function
'==============================================================================
'**********************************************************************************************************
'JJJJJ is the Modified Julian Date (MJD).
'The MJD is the last five digits of the Julian Date, which is the number of days since January 1, 4713 B.C.
'To Get the Julian Date, Add 2.4 million To the MJD.
'Scott Turchin - Modified CalDateToJulian function
'**********************************************************************************************************
Function ModifiedJulianDate(ByVal CalDate As Dword ) Export As Long
Dim Year As Dword
Dim Day As Dword
Dim Month As Dword
Dim Gregorian As Dword
Dim JulYear As Long
Dim JulMonth As Long
Dim Adjust As Long
Dim JDate As Long
Gregorian = 588829
Year = (((CalDate / 10000 ) - Int( CalDate / 10000 ) ) * 10000 )
Day = ((( Int( CalDate / 10000 ) / 100 ) - Int( Int( CalDate / 10000 ) / 100 ) ) * 100 )
Month = Int( Int( CalDate / 10000 ) / 100 )
If ( Year = 0 ) Then
Function = 0
Exit Function
End If
If ( Year < 0 ) Then Year = Year + 1
If ( Month > 2 ) Then
JulYear = Year
JulMonth = Month + 1
Else
JulYear = Year - 1
JulMonth = Month + 13
End If
JDate = ( Int( 365.25 * JulYear ) + Int( 30.6001 * JulMonth ) + Day + 1720995 )
If ( Day + ( 31 * ( Month + ( 12 * Year ) ) ) ) >= Gregorian Then
Adjust = Int( 0.01 * JulYear )
JDate = ( JDate + 2 - Adjust + Int( 0.25 * Adjust ) )
End If
Function = JDate - 2400000.5
End Function
'************************************************************************
'************************************************************************************
'Function IncrSYSTEMTIME increments the SYSTEMTIME structure by IncrValue milliseconds
'************************************************************************************
Function IncrSYSTEMTIME(st As SYSTEMTIME, ByVal IncrValue As Long)Export As Long
Dim QT As QuadFILETIME
'FILETIME returns 100's of NANOSECONDS so you have to adjust
IncrValue = IncrValue * 10000
'Convert to QUAD time
SystemTimeToFileTime ST,QT
'Now Add the delay To the Quad-element that overlay the FILETIME-struct
QT.qdTime = QT.qdTime + IncrValue
'Convert back To SYSTEMTIME
FileTimeToSystemTime QT,ST
IncrValue = IncrValue \ 10000
End Function
'************************************************************************************
'************************************************************************************
'Function IncrSYSTEMTIME increments the SYSTEMTIME structure by IncrValue milliseconds
'************************************************************************************
Function DecrSYSTEMTIME(st As SYSTEMTIME, ByVal IncrValue As Long)Export As Long
Dim QT As QuadFILETIME
'FILETIME returns 100's of NANOSECONDS so you have to adjust
IncrValue = IncrValue * 10000
'Convert to QUAD time
SystemTimeToFileTime ST,QT
'Now Add the delay To the Quad-element that overlay the FILETIME-struct
QT.qdTime = QT.qdTime + IncrValue
'Convert back To SYSTEMTIME
FileTimeToSystemTime QT,ST
IncrValue = IncrValue \ 10000
End Function
'------------------------------------------------------------------------------
Function SetPCTime(st As SYSTEMTIME,osinfo As OSVERSIONINFO)Export As String
Local bc As SYSTEMTIME 'Buffer BEFORE CHANGE
Local ac As SYSTEMTIME 'Compare to AFTER CHANGE
Local l_Result As Long
Local TdSt As String
Local TmpSt As String
Local Year As String
Local Month As String
Local Day As String
Local Hour As String
Local Minute As String
Local Second As String
Local s As String
Year = " Year"
Month = " Month"
Day = " Day"
Hour = " Hour"
Minute = " Minute"
Second = " Second"
s = "s"
'Verify we are running on Windows Server
osinfo.dwOsVersionInfoSize = SizeOf(osinfo)
GetVersionEx osinfo
GetLocalTime bc 'BEFORE CHANGE
If osinfo.dwPlatformId = %VER_PLATFORM_WIN32_NT Then
' Verify We're running Windows NT, adjust the process' token so that we can Set the time
If IsTrue SetTimePrivilege Then
l_Result = SendMessage(%HWND_BROADCAST, %WM_TIMECHANGE, 0, 0)
l_Result = SetSystemTime(st)
' Use this for troubleshooting format only
' Control Set Text hDlg, %PCTIME,FormatOutPut(1) 'After adjustment
Else
Function = GetLastErrorDescription(GetLastError(),0)
Exit Function
End If
Else
l_Result = SendMessage(%HWND_BROADCAST, %WM_TIMECHANGE, 0, 0)
l_Result = SetSystemTime(st)
End If
If IsFalse l_Result Then
Function = GetLastErrorDescription(GetLastError(),0)
Exit Function
End If
GetLocalTime ac
'Use this code to display the time difference:
st.wmilliseconds = st.wmilliseconds - 50 'Take out the 50 ms that NIST puts in for network delay
ac.wyear = Abs(bc.wyear - ac.wyear)
ac.wmonth = Abs(bc.wmonth - ac.wmonth)
ac.wday = Abs(bc.wday - ac.wday)
ac.wHour = Abs(bc.whour - ac.whour)
ac.wMinute = Abs(bc.wMinute - ac.wminute)
ac.wsecond = Abs(bc.wsecond - ac.wsecond)
If ac.wyear <> 1 Then Year = Year + s
If ac.wmonth <> 1 Then Month = Month + s
If ac.wday <> 1 Then Day = Day + s
If ac.wHour <> 1 Then Hour = Hour + s
If ac.wMinute <> 1 Then Minute = Minute + s
If ac.wsecond <> 1 Then Second = Second + s
TdSt = Trim$(Str$(ac.wyear)) + Year + " " + Trim$(Str$(ac.wmonth)) + Month + " " + Trim$(Str$(ac.wday)) + Day + " " +_
Trim$(Str$(ac.whour)) + Hour + " " + Trim$(Str$(ac.wminute)) + Minute + " " + Trim$(Str$(ac.wsecond)) + Second + " "
Function = TdSt
End Function
'
'
'
'
'
'
'
'
Function DayOfTheWeek() Export As String
'// get date format in "dddd, MMMM dd, yyyy"
'// e.g. Monday, June 26, 2000
Local uTime As SYSTEMTIME
Local lNum As Long
Local saDay As Asciiz * 64
Local saMonth As Asciiz * 64
GetLocalTime uTime
If uTime.wDayOfWeek = 0 Then
' this is Sunday, work out separately
lNum = &H30
Else
lNum = &H2A + (uTime.wDayOfWeek) -1
End If
GetLocaleInfo %LOCALE_USER_DEFAULT, lNum, saDay, SizeOf(saDay)
lNum = &H38 + (uTime.wMonth - 1)
GetLocaleInfo %LOCALE_USER_DEFAULT, lNum, saMonth, SizeOf(saMonth)
Function = Trim$(saDay)' & ", " & saMonth & " " & Trim$(Str$(uTime.wDay)) & ", " & Trim$(Str$(uTime.wYear)))
End Function
'------------------------------------------------------------------------------------------
Function GetPCTime(TimeFormat As Long,tzInfo As TIME_ZONE_INFORMATION) Export As String
Local sTime As SYSTEMTIME
Local tTime As Asciiz * 64
Local LocalTimeFormat As Asciiz * 64
LocalTimeFormat = "hh':'mm tt"
'If TimeFormat = 0 Then TimeFormat = %TIME_NOSECONDS
GetLocalTime sTime
'GetTimeFormat, 0, %TIME_NOSECONDS , LocalTimeFormat,LocalTimeFormat
GetTimeFormat 0,TimeFormat,sTime,LocalTimeFormat, tTime, 64
'GetTimeFormat %LOCALE_SYSTEM_DEFAULT,TimeFormat,sTime, ByVal %NULL, tTime, 64
GetTimeZoneInformation tzInfo
Function = tTime
End Function
'-----------------------------------------------------------------------------------
Function GetPCDate(DateFormat As Long,tzInfo As TIME_ZONE_INFORMATION) Export As String
Local sTime As SYSTEMTIME
Local tDay As Asciiz * 64
Local LocalDateFormat As Asciiz * 64
If DateFormat = 0 Then DateFormat = %DATE_LONGDATE
GetLocalTime sTime
LocalDateFormat = "dddd',' MMMM dd'ø' yyyy"
GetDateFormat 0,0,sTime,LocalDateFormat, tDay, 64
'GetDateFormat %LOCALE_USER_DEFAULT,DateFormat, sTime, ByVal %NULL, tDay, 64
'GetDateFormat %LOCALE_SYSTEM_DEFAULT,DateFormat, sTime, ByVal %NULL, tDay, 64
GetTimeZoneInformation tzInfo
Function = tDay
End Function
'-----------------------------------------------------------------------------------
Function GetPCTimeandDate(DateFormat As Long, TimeFormat As Long, Separator As String,tzInfo As TIME_ZONE_INFORMATION) Export As String
Local stime As SYSTEMTIME
Local tDay As Asciiz * 64
Local tTime As Asciiz * 64
If Separator = "" Then Separator = " "
If DateFormat = 0 Then DateFormat = %DATE_SHORTDATE
If TimeFormat = 0 Then TimeFormat = %TIME_FORCE24HOURFORMAT
GetLocalTime sTime
GetDateFormat %LOCALE_SYSTEM_DEFAULT,DateFormat, sTime, ByVal %NULL, tDay, 64
GetTimeFormat %LOCALE_SYSTEM_DEFAULT, TimeFormat,sTime, ByVal %NULL, tTime, 64
GetTimeZoneInformation tzInfo
Function = tDay & Separator & tTime
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
Local lResult As Long
Local stDay As String
Local styear As String
' 01-01-21
stday = Mid$(dt,4,2)
stYear = Mid$(dt,7,2)
Mid$(dt,7,2) = stday
Mid$(dt,4,2) = styear
dt = uString(dt)
' If IsFalse(VarDateFromStr(ByVal StrPtr(dt), %LOCALE_USER_DEFAULT, %LOCALE_NOUSEROVERRIDE, vbdate)) Then
lResult = VarDateFromStr(ByVal StrPtr(dt),0, 0, vbdate)
Select Case lResult
Case %FALSE
Function = vbdate
Case %DISP_E_TYPEMISMATCH 'Can't convert string to date, set 0 and invalidate
Function = 0
Case %DISP_E_OVERFLOW
Function = -1
Case %E_OUTOFMEMORY 'Throw exception here
Function = %FALSE
End Select
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 this 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
'-----------------------------------------------------------------------------------
Function TimeStamp() Export As String
Local tTime As Asciiz * 64
Local st As SYSTEMTIME
GetLocalTime st
GetTimeFormat %LOCALE_USER_DEFAULT,%TIME_FORCE24HOURFORMAT ,st, ByVal %NULL, tTime, 64
Function = Trim$(Str$(st.wyear)) + _
Format$(st.wMonth,"00") + _
Format$(st.wDay,"00") + "-" + _
Format$(st.wHour,"00") + _
Format$(st.wMinute,"00") + _
Format$(st.wSecond,"00") + "." + _
Format$(st.wMilliseconds, "000")
End Function
'-----------------------------------------------------------------------------------
Comment