Network Time Of Day

[SFSxOI]

Just some simple code to get the network time of day from a network your are joined to and logged on (and of course the network needs to be able to serve up the time also). I've only used it on Windows 7 systems x86, so thats the only place its been checked. Might help someone out.

Code: Select all

Structure TIME_OF_DAY_INFO
  tod_elapsedt.i
  tod_msecs.i
  tod_hours.i
  tod_mins.i
  tod_secs.i
  tod_hunds.i
  tod_timezone.l
  tod_tinterval.i
  tod_day.i
  tod_month.i
  tod_year.i
  tod_weekday.i
EndStructure

#NERR_Success = 0

; time returned is 24 hour clock so there is no AM or PM indication as the 24 hour clock is its own indicator
; gets the time from a time source server on a network you are joined and logged onto (not internet like nist1-lnk.binary.net ('cause your not joined to that network) so..
; this can't be used to get time across the internet unless you are joined to the network domain the time server is in

Procedure.s ShowAPIError(CheckReturnValue) ; forum code - credit to va!n for ShowAPIError procedure used here > http://www.purebasic.fr/english/viewtopic.php?t=21432 
  Buffer.s = Space(4096) 
  NumberChars = FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, CheckReturnValue, 0, Buffer.s, Len(Buffer.s), 0) 
  ProcedureReturn Left(Buffer.s, NumberChars-2) 
EndProcedure

Procedure.s GetNetRemoteTOD(serverx.s) ; network server name is a UNC path, IPv4, IPv6, local machine, network - can be empty for local machine also
  nStatus.i
  DateTime.i
  *pTOD.TIME_OF_DAY_INFO = #Null
  *pBuffTOD = #Null ; system automatically allocates memory for this buffer when function called - must be free'd with NetApiBufferFree
  
  If Len(serverx) =< 0
    serverx.s = "\\localhost" ; default to local host if serverx is null/empty
  EndIf
  
  ; ********************************
  ; NetRemoteTOD function only accepts server name in unicode - convert ascii to unicode or compile this code to unicode
  ; check to see how its compiled to decide how to use NetRemoteTOD
  ; NetRemoteTOD first parameter server name is a pointer to a "string constant" per MSDN - PB doesn't have string constants, but it's really just a pointer anyway
  CompilerIf #PB_Compiler_Unicode
    nStatus = NetRemoteTOD_(@serverx, @*pBuffTOD)
  CompilerElse
    *pServer = AllocateMemory(Len(serverx)*4)
    MultiByteToWideChar_(#CP_ACP, #MB_PRECOMPOSED, @serverx, -1, *pServer, Len(serverx))
    nStatus = NetRemoteTOD_(*pServer, @*pBuffTOD)
  CompilerEndIf
      
  ;*********************************
    
  If nStatus = #NERR_Success
    
    *pTOD = *pBuffTOD
    
    DateTime = Date(*pTOD\tod_year,*pTOD\tod_month,*pTOD\tod_day,*pTOD\tod_hours,*pTOD\tod_mins,*pTOD\tod_secs)
    DateTime = AddDate(DateTime,#PB_Date_Minute,*pTOD\tod_timezone * -1)
    
    CompilerIf #PB_Compiler_Unicode
      
      NetApiBufferFree_(*pBuffTOD)
      
    CompilerElse
      
      NetApiBufferFree_(*pBuffTOD)
      FreeMemory(*pServer)
      
    CompilerEndIf
    
    ProcedureReturn FormatDate("%mm/%dd/%yyyy %hh:%ii:%ss", DateTime)
  
  Else
    
    CompilerIf #PB_Compiler_Unicode
      ; don't really need this but in a very odd situation as if the function fails the system never
      ; allocates the *pBuffTOD memory so nothing To remove - just in case 
      If *pBuffTOD > #Null
        NetApiBufferFree_(*pBuffTOD)
      EndIf
      
    CompilerElse
      
      If PeekL(*pServer) > #Null
        FreeMemory(*pServer)
      EndIf
      
      If *pBuffTOD > #Null ; *pBuffTOD only used if compiled in ascii
        NetApiBufferFree_(*pBuffTOD)
      EndIf
      
    CompilerEndIf
    
    ProcedureReturn "An error has occurred: " + Str(nStatus) + " = " + ShowAPIError(nStatus)
    
  EndIf
  

EndProcedure


  ; example inputs
  ;server$ = "\\localhost" ; local machine UNC 
  ;server$ = "."
  ;server$ = #NULL$
  ;server$ = #NUL$
  ;server$ = "127.0.0.1" ; or network assigned IP address - even from ISP for your local machine; takes valid IPv4 and IPv6 addresses on your joined network
  ;server$ = "\\." ; local machine UNC
  ;server$ = "\\ yourservername"
  ;server$ = ""
        
  Debug GetNetRemoteTOD(server$)

And.... if you need the 'Internet Time' (even though there is really no such thing as 'Internet Time') from the system time......another small snip of code

Code: Select all

#INTERNET_RFC1123_FORMAT = 0
#INTERNET_RFC1123_BUFSIZE = 30

; returns time in GMT in format = Wed, 22 Feb 2012 16:13:39 GMT


Procedure.s GetInternetTimeFromSystemTime()
  
  Protected Time_out$
  
  st.SYSTEMTIME
  
  GetSystemTime_(@st)
  Time_out$ = Space(#INTERNET_RFC1123_BUFSIZE)
  ret_val.i = InternetTimeFromSystemTime_(@st, #INTERNET_RFC1123_FORMAT, @Time_out$, #INTERNET_RFC1123_BUFSIZE)
  
  ProcedureReturn Time_out$
  
EndProcedure

Debug GetInternetTimeFromSystemTime()