Sub GetiNetTime()
Dim ws
Dim http
Dim GMT_Time, NewNow, NewDate, NewTime, Hr, Mn, Sc
Dim sComm As String
Const GMTTime As String = "http://wwp.greenwichmeantime.com/time/scripts/clock-8/runner.php?tz=gmt"
On Error Resume Next
Set http = CreateObject("Microsoft.XMLHTTP")
http.Open "GET", GMTTime & Now(), False, "", ""
http.send
GMT_Time = http.getResponseHeader("Date")
GMT_Time = Mid$(GMT_Time, 6, Len(GMT_Time) - 9)
Hr = 7 'Hours.
Mn = 0 'Minutes.
Sc = 0 'Seconds.
NewNow = DateAdd("h", Hr, GMT_Time) 'Adding 7 Hours to GMT.
NewNow = DateAdd("n", Mn, NewNow) 'Adding 0 Minutes to GMT.
NewNow = DateAdd("s", Sc, NewNow) 'Adding 0 Seconds to GMT.
MsgBox "Current Date & Time is: SE Asia Standard time " & NewNow, vbOKOnly, "GetiNetTime"
'Thay TimeZone và ngày gi?
Set ws = CreateObject("WScript.Shell")
NewDate = DateValue(NewNow)
NewTime = Format(TimeValue(NewNow), "hh:mm:ss")
sComm = "cmd.exe /c TZUTIL /s ""SE Asia Standard time"""
ws.Run sComm, 0, True
ws.Run "%comspec% /c time " & NewTime, 0
ws.Run "%comspec% /c date " & NewDate, 0
Set ws = Nothing
Set http = Nothing
End Sub
Sub SetDateTimeFormNet(ByVal zone_offset As Long, ByVal zone_name As String)
Dim GMT_Time As String, currDateTime As String, currDate As Date, currTime As Date
Dim http As Object, shell As Object, sCmd As String, sMonth, s As String, index As Long
Const GMTTime As String = "http://wwp.greenwichmeantime.com/time/scripts/clock-8/runner.php?tz=gmt"
sMonth = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
On Error Resume Next
s = Application.OperatingSystem
index = InStr(1, s, "NT")
If index > 0 Then index = Mid(s, index + 3, 1)
If index > 5 Then
sCmd = "cmd.exe /c TZUTIL /s " & zone_name
ElseIf index = 5 Then
sCmd = "cmd.exe /c rundll32.exe shell32.dll,Control_RunDLL timedate.cpl,,/Z " & zone_name
Else
Exit Sub
End If
Set shell = CreateObject("WScript.Shell")
shell.Run sCmd, 0, True
Set http = CreateObject("Microsoft.XMLHTTP")
http.Open "GET", GMTTime & Now(), False, "", ""
http.send
GMT_Time = http.getResponseHeader("Date")
GMT_Time = Mid$(GMT_Time, 6, Len(GMT_Time) - 9)
For index = 0 To 11
s = Mid(GMT_Time, 3, 5)
If InStr(1, s, sMonth(index)) > 0 Then
GMT_Time = Replace(GMT_Time, s, Application.International(xlDateSeparator) & _
Format(index + 1, "00") & Application.International(xlDateSeparator))
Exit For
End If
Next
currDateTime = DateAdd("h", zone_offset, GMT_Time)
currDate = DateValue(currDateTime)
currTime = Format(TimeValue(currDateTime), "hh:mm:ss")
shell.Run "%comspec% /c time " & currTime, False
shell.Run "%comspec% /c date " & currDate, False
Set shell = Nothing
Set http = Nothing
End Sub
