Question

我构建了一个定时器，作为一个每秒ping一次并输出时间戳的时钟：

Private WithEvents Timer1Sec As New System.Timers.Timer
Private NumberPings As Integer
Private LastPingTime As Date
Private Duration As Integer = 1000 'in milliseconds

Private Sub StartTimer()
    Timer1Sec.AutoReset = True
    Timer1Sec.Interval = Duration

    NumberPings = 0
    LastPingTime = Now()
    Console.WriteLine(LastPingTime.ToString("hh:mm:ss:fff") & " Ping(Start)")
    Timer1Sec.Start()
End Sub

Private Sub Ping() Handles Timer1Sec.Elapsed
    NumberPings += 1
    Dim TimeNow As Date = Now()
    Dim TimeBewteen As TimeSpan = TimeNow - LastPingTime
    Dim TimeDrift As Double = Math.Round(TimeBewteen.TotalMilliseconds - Duration, 4)
    Console.WriteLine(TimeNow.ToString("hh:mm:ss:fff") & " Ping(" & NumberPings & ") MilSecDrift(" & TimeDrift & ")")
    LastPingTime = TimeNow
End Sub

以下是前10秒输出的典型示例：

12:02:12:091 Ping(Start)
12:02:13:122 Ping(1) MilSecDrift(31.1539)
12:02:14:123 Ping(2) MilSecDrift(0.648)
12:02:15:124 Ping(3) MilSecDrift(0.6483)
12:02:16:126 Ping(4) MilSecDrift(2.1463)
12:02:17:126 Ping(5) MilSecDrift(0.1452)
12:02:18:127 Ping(6) MilSecDrift(0.6468)
12:02:19:127 Ping(7) MilSecDrift(0.1476)
12:02:20:128 Ping(8) MilSecDrift(0.6449)
12:02:21:128 Ping(9) MilSecDrift(0.6527)
12:02:22:128 Ping(10) MilSecDrift(0.1499)

正如您所看到的，ping不会在每1000毫秒完成。相反，它似乎每1000.15到1001.5毫秒，导致它每10秒钟漂移多达5+毫秒。这种漂移会随着时间的推移而增加，并导致时钟变得非常快。

如何让计时器自动纠正每次连续ping时发生的漂移？或者我应该使用System.Timer以外的其他东西？

编辑：我只是在寻找平均1000毫秒的Timer1Sec.Elapsed事件。例如，如果我运行100万秒，它应该会发射100万次。但相反，由于漂移，它目前在百万秒内仅发射约999,000次。

Answer 1

如果您不担心提高CPU，可以尝试这样做：

    Dim tickInterval = New TimeSpan(0, 0, 1)
    Dim timeToTick = DateTime.Now + tickInterval

    While True
        While DateTime.Now < timeToTick
            System.Threading.Thread.Sleep(timeToTick - DateTime.Now)
        End While
        timeToTick += tickInterval
        Console.WriteLine(DateTime.Now.ToString("yyyyMMdd HH:mm:ss.FFF"))
    End While

Answer 2

Microsoft的Reactive Framework（NuGet“System.Reactive”）有一些非常强大的调度程序可能有所帮助。

这是一个计时器的实现，平均来说可以避免漂移：

Dim started = DateTimeOffset.Now
Dim reschedule As Func(Of IScheduler, Long, IDisposable) = Nothing
reschedule = Function(s, n)
    Console.WriteLine(DateTimeOffset.Now.Subtract(started).TotalMilliseconds)
    Return s.Schedule(n + 1, started.AddSeconds(n), reschedule)
End Function
Dim subscription = Scheduler.Default.Schedule(2, started.AddSeconds(1.0), reschedule)

有了它，我得到了这个输出：

你可以看到它在1秒钟之后有一点开销，但它不断尝试调整。

查找System.Reactive.Concurrency命名空间中的类。

要停止计时器，只需拨打subscription.Dispose()。

如何修复vb.net中的计时器漂移

2 个答案: