Vb编写代码修改计算机时间,VB 从取得标准时间然修改电脑时间?

该楼层疑似违规已被系统折叠 隐藏此楼查看此楼

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 Declare Function SetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) As Long

'//获取网络时间

Private Function GetNetTime(ByVal hUrl As String) As String

Dim objHttp As Object

Dim datetxt As String

Dim date1() As String

Dim date2 As String

Dim date3() As String

Dim nTime As String

Dim localtime As String

Dim mon As String

Set objHttp = CreateObject("Microsoft.XMLHTTP")

objHttp.open "GET", hUrl, False

On Error Resume Next

objHttp.send

datetxt = objHttp.getResponseHeader("Date")

date1 = Split(datetxt, ",")

If UBound(date1) < 1 Then

Debug.Print "网络验证失败，请重新启动或检查网络设置"

Exit Function

End If

date2 = Replace(date1(1), "GMT", "")

date3 = Split(date2, " ")

Select Case (date3(2))

Case "Jan": mon = "01"

Case "Feb": mon = "02"

Case "Mar": mon = "03"

Case "Apr": mon = "04"

Case "May": mon = "05"

Case "Jun": mon = "06"

Case "Jul": mon = "07"

Case "Aug": mon = "08"

Case "Sep": mon = "09"

Case "Oct": mon = "10"

Case "Nov": mon = "11"

Case "Dec": mon = "12"

End Select

localtime = date3(3) + "/" + mon + "/" + date3(1) + " " + date3(4)

nTime = CDate(localtime)

nTime = DateAdd("h", 8, nTime)

GetNetTime = nTime

End Function

'//将网络时间分割并设置

Public Sub LocalTimeByNet()

Dim tmp As String

tmp = GetNetTime("http://www.baidu.com/")

Dim lpSystemTime    As SYSTEMTIME

lpSystemTime.wYear = Year(tmp)

lpSystemTime.wMonth = Month(tmp)

lpSystemTime.wDayOfWeek = -1

lpSystemTime.wDay = Day(tmp)

lpSystemTime.wHour = Hour(tmp)

lpSystemTime.wMinute = Minute(tmp)

lpSystemTime.wSecond = Second(tmp)

lpSystemTime.wMilliseconds = 0

SetLocalTime lpSystemTime

End Sub

Sub main()

Call LocalTimeByNet

End Sub