Newsgroup: it.comp.lang.visual-basic
Titolo: [?] Aggiornare DATA/ORA da internet

Ciao, ho trovato sul sito comune un'applicazione per aggiornare DATA/ORA da
internet ma non mi funzia... e non so tradurne i contenuti...
Sto cercando il modo (ev. sorgente) che faccia un aggiornamento data/ora del
PC collegandosi sui server apposito in internet da implementare in un'appl.
VB6.
Grazie per qualche consiglio ev. sorgente, link.
Anto
-----= Posted via Newsfeeds.Com, Uncensored Usenet News =-----
http://www.newsfeeds.com
 - The #1 Newsgroup Service in the World!
-----==  Over 80,000 Newsgroups - 16 Different Servers! =-----

 apposito in internet da implementare in un'appl. VB6.
Ecco il codice di AtomicTime tratto dal sito comune:
--------------------
Option Explicit
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)
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 m_StrAtomicTime As String
Public Function DoAtomicTime() As Boolean
   Dim TZI As TIME_ZONE_INFORMATION
   Dim x As Single
   Dim Ntime As Date
   Dim i, n As Integer
   Dim lRet As Long
   Dim sRet As String
   Dim bDaylightSavings As Boolean
   Dim iMonthNow As Integer, iDayNow As Integer
   Dim iStandardMonth As Integer, iStandardDay As Integer
   Dim iDaylightMonth As Integer, iDaylightDay As Integer
   m_StrAtomicTime = ""
   Call GetTimeZoneInformation(TZI)
   iStandardMonth = TZI.StandardDate.wMonth
   iStandardDay = TZI.StandardDate.wDay
   iDaylightMonth = TZI.DaylightDate.wMonth
   iDaylightDay = TZI.DaylightDate.wDay
   iMonthNow = Month(Now)
   iDayNow = Day(Now)
   If iStandardMonth = iMonthNow Then
      bDaylightSavings = (iDayNow < iStandardDay)
   ElseIf iDaylightMonth = iMonthNow Then
      bDaylightSavings = (iDayNow >= iDaylightDay)
   Else
      If iDaylightMonth < iStandardMonth Then
         bDaylightSavings = iMonthNow > iDaylightMonth _
            And iMonthNow < iStandardMonth
      Else
         bDaylightSavings = iMonthNow > iDaylightMonth _
            Or iMonthNow < iStandardMonth
      End If
   End If
   lRet = TZI.Bias
   If bDaylightSavings Then
      lRet = lRet + TZI.DaylightBias
   Else
      lRet = lRet + TZI.StandardBias
   End If
   x = lRet / 60
   x = (x / 24)
   'sRet = OpenURL("
http://tycho.usno.navy.mil/cgi-bin/timer.pl
")
   sRet = OpenURL("
http://192.5.41.239/cgi-bin/timer.pl
")
   i = InStr(1, sRet, "Universal")
   If i <> 0 Then
      sRet = Mid$(sRet, 1, i)
      n = InStrRev(sRet, ",")
      If n <> 0 Then
         Ntime = CDate(Trim(Mid$(sRet, (n + 1), (i - (n + 1)))))
         Time = (Ntime - x)
         m_StrAtomicTime = CStr(Time)
         DoAtomicTime = True
      End If
   End If
End Function
Private Function OpenURL(ByVal sUrl As String) As String
   Dim hOpen               As Long
   Dim hOpenUrl            As Long
   Dim bDoLoop             As Boolean
   Dim bRet                As Boolean
   Dim sReadBuffer         As String * 2048
   Dim lNumberOfBytesRead  As Long
   Dim sBuffer             As String
   hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, _
       vbNullString, vbNullString, 0)
   hOpenUrl = InternetOpenUrl(hOpen, sUrl, vbNullString, 0, _
      INTERNET_FLAG_RELOAD, 0)
   bDoLoop = True
   Do While bDoLoop
      sReadBuffer = vbNullString
      bRet = InternetReadFile(hOpenUrl, sReadBuffer, _
         Len(sReadBuffer), lNumberOfBytesRead)
      sBuffer = sBuffer & Mid$(sReadBuffer, 1, _
         lNumberOfBytesRead)
      If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
   Loop
   If hOpenUrl <> 0 Then InternetCloseHandle (hOpenUrl)
   If hOpen <> 0 Then InternetCloseHandle (hOpen)
   OpenURL = sBuffer
End Function
--------------------
--
Sito Comune: 
http://www.it-lang-vb.net/
Manifesto: 
http://www.it-lang-vb.net/docs/Manifesto.txt

> Ecco il codice di AtomicTime tratto dal sito comune:
Grazie mille... non l'avevo trovato sul SC.
Funziona perfettamente. L'ho implementato al volo!
Solo una cosa che non sono riuscito a fare:
la variabile TIME DATA di windows viene aggiornata immediatamente ma
l'update del clock sulla barra win icone in basso a destra, resta invariata,
non viene aggiornata la visione del clock fino, credo, alla fine del minuto
che aggiorna la scritta sulla barra.
Sai magari se ci sia modo magari di forzare questo aggiornamento (applica)
anche su questo come per il resto.
ciao
ANTO!
