Index:
- Introduction
- Description of Use
- Sample Use
- Main Code
- Adding More ScoreType Information
- Using Inverted Scoring
Introduction
For tracking high scores, I cranked out the following code. Feel free to use it as you see fit. It would be nice to give attribution, but hey, whatever. It should work just fine in VB6. Things to tweak would be mostly in the three constants at the top. If you're feeling imaginative, you can tweak the two checksum functions as well. However, that's not too exciting. This should deter your basic punks from bunging with your file. If you're really ambitious, you could hack in some cryptographic hashing code. But that's a whole lot more work, IMHO, and would really muddy the file.
The basic high-score-file format is a checksum on the first line, followed by the score data. This allows the file to be readable as plaintext, but deters your average Joe from altering the data, as it will detect that the contents and the checksum don't match, notify the user of such, and then clear out the high-scores.
Description of Use
To initialize things, call the readScores function. This will populate the global high-score array (g_aHighScores) with the high-scores that it finds. If there's no high-score file, it will zero out the high-score array, populating it with the person "Nobody", with a score of zero, and a bogus timestamp (January 1st, 1900).
From there, in your code, you can make use of a ScoreType object like
Dim myScore As ScoreType
which has three properties...the name, the score, and the date. Twiddle these in your own code as desired. When a game is done and you want to work with it, you can call the addHighScore function like
If addHighScore(myScore) Then
' it was a high score
Else
' it wasn't a high score
End If
Then, when you want to write the high-scores back out to the file, just use the writeScores function. This will regenerate the file. You may want to throw in some extra file-protection checking in case the file is read-only, or for some reason the user doesn't have permission to write to the file.
Sample Use
In short:
Dim myScore as ScoreType
readScores
myScore.sName = "Mike Easter"
myScore.iScore = 100000
myScore.dWhen = Now
If addHighScore(myScore) Then
MsgBox "Yippie! A high score!"
Else
MsgBox "Sorry, chump! Not a high score!"
End If
writeScores
Just toss it into a module and include it in your project.
Main Code
Const HIGH_SCORE_COUNT = 10
' the number of high-scores to track
Const HIGH_SCORE_FILE = "hs.txt"
' the filename in which to keep them
Const CHECKSUM_CAP = 16381 ' arbirary number
' the CHECKSUM_CAP is used in calculating the
' checksum to make sure the user hasn't bunged
' with the file. If we were truely paranoid, we
' would use a cryptographic hash here, but that
' is a lot more work.
Private Type ScoreType
sName As String
iScore As Long
dWhen As Date
End Type
Dim g_aHighScores(HIGH_SCORE_COUNT) As ScoreType
Dim g_score As ScoreType
Private Sub clearScores()
Dim iIndex As Integer
For iIndex = 0 To HIGH_SCORE_COUNT - 1
With g_aHighScores(iIndex)
.sName = "Nobody"
.iScore = 0
.dWhen = #1/1/1900#
End With
Next
End Sub
Private Sub readScores()
Dim iHSFile As Integer
Dim iIndex As Integer
Dim sTemp As String, sHeader As String
clearScores ' start with an empty scoreboard
If Dir(HIGH_SCORE_FILE) <> "" Then ' we have a high-score file
iHSFile = FreeFile
Open HIGH_SCORE_FILE For Input As iHSFile
If Not EOF(iHSFile) Then ' we have stuff in the file
Line Input #iHSFile, sHeader
iIndex = 0
While iIndex < HIGH_SCORE_COUNT And Not EOF(iHSFile)
With g_aHighScores(iIndex)
Input #iHSFile, .sName, .iScore, .dWhen
End With
iIndex = iIndex + 1
Wend
End If
If getWholeChecksum <> sHeader Then
MsgBox "Invalid score file!", vbExclamation, "Internal error"
clearScores
End If
Close #iHSFile
End If
End Sub
Private Function getScoreChecksum(score As ScoreType) As Long
Dim i As Integer
Dim iAccum As Long
Dim iTempScore As Long
iAccum = 0
For i = 1 To Len(score.sName)
iAccum = iAccum + Asc(Mid(score.sName, i, 1))
If iAccum > CHECKSUM_CAP Then
iAccum = iAccum - CHECKSUM_CAP
End If
Next
iTempScore = score.iScore
While iTempScore > CHECKSUM_CAP
iTempScore = iTempScore - CHECKSUM_CAP
Wend
iAccum = iAccum + iTempScore
While iAccum > CHECKSUM_CAP
iAccum = iAccum - CHECKSUM_CAP
Wend
iAccum = iAccum + Month(score.dWhen) + Day(score.dWhen) + Year(score.dWhen)
If iAccum > CHECKSUM_CAP Then iAccum = iAccum - CHECKSUM_CAP
iAccum = iAccum + Hour(score.dWhen) + Minute(score.dWhen) + Second(score.dWhen)
If iAccum > CHECKSUM_CAP Then iAccum = iAccum - CHECKSUM_CAP
getScoreChecksum = iAccum
End Function
Private Function getWholeChecksum() As String
Dim iResult As Long
Dim score As ScoreType
Dim iIndex As Integer
iResult = 0
For iIndex = 0 To HIGH_SCORE_COUNT - 1
iResult = iResult + getScoreChecksum(g_aHighScores(iIndex))
If iResult > CHECKSUM_CAP Then
iResult = iResult - CHECKSUM_CAP
End If
Next
getWholeChecksum = iResult
End Function
Private Sub writeScores()
Dim sHeader As String
Dim iIndex As Integer
Dim iHSFile As Integer
sHeader = getWholeChecksum
iHSFile = FreeFile
Open HIGH_SCORE_FILE For Output As #iHSFile
Print #iHSFile, sHeader
For iIndex = 0 To HIGH_SCORE_COUNT - 1
With g_aHighScores(iIndex)
Write #iHSFile, .sName, .iScore, .dWhen
End With
Next
Close #iHSFile
End Sub
Private Function addHighScore(score As ScoreType) As Boolean
Dim iIndex As Integer
Dim iInsertionPointIndex As Integer
iInsertionPointIndex = 0
Do While iInsertionPointIndex < HIGH_SCORE_COUNT
If score.iScore > g_aHighScores(iInsertionPointIndex).iScore Then
Exit Do
End If
iInsertionPointIndex = iInsertionPointIndex + 1
Loop
If iInsertionPointIndex < HIGH_SCORE_COUNT Then
' it's on the list
' push the others down
For iIndex = HIGH_SCORE_COUNT - 2 To iInsertionPointIndex Step -1
g_aHighScores(iIndex + 1) = g_aHighScores(iIndex)
Next
g_aHighScores(iInsertionPointIndex) = score
addHighScore = True
Else
addHighScore = False
End If
End Function
Adding More ScoreType Information
If you want to add other properties to a ScoreType object, make sure that you do the following
add the extra information to the definition of the ScoreType object
the getScoreChecksum function takes the new field(s) into consideration
the readScores and writeScores functions input and output the proper information.
Using Inverted Scoring
In some games such as Golf or Hearts, the lowest score wins. To track this, you can do the following.
In the clearScores function, change the default score:
With g_aHighScores(iIndex)
.sName = "Nobody"
.iScore = 0
.dWhen = #1/1/1900#
End With
and change the .iScore = 0 line so that it's some absurdly large value. IIRC, a Long can handle up to (232 - 1) although it might only be (231 - 1). But any large value should do, such as
.iScore = 10000000
Then in the addHighScore function, change the score comparison from greater-than to less-than in the comparison line:
If score.iScore > g_aHighScores(iInsertionPointIndex).iScore Then
Exit Do
End If