[RESOLVED] Time Server Synchronization WITHOUT Winsock???

[Hassan Basri]

Thanks for everybody's help, after having searched on the internet I found a way using HTTP protocol and VB code. Here is the link:

http://brigsoft.com/atomic-clock-syn...cVbArticle.htm

Here is the code from the web page. However it needs some adjusting in parsing the result received from the web page. However it gives the general idea of how to proceed.

Option Explicit
 
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 As String * 64
    StandardDate As SYSTEMTIME
    StandardBias As Long
    DaylightName As String * 64
    DaylightDate As SYSTEMTIME
    DaylightBias As Long
End Type
 
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
Private Const scUserAgent = "VB Project"
Private Const INTERNET_FLAG_RELOAD = &H80000000
 
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
 
Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hOpen As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
 
Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer
 
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
 
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
 
Private Declare Sub GetLocalTime Lib "kernel32" (localTime As SYSTEMTIME)
 
Private Declare Sub SetLocalTime Lib "kernel32" (localTime As SYSTEMTIME)
 
 
'=================================================================
' LocalZoneTime function calculates Local time using Universal time.
' Time zone information is gotten from Windows using
' GetTimeZoneInformation API function (see MSDN for mo information).
' The function support DST time.
Sub LocalZoneTime(tmUniversal As SYSTEMTIME, tmLocal As SYSTEMTIME)
 
    Dim TZI As TIME_ZONE_INFORMATION
 
    Dim retCode As Long
 
    retCode = GetTimeZoneInformation(TZI)
 
    Dim iStandardMonth As Integer
    Dim iDaylightMonth As Integer
 
    iStandardMonth = TZI.StandardDate.wMonth
    iDaylightMonth = TZI.DaylightDate.wMonth
 
    Dim nZoneCorrection As Long
    nZoneCorrection = TZI.Bias
 
    If retCode = 1 Then 'TIME_ZONE_ID_STANDARD
        nZoneCorrection = nZoneCorrection + TZI.StandardBias
    ElseIf retCode = 2 Then ' TIME_ZONE_ID_DAYLIGHT
        nZoneCorrection = nZoneCorrection + TZI.DaylightBias
    Else
        Debug.Assert (0)
    End If
 
    nZoneCorrection = -nZoneCorrection
 
    Dim nTotalMinutes As Integer
 
    nTotalMinutes = tmUniversal.wHour * 60 + tmUniversal.wMinute + nZoneCorrection
 
    If nTotalMinutes < 0 Then
        nTotalMinutes = nTotalMinutes + 24 * 60
    End If
    If nTotalMinutes > 24 * 60 Then
        nTotalMinutes = nTotalMinutes - 24 * 60
    End If
 
    tmLocal.wHour = Int(nTotalMinutes / 60)
    tmLocal.wMinute = nTotalMinutes - tmLocal.wHour * 60
    tmLocal.wSecond = tmUniversal.wSecond
 
End Sub
 
 
'===========================================================
' OnSyncro is called after SYNCRO dialog button pressing.
' It opens Internet connection, receives Universal Time,
' calculates Local Time and set it in Windows.
 
Public Function OnSynchro()
 
    Dim hInternet As Long
    Dim hHttp As Long
    Dim bRet As Boolean
    Dim sBuff As String * 2048
    Dim lNumberOfBytesRead As Long
    Dim sBuffer As String
 
    hInternet = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, _
    vbNullString, vbNullString, 0)
    If hInternet = 0 Then Debug.Assert (0)
 
    hHttp = InternetOpenUrl(hInternet, "http://tycho.usno.navy.mil/cgi-bin/timer.pl", vbNullString, 0, _
    INTERNET_FLAG_RELOAD, 0)
    If hHttp = 0 Then Debug.Assert (0)
 
    sBuff = vbNullString
    bRet = InternetReadFile(hHttp, sBuff, _
    Len(sBuff), lNumberOfBytesRead)
    sBuffer = sBuffer & Left$(sBuff, _
    lNumberOfBytesRead)
 
    If hHttp <> 0 Then InternetCloseHandle (hHttp)
    If hInternet <> 0 Then InternetCloseHandle (hInternet)
 
    Dim dtOldTime As SYSTEMTIME
    Dim tmLocal As SYSTEMTIME
    Dim tmUniversal As SYSTEMTIME
 
    Call GetLocalTime(tmLocal)
    dtOldTime = tmLocal
 
    Dim buffPos As Integer
    buffPos = InStr(1, sBuff, "UTC")
 
    If Not buffPos > 0 Then
        MsgBox ("Unrecognized communication error!")
        Return
    End If
 
 
    tmUniversal.wHour = Mid$(sBuff, buffPos - 11, 2)
    tmUniversal.wMinute = Mid$(sBuff, buffPos - 8, 2)
    tmUniversal.wSecond = Mid$(sBuff, buffPos - 5, 2)
 
    ' Calculate Local Time using received Universal Time.
    Call LocalZoneTime(tmUniversal, tmLocal)
 
    Call SetLocalTime(tmLocal)
 
    Dim sRep
    sRep = "Successful synchronization!" + Chr$(10) + Chr$(13) + _
    "Time before: " + Str$(dtOldTime.wHour) + ":" + Str$(dtOldTime.wMinute) + ":" + Str$(dtOldTime.wSecond) + Chr$(10) + Chr$(13) + _
    "Time after: " + Str$(tmLocal.wHour) + ":" + Str$(tmLocal.wMinute) + ":" + Str$(tmLocal.wSecond) + "."
 
    MsgBox (sRep)
 
End Function