Skip to content
Permalink
Browse files

Use the data type "Currency" to store 64-bit result of GetTickCount64…

…() system call.

* Use that system call for system and connection uptime.
* Use the function GetTickCountMS() to return a number of milliseconds
  stored in a Currency data type. A Currency data type is a fixed-point
  decimal number and is stored in memory as a 64-bit number. When
  multiplied by 1000 and passed around as a Currency, it should support
  connection and system uptimes of approximately 2 million years
  without overflowing.
* Redo the ConvertTime() function renamed to ConvertTimeInterval():
  returns the human-readable string with correct plurals and no 0-value parts
  (unless the value is actually 0, then it returns "0 seconds").
* Remove GetUptimeMS() in favor of GetTickCountMS().
* Remove the uTicks variable in favor of storing the connection
  GetTickCount() value on logon and calculating the difference.
* Remove timeGetSystemTime() system call and related structures.
* .uptime now only shows the system uptime part when not connected.
  • Loading branch information...
nmbook committed Mar 9, 2017
1 parent 855a082 commit 4ceebbd3e5de4345a525a3767785dfdc6e35a990
@@ -31,7 +31,7 @@ Private m_MCPHandler As clsMCPHandler
Private m_FirstTimeChat As Boolean
Private m_AccountEntry As Boolean
Private m_AccountEntryPending As Boolean
Private m_LastPingResponse As Double
Private m_LastPingResponse As Currency

Public Sub List()
With frmChat
@@ -89,7 +89,8 @@ Public Property Let ClientToken(lData As Long)
m_ClientToken = lData
End Property
Public Property Get ClientToken() As Long
If (m_ClientToken = 0) Then m_ClientToken = GetTickCount
' keep 32-bit GTC as it's used as a cookie and it doesn't matter the value
If (m_ClientToken = 0) Then m_ClientToken = GetTickCount()
ClientToken = m_ClientToken
End Property

@@ -204,10 +205,10 @@ Public Property Get AccountEntryPending() As Boolean
AccountEntryPending = m_AccountEntryPending
End Property

Public Property Let LastPingResponse(dData As Double)
Public Property Let LastPingResponse(dData As Currency)
m_LastPingResponse = dData
End Property
Public Property Get LastPingResponse() As Double
Public Property Get LastPingResponse() As Currency
LastPingResponse = m_LastPingResponse
End Property

@@ -386,12 +386,10 @@ End Function

'// GETGTC
'// Returns the current system uptime in milliseconds as reported by the GetTickCount() API call
Public Function GetGTC() As Long
GetGTC = GetTickCount()
Public Function GetGTC() As Double
GetGTC = CDbl(modDateTime.GetTickCountMS())
End Function



'// DOBEEP
'// Executes a call to the Beep() API function
Public Function DoBeep(ByVal lFreq As Long, ByVal lDuration As Long) As Long
@@ -1070,13 +1068,25 @@ End Function
'// GETSYSTEMUPTIME
'// Returns the amount of time your system has been up
Public Function GetSystemUptime() As String
GetSystemUptime = ConvertTime(GetUptimeMS)
GetSystemUptime = ConvertTimeInterval(modDateTime.GetTickCountMS())
End Function

'// GETCONNECTIONUPTIME
'// Returns the amount of time your bot has been online
Public Function GetConnectionUptime() As String
GetConnectionUptime = ConvertTime(uTicks)
GetConnectionUptime = ConvertTimeInterval(modDateTime.GetConnectionUptime())
End Function

'// GETSYSTEMUPTIMEMS
'// Returns the amount of time your system has been up in milliseconds
Public Function GetSystemUptimeMS() As Double
GetSystemUptimeMS = modDateTime.GetTickCountMS()
End Function

'// GETCONNECTIONUPTIMEMS
'// Returns the amount of time your bot has been online in milliseconds
Public Function GetConnectionUptimeMS() As Double
GetConnectionUptimeMS = modDateTime.GetConnectionUptime()
End Function

'// CRC32
@@ -17,7 +17,7 @@ Attribute VB_Exposed = False
Option Explicit

Private m_event_id As Long
Private m_gtc As Long
Private m_gtc As Currency
Private m_ping As Long
Private m_flags As Long
Private m_message As String
@@ -28,7 +28,7 @@ Private m_stat_string As String
Private m_displayed As Boolean

Private Sub Class_Initialize()
EventTick = GetTickCount()
EventTick = GetTickCountMS()
End Sub

Public Property Get EventID() As Long
@@ -39,12 +39,12 @@ Public Property Let EventID(ByVal lng As Long)
m_event_id = lng
End Property

Public Property Let EventTick(ByVal lng As Long)
Public Property Let EventTick(ByVal lng As Currency)
m_gtc = lng
End Property


Public Property Get EventTick() As Long
Public Property Get EventTick() As Currency
EventTick = m_gtc
End Property

@@ -2304,6 +2304,7 @@ End Sub
Sub Event_BNetDisconnected()
tmrIdleTimer.Enabled = False
UpTimer.Enabled = False
ConnectionTickCount = 0@
BotVars.JoinWatch = 0

AddChat RTBColors.ErrorMessageText, "[BNCS] Disconnected."
@@ -4052,7 +4053,7 @@ Private Sub mnuPopClanRemove_Click()
AwaitingClanInfo = 1
End With

LastRemoval = GetTickCount
LastRemoval = GetTickCountMS()
End If
End If
End Sub
@@ -6227,14 +6228,14 @@ Private Sub tmrIdleTimer_Timer_IdleMsg()
Exit Sub
End If

IdleMsg = Replace(IdleMsg, "%cpuup", ConvertTime(GetUptimeMS))
IdleMsg = Replace(IdleMsg, "%cpuup", ConvertTimeInterval(GetTickCountMS()))
IdleMsg = Replace(IdleMsg, "%chan", g_Channel.Name)
IdleMsg = Replace(IdleMsg, "%c", g_Channel.Name)
IdleMsg = Replace(IdleMsg, "%me", GetCurrentUsername)
IdleMsg = Replace(IdleMsg, "%v", CVERSION)
IdleMsg = Replace(IdleMsg, "%ver", CVERSION)
IdleMsg = Replace(IdleMsg, "%bc", BanCount)
IdleMsg = Replace(IdleMsg, "%botup", ConvertTime(uTicks))
IdleMsg = Replace(IdleMsg, "%botup", ConvertTimeInterval(GetConnectionUptime()))
IdleMsg = Replace(IdleMsg, "%mp3", Replace(MediaPlayer.TrackName, "&", "+"))
IdleMsg = Replace(IdleMsg, "%quote", g_Quotes.GetRandomQuote)
IdleMsg = Replace(IdleMsg, "%rnd", GetRandomPerson)
@@ -6245,7 +6246,7 @@ Private Sub tmrIdleTimer_Timer_IdleMsg()
End If

ElseIf IdleType = "uptime" Then
IdleMsg = "/me -: System Uptime: " & ConvertTime(GetUptimeMS()) & " :: Connection Uptime: " & ConvertTime(uTicks) & " :: " & CVERSION & " :-"
IdleMsg = "/me -: System Uptime: " & ConvertTimeInterval(GetTickCountMS()) & " :: Connection Uptime: " & ConvertTimeInterval(GetConnectionUptime()) & " :: " & CVERSION & " :-"

ElseIf IdleType = "mp3" Then
Dim WindowTitle As String
@@ -6569,8 +6570,6 @@ Private Sub UpTimer_Timer()
Dim i As Integer
Dim pos As Integer
Dim doCheck As Boolean

uTicks = (uTicks + 1000)

If (floodCap > 2) Then
floodCap = floodCap - 3
@@ -8128,7 +8127,7 @@ Sub DoConnect()
Call DoDisconnect
End If

uTicks = 0
ConnectionTickCount = 0@

UserCancelledConnect = False

@@ -8231,7 +8230,7 @@ Sub DoDisconnect(Optional ByVal DoNotShow As Byte = 0, Optional ByVal LeaveUCCAl
Call g_Queue.Clear

BNLSAuthorized = False
uTicks = 0
ConnectionTickCount = 0@

mnuSepZ.Visible = False
mnuIgnoreInvites.Visible = False
@@ -832,9 +832,9 @@ On Error GoTo ERROR_HANDLER:
Cookie = pBuff.GetDWORD

SendResponse = False
If uTicks >= ds.LastPingResponse + 1000 Then
If GetTickCountMS() >= ds.LastPingResponse + 1000 Then
SendResponse = True
ds.LastPingResponse = uTicks
ds.LastPingResponse = GetTickCountMS()
End If
'frmChat.AddChat vbWhite, StringFormat("PING uTicks={0} LPR={1} C={2} SendResponse={3}", uTicks, ds.LastPingResponse, cookie, SendResponse)

@@ -16,9 +16,9 @@ End Sub
Public Function ChatQueueTimerProc()

Dim CurrentUser As clsUserObj
Dim I As Integer
Dim j As Integer
Dim lastTimer As Long
Dim i As Integer
Dim j As Integer
Dim lastTimer As Long

If (g_Channel Is Nothing) Then
Exit Function
@@ -28,19 +28,19 @@ Public Function ChatQueueTimerProc()
Exit Function
End If

For I = 1 To g_Channel.Users.Count
If (I > g_Channel.Users.Count) Then
For i = 1 To g_Channel.Users.Count
If (i > g_Channel.Users.Count) Then
Exit For
End If

Set CurrentUser = g_Channel.Users(I)
Set CurrentUser = g_Channel.Users(i)

If (CurrentUser.Queue.Count > 0) Then
If ((GetTickCount() - CurrentUser.Queue(1).EventTick) >= BotVars.ChatDelay) Then
If ((GetTickCountMS() - CurrentUser.Queue(1).EventTick) >= BotVars.ChatDelay) Then
CurrentUser.DisplayQueue
End If
End If
Next I
Next i

Set CurrentUser = Nothing
End Function
@@ -267,7 +267,7 @@ Public Sub OnInfo(Command As clsCommandObj)
.DisplayName, ProductCodeToFullName(.Game), _
IIf(.IsOperator, "ops, and ", vbNullString), .Ping)

Command.Respond StringFormat("He/she has been present in the channel for {0}.", ConvertTime(.TimeInChannel(), 1))
Command.Respond StringFormat("He/she has been present in the channel for {0}.", ConvertTimeInterval(.TimeInChannel(), True))
End With
Else
Command.Respond "No such user is present."
@@ -660,7 +660,11 @@ Public Sub OnTrigger(Command As clsCommandObj)
End Sub

Public Sub OnUptime(Command As clsCommandObj)
Command.Respond StringFormat("System uptime {0}, connection uptime {1}.", ConvertTime(GetUptimeMS), ConvertTime(uTicks))
If g_Online Then
Command.Respond StringFormat("System uptime {0}; connection uptime {1}.", ConvertTimeInterval(GetTickCountMS()), ConvertTimeInterval(GetConnectionUptime()))
Else
Command.Respond StringFormat("System uptime {0}.", ConvertTimeInterval(GetTickCountMS()))
End If
End Sub

Public Sub OnWhere(Command As clsCommandObj)
@@ -9,10 +9,12 @@ Public Declare Function FileTimeToSystemTime Lib "Kernel32.dll" (lpFileTime As F
Public Declare Function SystemTimeToFileTime Lib "Kernel32.dll" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Public Declare Function FileTimeToLocalFileTime Lib "Kernel32.dll" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Public Declare Function GetTimeZoneInformation Lib "Kernel32.dll" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
Public Declare Function timeGetSystemTime Lib "winmm.dll" (lpTime As MMTIME, ByVal uSize As Long) As Long
Public Declare Function GetTickCount Lib "Kernel32.dll" () As Long
Public Declare Function GetTickCount64 Lib "Kernel32.dll" () As Currency
Public Declare Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)

Public ConnectionTickCount As Currency

Private Const TIME_ZONE_ID_UNKNOWN = 0
Private Const TIME_ZONE_ID_STANDARD = 1
Private Const TIME_ZONE_ID_DAYLIGHT = 2
@@ -43,23 +45,6 @@ Private Type TIME_ZONE_INFORMATION
DaylightBias As Long
End Type

Public Type SMPTE
hour As Byte
min As Byte
sec As Byte
frame As Byte
fps As Byte
dummy As Byte
pad(2) As Byte
End Type

Public Type MMTIME
wType As Long
units As Long
smpteVal As SMPTE
songPtrPos As Long
End Type

Public Function UtcNow() As Date
UtcNow = SystemTimeToDate(GetSystemTime())
End Function
@@ -90,7 +75,7 @@ End Function

Public Function SystemTimeToDate(ByRef STime As SYSTEMTIME) As Date
Dim tempDate As Date
Dim tempTime As Date
Dim tempTime As Date
tempDate = DateSerial(STime.wYear, STime.wMonth, STime.wDay)
tempTime = TimeSerial(STime.wHour, STime.wMinute, STime.wSecond)

@@ -124,7 +109,7 @@ Public Function GetTimeZoneBias() As Long

Case Else
GetTimeZoneBias = TZinfo.Bias
End Select
End Select
End Function

Public Function GetTimeZoneName() As String
@@ -157,3 +142,91 @@ Public Function GetTimeZoneName() As String

GetTimeZoneName = str
End Function

Public Function GetTickCountMS() As Currency
GetTickCountMS = (GetTickCount64() * 10000)
End Function

Public Function GetTickCountS() As Long
GetTickCountS = CLng(GetTickCount64() * 10)
End Function

Public Function GetConnectionUptime() As Currency
If g_Online Then
GetConnectionUptime = GetTickCountMS() - ConnectionTickCount
Else
GetConnectionUptime = 0@
End If
End Function

'// Converts a millisecond or second time value to humanspeak.. modified to support BNet's Time
Public Function ConvertTimeInterval(ByVal MS As Currency, Optional ByVal IsSeconds As Boolean = False) As String
Dim Seconds As Currency
Dim Minutes As Currency
Dim Hours As Currency
Dim Days As Currency

Dim sSeconds As String
Dim sMinutes As String
Dim sHours As String
Dim sDays As String

Dim sPlural As String
Dim sComma As String
Dim sAnd As String

If (IsSeconds) Then
Seconds = MS
MS = MS * 1000
Else
Seconds = Round(MS / 1000)
End If

Days = Int(Seconds / 86400)
Seconds = Seconds Mod 86400

If Days > 0 Then
sPlural = "s"
sComma = ", "
If Days = 1 Then sPlural = vbNullString
If Seconds = 0 Then sComma = vbNullString
sDays = StringFormat("{0} day{1}{2}", Days, sPlural, sComma)
End If

Hours = Int(Seconds / 3600)
Seconds = Seconds Mod 3600

If Hours > 0 Then
sPlural = "s"
sComma = ", "
sAnd = "and "
If Hours = 1 Then sPlural = vbNullString
If Seconds = 0 Then sComma = vbNullString
If Seconds <> 0 Or Days = 0 Then sAnd = vbNullString
sHours = StringFormat("{3}{0} hour{1}{2}", Hours, sPlural, sComma, sAnd)
End If

Minutes = Int(Seconds / 60)
Seconds = Seconds Mod 60

If Minutes > 0 Then
sPlural = "s"
sComma = ", "
sAnd = "and "
If Minutes = 1 Then sPlural = vbNullString
If Seconds = 0 Then sComma = vbNullString
If Seconds <> 0 Or (Days = 0 And Hours = 0) Then sAnd = vbNullString
sMinutes = StringFormat("{3}{0} minute{1}{2}", Minutes, sPlural, sComma, sAnd)
End If

If Seconds > 0 Or MS < 1000 Then
sPlural = "s"
sAnd = "and "
If Seconds = 1 Then sPlural = vbNullString
If Days = 0 And Hours = 0 And Minutes = 0 Then sAnd = vbNullString
sSeconds = StringFormat("{2}{0} second{1}", Seconds, sPlural, sAnd)
End If

ConvertTimeInterval = StringFormat("{0}{1}{2}{3}", sDays, sHours, sMinutes, sSeconds)
End Function

0 comments on commit 4ceebbd

Please sign in to comment.
You can’t perform that action at this time.