[分享]API 设置调整系统当前时间

huangqinyong

API 设置调整系统当前时间

       对于时间要求比较严谨的情况下，需要对当前系统时间和外部时间作一个对比，并作相应的调整，这就要求能对系统时间重新设置

' 功能: 重新设置系统时间
' 用法: SetTime "2008-4-26 22:53:48"
'**************************************************
'设置当前系统时间
Private Declare Function SetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) As Long
Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
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(32) As Integer
        StandardDate As SYSTEMTIME
        StandardBias As Long
        DaylightName(32) As Integer
        DaylightDate As SYSTEMTIME
        DaylightBias As Long
End Type

Public Sub SetTime(NewTime As String)
' 功能: 设置系统时间
   Dim lpSystemTime As SYSTEMTIME               '时间信息
   Dim ZoneNum As Integer
    ZoneNum = getZoneNum()
    With lpSystemTime
        .wYear = Year(NewTime)
        .wMonth = Month(NewTime) + 1
        .wDayOfWeek = -1
        .wDay = Day(NewTime)
        .wHour = Hour(NewTime) + ZoneNum
        .wMinute = Minute(NewTime)
        .wSecond = Second(NewTime)
        .wMilliseconds = 0
    End With
   
   SetSystemTime lpSystemTime
End Sub
Private Function getZoneNum() As Integer
    Dim lpSystemZone As TIME_ZONE_INFORMATION    '时区信息
    GetTimeZoneInformation lpSystemZone
    getZoneNum = lpSystemZone.Bias / 60
End Function

xsxsxslch

感觉楼主在EH混了不少日子了，猜想这是第二号吧！