GetInternetDate via WMI hangs in line .POST?

Hi,

I needed to get current date&time information from a time server and found a code thanks to this forum.

The code is below.

It works well many times but sometimes (and not so seldom) the code creates an error saying "unspecified error" at line xPOST.send. Sometimes it works very well.

At first, I thought that it is because of internet connection or syncronizing problem and so I have enveloped it with a loop until to get response to the xpost.send command. It did not worked, the loop goes to endless loop when the error fired.

I am using ServerNO=2 while caling the function because other servers never responce or very slow.

What is the reason & solution of this error randomly firing.

Thank you for your comments in advance.


THE CODE IS AT BELOW:

Public Function GetInternetDate(ServerNo As Byte) As String
'//Get current time from internet time server
'//by jimmyzs

Dim SvrName(15), xPost, HttpAdd, NowTime, StartTime

StartTime = Now
'//internet time server list
SvrName(1) = "time-nw.nist.gov"
'//Microsoft, Redmond, Washington 131.107.1.10
SvrName(2) = "time-a.nist.gov"
'//NIST, Gaithersburg, Maryland 129.6.15.28
SvrName(3) = "time-b.nist.gov"
'//NIST, Gaithersburg, Maryland 129.6.15.29
SvrName(4) = "time-a.timefreq.bldrdoc.gov"
'//NIST, Boulder, Colorado 132.163.4.101
SvrName(5) = "time-b.timefreq.bldrdoc.gov"
'//NIST, Boulder, Colorado 132.163.4.102
SvrName(6) = "time-c.timefreq.bldrdoc.gov"
'//NIST, Boulder, Colorado 132.163.4.103
SvrName(7) = "utcnist.colorado.edu"
'//University of Colorado, Boulder 128.138.140.44
SvrName(8) = "time.nist.gov"
'//NCAR, Boulder, Colorado 192.43.244.18
SvrName(9) = "nist1.datum.com"
'//Datum, San Jose, California 66.243.43.21
SvrName(10) = "nist1.dc.glassey.com"
'//Abovenet, Virginia 216.200.93.8
SvrName(11) = "nist1.ny.glassey.com"
'//Abovenet, New York City 208.184.49.9
SvrName(12) = "nist1.sj.glassey.com"
'//Abovenet, San Jose, California 207.126.103.204
SvrName(13) = "nist1.aol-ca.truetime.com"
'//TrueTime, AOL facility, Sunnyvale, CA 207.200.81.113
SvrName(14) = "nist1.aol-va.truetime.com"
'//TrueTime, AOL facility, Virginia 205.188.185.33
'//use xmlhttp object
SvrName(15) = "1.tr.pool.ntp.org"
'//Türkiye server

strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!" & strComputer & "\root\cimv2")

Set colTimeZone = objWMIService.ExecQuery("Select * from Win32_computersystem")
For Each objTimeZone In colTimeZone
Offset = objTimeZone.currenttimezone
Next
Set xPost = CreateObject("Microsoft.XMLHTTP")

HttpAdd = "Http://" & SvrName(ServerNo) & ":13"
NowTime = ""
frmsvr = SvrName(ServerNo)

xPost.Open "Put", HttpAdd, False

'//synchronize
On Error Resume Next
Do
xPost.Send
'send request to http server and receive response
Loop While Err <> 0
On Error GoTo 0

If xPost.readyState = 4 Then
'//success or failed
NowTime = Mid(xPost.responsetext, 8, 17)
'//return response
If NowTime <> "" Then
NowTime = Mid(NowTime, 7, 2) & "." & Mid$(NowTime, 4, 2) & ".20" & Left$(NowTime, 2)
NowTime = CDate(NowTime)
GetInternetDate_Noktalıggaayyyy = NowTime
Else
xPost.abort
NowTime = ""
GetInternetTime = NowTime
GetInternetDate_Noktalıggaayyyy = "Please check your internet connection."
Stop
End If
End If

'//internet connection problem
If DateDiff("s", StartTime, Now) >= 30 And NowTime = "" Then
GetInternetTime = "Please check your internet connection."
Stop
End If

xPost.abort
Set xPost = Nothing
End Function