Skip to content

Commit

Permalink
Use the data type "Currency" to store 64-bit result of GetTickCount64…
Browse files Browse the repository at this point in the history
…() 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 4ceebbd
Show file tree
Hide file tree
Showing 12 changed files with 148 additions and 108 deletions.
9 changes: 5 additions & 4 deletions trunk/clsDataStorage.cls
Expand Up @@ -31,7 +31,7 @@ Private m_MCPHandler As clsMCPHandler
Private m_FirstTimeChat As Boolean Private m_FirstTimeChat As Boolean
Private m_AccountEntry As Boolean Private m_AccountEntry As Boolean
Private m_AccountEntryPending As Boolean Private m_AccountEntryPending As Boolean
Private m_LastPingResponse As Double Private m_LastPingResponse As Currency


Public Sub List() Public Sub List()
With frmChat With frmChat
Expand Down Expand Up @@ -89,7 +89,8 @@ Public Property Let ClientToken(lData As Long)
m_ClientToken = lData m_ClientToken = lData
End Property End Property
Public Property Get ClientToken() As Long 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 ClientToken = m_ClientToken
End Property End Property


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


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


Expand Down
22 changes: 16 additions & 6 deletions trunk/clsScriptSupportClass.cls
Expand Up @@ -386,12 +386,10 @@ End Function


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




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


'// GETCONNECTIONUPTIME '// GETCONNECTIONUPTIME
'// Returns the amount of time your bot has been online '// Returns the amount of time your bot has been online
Public Function GetConnectionUptime() As String 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 End Function


'// CRC32 '// CRC32
Expand Down
8 changes: 4 additions & 4 deletions trunk/clsUserEventObj.cls
Expand Up @@ -17,7 +17,7 @@ Attribute VB_Exposed = False
Option Explicit Option Explicit


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


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


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


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




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


Expand Down
15 changes: 7 additions & 8 deletions trunk/frmChat.frm
Expand Up @@ -2304,6 +2304,7 @@ End Sub
Sub Event_BNetDisconnected() Sub Event_BNetDisconnected()
tmrIdleTimer.Enabled = False tmrIdleTimer.Enabled = False
UpTimer.Enabled = False UpTimer.Enabled = False
ConnectionTickCount = 0@
BotVars.JoinWatch = 0 BotVars.JoinWatch = 0


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


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


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


ElseIf IdleType = "uptime" Then 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 ElseIf IdleType = "mp3" Then
Dim WindowTitle As String Dim WindowTitle As String
Expand Down Expand Up @@ -6569,8 +6570,6 @@ Private Sub UpTimer_Timer()
Dim i As Integer Dim i As Integer
Dim pos As Integer Dim pos As Integer
Dim doCheck As Boolean Dim doCheck As Boolean

uTicks = (uTicks + 1000)


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


uTicks = 0 ConnectionTickCount = 0@


UserCancelledConnect = False UserCancelledConnect = False


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


BNLSAuthorized = False BNLSAuthorized = False
uTicks = 0 ConnectionTickCount = 0@


mnuSepZ.Visible = False mnuSepZ.Visible = False
mnuIgnoreInvites.Visible = False mnuIgnoreInvites.Visible = False
Expand Down
4 changes: 2 additions & 2 deletions trunk/modBNCS.bas
Expand Up @@ -832,9 +832,9 @@ On Error GoTo ERROR_HANDLER:
Cookie = pBuff.GetDWORD Cookie = pBuff.GetDWORD


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


Expand Down
16 changes: 8 additions & 8 deletions trunk/modChatQueue.bas
Expand Up @@ -16,9 +16,9 @@ End Sub
Public Function ChatQueueTimerProc() Public Function ChatQueueTimerProc()


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


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


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


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


If (CurrentUser.Queue.Count > 0) Then 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 CurrentUser.DisplayQueue
End If End If
End If End If
Next I Next i


Set CurrentUser = Nothing Set CurrentUser = Nothing
End Function End Function
8 changes: 6 additions & 2 deletions trunk/modCommandsInfo.bas
Expand Up @@ -267,7 +267,7 @@ Public Sub OnInfo(Command As clsCommandObj)
.DisplayName, ProductCodeToFullName(.Game), _ .DisplayName, ProductCodeToFullName(.Game), _
IIf(.IsOperator, "ops, and ", vbNullString), .Ping) 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 End With
Else Else
Command.Respond "No such user is present." Command.Respond "No such user is present."
Expand Down Expand Up @@ -660,7 +660,11 @@ Public Sub OnTrigger(Command As clsCommandObj)
End Sub End Sub


Public Sub OnUptime(Command As clsCommandObj) 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 End Sub


Public Sub OnWhere(Command As clsCommandObj) Public Sub OnWhere(Command As clsCommandObj)
Expand Down
113 changes: 93 additions & 20 deletions trunk/modDateTime.bas
Expand Up @@ -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 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 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 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 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 Declare Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)


Public ConnectionTickCount As Currency

Private Const TIME_ZONE_ID_UNKNOWN = 0 Private Const TIME_ZONE_ID_UNKNOWN = 0
Private Const TIME_ZONE_ID_STANDARD = 1 Private Const TIME_ZONE_ID_STANDARD = 1
Private Const TIME_ZONE_ID_DAYLIGHT = 2 Private Const TIME_ZONE_ID_DAYLIGHT = 2
Expand Down Expand Up @@ -43,23 +45,6 @@ Private Type TIME_ZONE_INFORMATION
DaylightBias As Long DaylightBias As Long
End Type 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 Public Function UtcNow() As Date
UtcNow = SystemTimeToDate(GetSystemTime()) UtcNow = SystemTimeToDate(GetSystemTime())
End Function End Function
Expand Down Expand Up @@ -90,7 +75,7 @@ End Function


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


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


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


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


GetTimeZoneName = str GetTimeZoneName = str
End Function 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.