Announcement

Collapse
No announcement yet.

Programmical emulate NET TIME

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Gregery D Engle
    replied
    Scott,

    Thanks for the source. But I'm beyound that now.

    Lance,

    Picture this:

    1 PB/CC UDP Server/Client that sends out events at a
    given time

    10 or more Visual Basic Apps that receive information from the
    Server and then send some information back such as Current
    User.

    Every packet is sent through broadcast, and the only application
    that reads all of them is the PB/CC app.

    I know I could simply do something with the built in Winsock control
    in VB but I would rather do it entirely in PB and somehow
    allow VB to read it.

    ------------------
    -Greg

    [This message has been edited by Gregery D Engle (edited September 08, 2001).]

    Leave a comment:


  • Lance Edmonds
    replied
    Greg, what was the solution? Did you make both "ends" servers, or...?

    What exactly do you want to "relate to VB"? Data? Text? Can you not just pass the info back and forward as DLL parameters, or are you running these as separate Processes?

    Basically, I'm unclear as to what you really want to achieve...

    ------------------
    Lance
    PowerBASIC Support
    mailto:[email protected][email protected]</A>

    Leave a comment:


  • Scott Turchin
    replied
    Here, hope this helps somewhat, it is not NET time, I believe Dave Navarro was the person that did that one, you may be able to find it, but there is enough here to handle stuff.

    if you want to do NET TIME programmatically look at netbios calls, it is one.

    Code:
    '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
    '-----------------------------------------------------------------------------------
    ------------------
    Scott Turchin
    MCSE, MCP+I
    Computer Creations Software
    http://www.tngbbs.com/ccs

    Leave a comment:


  • Gregery D Engle
    replied
    I got it to work.

    This is going to be used with a Visual Basic Application and
    since I can setup a UDP client/server for time I want to send
    other information too.

    We have client Users that log into the database (I want to send
    that information too)

    so basically every computer will be a client and a server.

    The problem I'm having is how to I relate that information to
    VB? Since I can't call a Call Dword?

    Can I somehow receive a message on a invisible window within VB?

    ------------------
    -Greg

    Leave a comment:


  • Gregery D Engle
    replied
    Lance,

    The ip# is my current ip number, I wanted to first get the
    udp server working and then working on the broadcast part.

    I really think PB needs to make a UPD Client/Server sample.

    After searching the BBS, I find that other users have had many
    problems with this. I still haven't gotten it to work, maybe
    over the weekend I'll get more time to mess around with it.

    ------------------
    -Greg

    Leave a comment:


  • Lance Edmonds
    replied
    ummm.. please ignore my last message... brain was not in gear...

    Off hand though, I don't see anything else particularly wrong except you are not using a broadcast address.

    Any ideas anyone?


    ------------------
    Lance
    PowerBASIC Support
    mailto:[email protected][email protected]</A>

    Leave a comment:


  • Gregery D Engle
    replied
    Lance,

    in the help file it stats:

    Code:
    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.
    to me that means ipvar& and pnumvar& are passed byref.

    In any case I changed my client code and filled ipvar& and pnumvar&
    and it still doesn't work.

    Printed ERR, and the only err codes I get is on the client server
    and that is err#24 Device Time out.

    Any more ideas?

    ------------------
    -Greg

    Leave a comment:


  • Lance Edmonds
    replied
    How are you filling ipvar& & ipport& in the client code?

    Also, it may pay to keep an eye in ERR or ERRCLEAR to see if there are any runtime errors occurring.


    ------------------
    Lance
    PowerBASIC Support
    mailto:[email protected][email protected]</A>

    Leave a comment:


  • Gregery D Engle
    replied
    What am I doing wrong? I'm trying to simply get an UPD Client/server setup

    SERVER
    Code:
    #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
    CLIENT
    Code:
    #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

    ------------------
    -Greg



    [This message has been edited by Gregery D Engle (edited September 06, 2001).]

    Leave a comment:


  • Lance Edmonds
    replied
    Subnetting and IP masking is not my speciality, but I think you send to 192.169.0.255
    to broadcast to everything in 192.168.0.0 (or is it .0.1?) to 192.168.0.254

    Search the BBS for "UDP OPEN PORT" for additional info... you should find something here.


    ------------------
    Lance
    PowerBASIC Support
    mailto:[email protected][email protected]</A>

    Leave a comment:


  • Gregery D Engle
    replied
    Lance,

    I knew it wasn't shelling to dos, I think you knew what I ment.

    I did some research and I found that WM_TIMECHANGE is sent to
    all top level dialogs when the time is changed.

    I also like the UDP broadcast idea? How do I broadcast? my
    ip range is 192.168.0.0/24 Do I send a packet to a special ip#?

    ------------------
    -Greg

    [This message has been edited by Gregery D Engle (edited September 06, 2001).]

    Leave a comment:


  • Lance Edmonds
    replied
    The SHELL in the above code is not shelling to DOS per se... it is not launching the Command interpreter, but the NET.EXE utility.

    However, I tend to agree... it is a messy solution either way.

    Since you can set the time with TIME$, how about creating a "time server" PC to do a UDP broadcast of it's time every few minutes or so, then on the clients, just update the local time whenever the UDP broadcast is received.



    ------------------
    Lance
    PowerBASIC Support
    mailto:[email protected][email protected]</A>

    Leave a comment:


  • Gregery D Engle
    replied
    Bob,

    Yes that would work, I wasn't wanting to have to resort to
    shelling to dos though.

    This application is going to be a Desktop Time Entry system.

    I'm afraid the users will try and change there time's. Maybe
    if there is a way to restrict Any time changes on a Windows 98
    box it would work. I'm just afraid that if I start shelling to
    dos 500 times a day it might become unstable.



    ------------------
    -Greg

    Leave a comment:


  • Bob Houle
    replied
    Gregory,

    Is this what you're looking for? This small function
    asks the user for the info, but you should be able to
    do it progamatically, if you know the server name.

    Code:
    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
    Regards,
    --Bob

    ------------------

    Leave a comment:


  • Gregery D Engle
    replied
    Scott,

    I'm aware of that, I want this to be done programmically because
    my application requires the time to be synced to a main server.

    The computer's time can be whatever.

    ------------------
    -Greg

    Leave a comment:


  • Scott Turchin
    replied
    While I know you are looking to programmatically do this (Search on NET TIME, think the code is out there), you could always do this:

    NET TIME /SETSNTP:<MACHINENAME>

    From then on it defaults to 8 hrs, checks it automatically.



    ------------------
    Scott Turchin
    MCSE, MCP+I
    Computer Creations Software
    http://www.tngbbs.com/ccs

    Leave a comment:


  • Gregery D Engle
    started a topic Programmical emulate NET TIME

    Programmical emulate NET TIME

    I want to programmically get the time on a server just like

    Code:
    net time \\exchange1
    I want to get the time to make sure my program is in sync
    with the server's time. I don't want to have to shell and run
    NET because this will be used on different OS's

    any ideas?

    ------------------
    -Greg
Working...
X