Possible report file bug.

[PS-SCUD]

There seems to be an inconsistency with what report files are recorded for multiplayer games.

I have several reports from multiplayer games (1 was a Coop which WB hosted, and I dropped from. The other was a HTH Sean hosted.) The rest of my multiplayer reports are missing (3 or 4 games worth).

I believe this may be a bug. I'd be happy to do some experiments with any willing partner to try to discover why reports may not be written at times.

[PS-SCUD]

After further observation I have found that you only get the report files if you drop from the game or quit before it ends.

Why is this? Shouldn't you be able to get the report file when the game ends normally?

[PS-SCUD]

So is anyone going to answer my questions?

[Bluewings]

No . :mrgreen:

Cheers . :3starSK:

[PS-SCUD]

:mad2:

[PS-SCUD]

Option Explicit

''''''''''''''''''''''''''''''' _
Browse window declarations
'''''''''''''''''''''''''''''''

Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260

Private Declare Function SHBrowseForFolder Lib _
"shell32" (lpbi As BrowseInfo) As Long

Private Declare Function SHGetPathFromIDList Lib _
"shell32" (ByVal pidList As Long, ByVal lpBuffer _
As String) As Long

Private Declare Function lstrcat Lib "kernel32" _
Alias "lstrcatA" (ByVal lpString1 As String, ByVal _
lpString2 As String) As Long

Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type


Private Sub CancelButton_Click()
Unload diaCompile
End Sub

'Opens a Browse Folders Dialog Box so the user can easily browse for the
'Report file directory. NOTE: Make the default path the default SB Pro PE
'Install path.
Private Sub cmdBrowse_Click()

Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo

szTitle = "Select the directory where your SB Pro PE report files are stored." & _
" Then click the OK button."

With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With

lpIDList = SHBrowseForFolder(tBrowseInfo)

If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
End If


txtInput.Text = sBuffer

End Sub

Private Sub Form_Load()
'Center form
diaCompile.Left = (Screen.Width - diaCompile.Width) / 2
diaCompile.Top = (Screen.Height - diaCompile.Height) / 2
End Sub

Private Sub OKButton_Click()

Dim strReportDir As String
Dim intCompileResult As Integer

'This program requires a directory that ends in a backslash.
'So if the user doesn't input one, this will append it on.

If (txtInput.Text <> "") Then
If (Mid(txtInput.Text, (Len(txtInput.Text)), 1) <> "\") Then
strReportDir = (txtInput.Text & "\")
Else
strReportDir = txtInput.Text
End If

Else
MsgBox ("Error: You must select a directory first.")
End If

If ((strReportDir <> "\") And (strReportDir <> "")) Then

'Show hourglass
diaCompile.MousePointer = 11

'Compile the files found in the directory that the user selected.
intCompileResult = compileReportFiles(strReportDir)

diaCompile.MousePointer = 0
'Reset curser
If (intCompileResult = 1) Then

With diaCompileSuccess
.passDirectory = strReportDir
.Show
End With
Unload diaCompile
End If

If (intCompileResult = 3) Then
MsgBox "Error: No valid SB Report files were found at this location.", vbExclamation
End If

If (intCompileResult = 4) Then
MsgBox "No files were written to the database, because only outdated files were found." _
& vbNewLine & "If you want to include these files in the database check the 'Write old files' option in the options menu."
End If

End If

End Sub


Option Explicit

Private strReportDir

Public Property Let passDirectory(ByVal strDirectory As String)
strReportDir = strDirectory
End Property


Private Sub lblMessage_Click()

End Sub


Private Sub cmdNo_Click()
Unload diaCompileSuccess
End Sub

Private Sub cmdYes_Click()

Dim loadReturn As Integer

'Show hourglass
diaCompileSuccess.MousePointer = 11

'Load the report database file.
loadReturn = loadDatabase(strReportDir)

diaCompileSuccess.MousePointer = 0
'Reset curser

If (loadReturn = 1) Then
MsgBox ("Database successfully loaded.")
frmMainMenu.loadedSign = True
Unload diaCompileSuccess
End If

End Sub

Private Sub Form_Load()

' Center
diaCompileSuccess.Left = (Screen.Width - diaCompileSuccess.Width) / 2
diaCompileSuccess.Top = (Screen.Height - diaCompileSuccess.Height) / 2

End Sub



Option Explicit

''''''''''''''''''''''''''''''' _
Browse window declarations
'''''''''''''''''''''''''''''''

Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260

Private Declare Function SHBrowseForFolder Lib _
"shell32" (lpbi As BrowseInfo) As Long

Private Declare Function SHGetPathFromIDList Lib _
"shell32" (ByVal pidList As Long, ByVal lpBuffer _
As String) As Long

Private Declare Function lstrcat Lib "kernel32" _
Alias "lstrcatA" (ByVal lpString1 As String, ByVal _
lpString2 As String) As Long

Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Private Sub CancelButton_Click()
Unload diaLoad
End Sub


Private Sub cmdBrowse_Click()

Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo

szTitle = "Select the directory where your SB Pro PE report files are stored." & _
" Then click the OK button."

With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With

lpIDList = SHBrowseForFolder(tBrowseInfo)

If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
End If


txtInput.Text = sBuffer

End Sub

Private Sub Form_Load()
'Center form
diaLoad.Left = (Screen.Width - diaLoad.Width) / 2
diaLoad.Top = (Screen.Height - diaLoad.Height) / 2

End Sub

Private Sub OKButton_Click()
Dim strReportDir As String
Dim loadReturn As Integer

'This program requires a directory that ends in a backslash.
'So if the user doesn't input one, this will append it on.
If (txtInput.Text <> "") Then
If (Mid(txtInput.Text, (Len(txtInput.Text)), 1) <> "\") Then
strReportDir = (txtInput.Text & "\")
Else
strReportDir = txtInput.Text
End If

Else
MsgBox ("Error: You must select a directory first.")
End If


If ((strReportDir <> "\") And (strReportDir <> "")) Then

'Show hourglass
diaLoad.MousePointer = 11

'Load the report database file.
loadReturn = loadDatabase(strReportDir)

diaLoad.MousePointer = 99
'Reset curser

If (loadReturn = 1) Then
frmMainMenu.loadedSign = True
Unload diaLoad
Else
MsgBox ("Error loading stat database.")
End If

End If

End Sub


Option Explicit
Public Property Let loadedSign(ByVal blnLoadedSign As Boolean)
lblStatLoaded.Visible = blnLoadedSign
End Property

Private Sub cmdCompile_Click()
diaCompile.Show
End Sub

Private Sub cmdExit_Click()
End
End Sub

Private Sub cmdLoadStats_Click()
cmdView.SetFocus
diaLoad.Show
End Sub

Private Sub cmdOptions_Click()
frmOptions.Show
End Sub

Private Sub cmdView_Click()

If (lblStatLoaded.Visible = False) Then
MsgBox ("Error: You must load a stat database first.")
Else
frmStats.Show
End If

End Sub

Private Sub Form_Load()
setConstants

'Center form
frmMainMenu.Left = (Screen.Width - frmMainMenu.Width) / 2
frmMainMenu.Top = (Screen.Height - frmMainMenu.Height) / 2

End Sub


Option Explicit

Private Sub cmdCancel_Click()
Unload frmOptions
End Sub


Private Sub chkBackupData_Click()
If (chkBackupData = 1) Then
blnBackupData = True
Else
blnBackupData = False
End If
End Sub

Private Sub chkDelScanned_Click()
If (chkDelScanned = 1) Then
blnDeleteReports = True
Else
blnDeleteReports = False
End If

End Sub

Private Sub chkWriteOld_Click()
If (chkWriteOld = 1) Then
blnWriteOldFiles = True
Else
blnWriteOldFiles = False
End If

End Sub

Private Sub cmdOk_Click()
frmOptions.Hide
End Sub


Option Explicit

Private strUserName As String
Private intFirstEntry As Integer
Private intTotalEntries As Integer
Private intUserIndex As Integer
Private gameType As e_gameType
Private playerSide As e_side
Private blnSelectedUser As Boolean
Private dblStartDate As Double
Private dblEndDate As Double


Private Function getUserList()

Dim intScenario As Integer
Dim intUser As Integer
Dim intListItem As Integer
Dim blnAddToList As Boolean
Dim blnFirstRun As Boolean
Dim strUserName As String
Dim intListedUser As Integer


'''''''''''''''''''''''''''''''''''''' _
Get a list of User names and add them _
to the combo box. If a name is already in _
the combo list, don't add it.
'''''''''''''''''''''''''''''''''''''

'Scan every user in every scenario.
For intScenario = 0 To UBound(theDatabase())
For intUser = 0 To ((theDatabase(intScenario).BluePlayers + _
theDatabase(intScenario).RedPlayers) - 1)

'If it is the first time through the loop, we want to automatically assign
' the user to the first index value.
blnFirstRun = False
If (cboPlayers.ListCount = 0) Then
cboPlayers.AddItem (theDatabase(intScenario).UserData(intUser).Nam e)
blnFirstRun = True
End If


If (blnFirstRun = False) Then
blnAddToList = True

'Don't add duplicate users to the list. Scan each member in the list, and make
'sure that the current user doesn't match.
For intListItem = 0 To (cboPlayers.ListCount - 1)

'If the current user does match, we still want to increment the number of
'Scenarios he has played in.
If (cboPlayers.List(intListItem) = theDatabase(intScenario).UserData(intUser).Name) Then
blnAddToList = False
End If

Next intListItem

'If the user isn't already on the list, add him.
If (blnAddToList = True) Then
cboPlayers.AddItem (theDatabase(intScenario).UserData(intUser).Nam e)
End If
End If

Next intUser
intUser = 0

Next intScenario

End Function


Private Sub cboDate_Click()

Dim endDate, startDate As Date
Dim strStartDay, strStartMonth, strStartYear As String
Dim strEndDay, strEndMonth, strEndYear As String
Dim intRollback As Integer
Dim intStartPos, intEndPos As Integer

Select Case cboDate.Text
Case "Last 7 Days"
intRollback = 7
Case "Last 30 Days"
intRollback = 30
Case "Last 60 Days"
intRollback = 60
Case "Last 365 Days"
intRollback = 365
End Select


endDate = Date
startDate = DateAdd("d", -intRollback, endDate)

intEndPos = InStr(1, startDate, "/", vbTextCompare)
strStartMonth = Mid(startDate, 1, (intEndPos - 1))
intStartPos = (intEndPos + 1)
intEndPos = InStr(intStartPos, startDate, "/", vbTextCompare)

strStartDay = Mid(startDate, intStartPos, (intEndPos - intStartPos))
intStartPos = (intEndPos + 1)
strStartYear = Mid(startDate, intStartPos, (intEndPos + 4))

intEndPos = InStr(1, endDate, "/", vbTextCompare)
strEndMonth = Mid(endDate, 1, (intEndPos - 1))
intStartPos = (intEndPos + 1)
intEndPos = InStr(intStartPos, endDate, "/", vbTextCompare)

strEndDay = Mid(endDate, intStartPos, (intEndPos - intStartPos))
intStartPos = (intEndPos + 1)
strEndYear = Mid(endDate, intStartPos, (intEndPos + 4))

txtStartDay.Text = strStartDay
txtStartMonth.Text = strStartMonth
txtStartYear.Text = strStartYear

txtEndDay.Text = strEndDay
txtEndMonth.Text = strEndMonth
txtEndYear.Text = strEndYear

dblStartDate = DateSerial(Val(strStartYear), Val(strStartMonth), Val(strStartDay))
dblEndDate = DateSerial(Val(strEndYear), Val(strEndMonth), Val(strEndDay))

End Sub

Private Sub cboPlayers_DblClick()

Dim intScenario As Integer
Dim intUser As Integer
Dim intScenarioIndex As Integer
Dim blnFoundUser As Boolean
Dim intTotalEntries As Integer

strUserName = cboPlayers.Text
blnSelectedUser = True
intFirstEntry = 0
intUserIndex = 0

'Find the location of the first scenario the user played in.
'And count the total number of scenarios he played in.
For intScenario = 0 To (UBound(theDatabase()))
For intUser = 0 To (theDatabase(intScenario).RedPlayers + _
theDatabase(intScenario).BluePlayers - 1)

If ((theDatabase(intScenario).UserData(intUser).Na me = strUserName) _
And blnFoundUser = False) Then
intUserIndex = intUser
intFirstEntry = intScenario
blnFoundUser = True
End If

If (theDatabase(intScenario).UserData(intUser).Nam e = strUserName) Then
intTotalEntries = (intTotalEntries + 1)
End If


Next intUser
intUser = 0
Next intScenario


'The first instance of the user will record the location of all the other instances
ReDim theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(0 To intTotalEntries, 0 To 1)

intScenarioIndex = 0
For intScenario = 0 To (UBound(theDatabase()))
For intUser = 0 To (theDatabase(intScenario).RedPlayers + _
theDatabase(intScenario).BluePlayers - 1)
If (theDatabase(intScenario).UserData(intUser).Nam e = strUserName) Then
theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenarioIndex, 0) = _
intScenario
theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenarioIndex, 1) = _
intUser
intScenarioIndex = (intScenarioIndex + 1)
End If
Next intUser
intUser = 0
Next intScenario

End Sub

[PS-SCUD]

Private Sub cmdClearDates_Click()
txtStartDay.Text = ""
txtStartMonth.Text = ""
txtStartYear.Text = ""
txtEndDay.Text = ""
txtEndMonth.Text = ""
txtEndYear.Text = ""
dblStartDate = 0
dblEndDate = 0
End Sub

Private Sub cmdGetStats_Click()
Dim intTotalGames As Integer

If (blnSelectedUser = False) Then
MsgBox "Select a player first."
Exit Sub
End If

lblPlayer1Name.Caption = strUserName
lblTotals.Visible = True
lblPersonalKills.Visible = True
lblPersonalLosses.Visible = True
lblPMRating.Visible = True
lblTotalKills.Visible = True
lblFrats.Visible = True
lblTanksLost.Visible = True
lblTanksCommanded.Visible = True
lblPCsLost.Visible = True
lblPCsCommanded.Visible = True
lblTroopsLost.Visible = True
lblTroopsCommanded.Visible = True
lblOthersLost.Visible = True
lblOthersCommanded.Visible = True
lblShots.Visible = True
lblHits.Visible = True
lblGamesPlayed.Visible = True
lblHoursPlayed.Visible = True


lblPKillsStat.Caption = getUserTotal(intFirstEntry, intUserIndex, Kills, gameType, _
dblStartDate, dblEndDate, , playerSide)

lblPLossesStat.Caption = getUserTotal(intFirstEntry, intUserIndex, Losses, gameType, _
dblStartDate, dblEndDate, , playerSide)

lblPMRatingStat.Caption = getUserTotal(intFirstEntry, intUserIndex, PMRating, gameType, _
dblStartDate, dblEndDate, , playerSide)

If (Val(lblPMRatingStat.Caption) > 0) Then
lblPMRatingSign.Caption = "+"
Else
lblPMRatingStat.Caption = Abs(Val(lblPMRatingStat.Caption))
lblPMRatingSign.Caption = "-"

End If

lblTotalKStat.Caption = getUserTotal(intFirstEntry, intUserIndex, Tkills, gameType, _
dblStartDate, dblEndDate, , playerSide)

lblTanksLostStat.Caption = getUserTotal(intFirstEntry, intUserIndex, TanksLost, gameType, _
dblStartDate, dblEndDate, , playerSide)

lblFratStat.Caption = getUserTotal(intFirstEntry, intUserIndex, Frats, gameType, _
dblStartDate, dblEndDate, , playerSide)

lblTanksLostStat.Caption = getUserTotal(intFirstEntry, intUserIndex, TanksLost, gameType, _
dblStartDate, dblEndDate, , playerSide)

lblTanksCmdStat.Caption = getUserTotal(intFirstEntry, intUserIndex, TotalTanks, gameType, _
dblStartDate, dblEndDate, , playerSide)

lblPCsLostStat.Caption = getUserTotal(intFirstEntry, intUserIndex, PCsLost, gameType, _
dblStartDate, dblEndDate, , playerSide)

lblPCsCommandedStat.Caption = getUserTotal(intFirstEntry, intUserIndex, TotalPCs, gameType, _
dblStartDate, dblEndDate, , playerSide)

lblTroopsLostStat.Caption = getUserTotal(intFirstEntry, intUserIndex, TroopsLost, gameType, _
dblStartDate, dblEndDate, , playerSide)

lblTroopsCmdStat.Caption = getUserTotal(intFirstEntry, intUserIndex, TotalTroops, gameType, _
dblStartDate, dblEndDate, , playerSide)

lblOthersLostStat.Caption = getUserTotal(intFirstEntry, intUserIndex, OthersLost, gameType, _
dblStartDate, dblEndDate, , playerSide)

lblOthersCmdStat.Caption = getUserTotal(intFirstEntry, intUserIndex, TotalOthers, gameType, _
dblStartDate, dblEndDate, , playerSide)

lblShotsStat.Caption = getUserTotal(intFirstEntry, intUserIndex, TotalShots, gameType, _
dblStartDate, dblEndDate, , playerSide)

lblHitsStat.Caption = getUserTotal(intFirstEntry, intUserIndex, TotalHits, gameType, _
dblStartDate, dblEndDate, , playerSide)

lblGamesPlayedStat.Caption = getUserTotal(intFirstEntry, intUserIndex, GamesPlayed, gameType, _
dblStartDate, dblEndDate, , playerSide)

intTotalGames = Val(lblGamesPlayedStat.Caption)

lblHoursPlayedStat.Caption = getUserTotal(intFirstEntry, intUserIndex, HoursPlayed, gameType, _
dblStartDate, dblEndDate, , playerSide)

lblAverages.Visible = True
lblAvgPKills.Visible = True
lblAvgPLosses.Visible = True
lblAvgPMRating.Visible = True
lblAvgTotalKills.Visible = True
lblAvgFrats.Visible = True
lblTankMortality.Visible = True
lblPCMortality.Visible = True
lblTroopMortality.Visible = True
lblOtherMortality.Visible = True
lblAccuracy.Visible = True
lblAvgHoursPlayed.Visible = True


lblAvgPKillsStat.Caption = Round((Val(lblPKillsStat.Caption) / intTotalGames), 2)

lblAvgPLossesStat.Caption = Round((Val(lblPLossesStat.Caption) / intTotalGames), 2)

lblAvgPMRatingStat.Caption = Round((Val(lblPMRatingStat.Caption) / intTotalGames), 2)

If (Val(lblAvgPMRatingStat.Caption) > 0) Then
lblAvgPMRatingSign.Caption = "+"
Else
lblAvgPMRatingStat.Caption = Abs(Val(lblAvgPMRatingStat.Caption))
lblAvgPMRatingSign.Caption = "-"

End If

lblAvgTotalKStat.Caption = Round((Val(lblTotalKStat.Caption) / intTotalGames), 2)

lblAvgFratStat.Caption = Round((Val(lblFratStat.Caption) / intTotalGames), 2)

lblTankMortalityStat.Caption = getUserAverage(intFirstEntry, intUserIndex, TankMortality, gameType _
, dblStartDate, dblEndDate, , playerSide) & "%"

lblPCMortalityStat.Caption = getUserAverage(intFirstEntry, intUserIndex, PCMortality, gameType _
, dblStartDate, dblEndDate, , playerSide) & "%"

lblTroopMortalityStat.Caption = getUserAverage(intFirstEntry, intUserIndex, TroopMortality, gameType _
, dblStartDate, dblEndDate, , playerSide) & "%"

lblOtherMortalityStat.Caption = getUserAverage(intFirstEntry, intUserIndex, OtherMortality, gameType _
, dblStartDate, dblEndDate, , playerSide) & "%"

lblAccuracyStat.Caption = getUserAverage(intFirstEntry, intUserIndex, Accuracy, gameType _
, dblStartDate, dblEndDate, , playerSide) & "%"

lblAvgHoursPlayedStat.Caption = Round((Val(lblHoursPlayedStat.Caption) / _
Val(lblGamesPlayedStat.Caption)), 2)


End Sub

Private Sub cmdMainMenu_Click()

End Sub

Private Sub cmdOKDates_Click()
dblStartDate = DateSerial(Val(txtStartYear.Text), Val(txtStartMonth.Text), Val(txtStartDay.Text))
dblEndDate = DateSerial(Val(txtEndYear.Text), Val(txtEndMonth.Text), Val(txtEndDay.Text))

If ((dblEndDate - dblStartDate) <= 0) Then
MsgBox "Error! Start date does not precede end date."
cmdClearDates.SetFocus
Exit Sub
End If
End Sub

Private Sub Combo1_Change()

End Sub

Private Sub Form_Load()

frmStats.Left = (Screen.Width - frmStats.Width) / 2
frmStats.Top = (Screen.Height - frmStats.Height) / 2

optAllGames.Value = True
optAnySide.Value = True
OptPlayerStat.Value = True

getUserList

End Sub


Private Sub Form_Resize()



'Adjust the scrollbars and form position.
VScroll1.Move Me.ScaleWidth - VScroll1.Width, 0, VScroll1.Width, Me.ScaleHeight
HScroll1.Move 0, Me.ScaleHeight - HScroll1.Height, Me.ScaleWidth - VScroll1.Width, _
HScroll1.Height
pbOuter.Move 0, 0, Me.ScaleWidth - VScroll1.Width, Me.ScaleHeight - HScroll1.Height

'Hide scrollbars if they are unecessary
If pbInner.Height <= pbOuter.Height Then
VScroll1.Visible = False
Else
VScroll1.Visible = True
VScroll1.Max = pbInner.Height - pbOuter.Height
VScroll1.LargeChange = 2500
VScroll1.SmallChange = 500
End If

If pbInner.Width <= pbOuter.Width Then
HScroll1.Visible = False
Else
HScroll1.Visible = True
HScroll1.Max = pbInner.Width - pbOuter.Width
HScroll1.LargeChange = 2500
HScroll1.SmallChange = 250
End If


End Sub

Private Sub HScroll1_Change()
pbInner.Left = -HScroll1.Value
End Sub

Private Sub lblPLosses_Click()

End Sub

Private Sub lblTotalHits_Click()

End Sub

Private Sub lblTotalShots_Click()

End Sub

Private Sub optAllGames_Click()
gameType = AllGames
End Sub

Private Sub optAnySide_Click()
playerSide = AnySide
End Sub

Private Sub optBlueSide_Click()
playerSide = Blue
End Sub

Private Sub optCoop_Click()
gameType = Coop
End Sub

Private Sub optHTH_Click()
gameType = HeadToHead
End Sub

Private Sub optRedSide_Click()
playerSide = Red
End Sub

Private Sub optSP_Click()
gameType = SinglePlayer
End Sub

Private Sub txtEndDay_Change()
Dim numCheck As Integer
numCheck = ValidateNumber(txtEndDay.Text, True, , False)

If (numCheck <> 0) Then
MsgBox ("Incorrect date")
txtEndDay.SelStart = 0
txtEndDay.SelLength = Len(txtEndDay.Text)
End If

If (Len(txtEndDay.Text) = 2 And (numCheck = 0)) Then
txtEndMonth.SetFocus
End If
End Sub

Private Sub txtEndMonth_Change()
Dim numCheck As Integer

numCheck = ValidateNumber(txtEndMonth.Text, True, , False)

If (numCheck <> 0) Then
MsgBox ("Incorrect date")
txtEndMonth.SelStart = 0
txtEndMonth.SelLength = Len(txtEndMonth.Text)
End If

If ((Len(txtEndMonth.Text) = 2) And (numCheck = 0)) Then
txtEndYear.SetFocus
End If
End Sub

Private Sub txtEndYear_Change()
Dim strEndDate As String
Dim numCheck As Integer

numCheck = ValidateNumber(txtEndYear.Text, True, , False)


If (numCheck <> 0) Then
MsgBox ("Incorrect date")
txtEndYear.SelStart = 0
txtEndYear.SelLength = Len(txtEndYear.Text)
End If


If ((Len(txtEndYear.Text) = 4) And (numCheck = 0)) Then
strEndDate = txtEndMonth.Text & "/" & txtEndDay.Text & "/" & txtEndYear.Text

If (IsDate(strEndDate) = False) Then
MsgBox "Invalid date."
cmdClearDates.SetFocus
Exit Sub
End If

cmdOKDates.SetFocus
End If


End Sub

Private Sub txtStartDay_Change()

Dim numCheck As Integer
numCheck = ValidateNumber(txtStartDay.Text, True, , False)

If (numCheck <> 0) Then
MsgBox ("Incorrect date")
txtStartDay.SelStart = 0
txtStartDay.SelLength = Len(txtStartDay.Text)
End If

If (Len(txtStartDay.Text) = 2 And (numCheck = 0)) Then
txtStartMonth.SetFocus
End If
End Sub

Private Sub txtStartMonth_Change()
Dim numCheck As Integer

numCheck = ValidateNumber(txtStartMonth.Text, True, , False)

If (numCheck <> 0) Then
MsgBox ("Incorrect date")
txtStartMonth.SelStart = 0
txtStartMonth.SelLength = Len(txtStartMonth.Text)
End If

If ((Len(txtStartMonth.Text) = 2) And (numCheck = 0)) Then
txtStartYear.SetFocus
End If
End Sub

Private Sub txtStartYear_Change()

Dim strStartDate As String
Dim numCheck As Integer


numCheck = ValidateNumber(txtStartYear.Text, True, , False)


If (numCheck <> 0) Then
MsgBox ("Incorrect date")
txtStartYear.SelStart = 0
txtStartYear.SelLength = Len(txtStartYear.Text)
End If


If ((Len(txtStartYear.Text) = 4) And (numCheck = 0)) Then
strStartDate = txtStartMonth.Text & "/" & txtStartDay.Text & "/" & txtStartYear.Text

If (IsDate(strStartDate) = False) Then
MsgBox "Invalid date."
cmdClearDates.SetFocus
Exit Sub
Else
txtEndDay.SetFocus

End If
End If


End Sub

Private Sub VScroll1_Change()
pbInner.Top = -VScroll1.Value
End Sub


Option Explicit

Private intDatabasePos As Integer

Private strInputFile() As String
Private lngInputFile As Long

Private Const SEGMENTSZ = 4096& 'How many bytes should each segment be broken into
'When loading the database file. 4096 is the minimum recommended size (any smaller _
and you risk corrupting data.) Larger sizes have slower loading times.





' This function will read the sceDatabase file and load it into memory
' Using an array of scenarioStat objects
Public Function loadDatabase(ByVal strReportDir As String) As Integer

'Reset the database position and array.
intDatabasePos = 0
ReDim theDatabase(0 To 0)

Dim strDatabaseFilePath As String
Dim intLoadResult As Integer
Dim intSegmentResult As Integer

strDatabaseFilePath = (strReportDir & "sceDatabase.sst")

intSegmentResult = segmentData(strDatabaseFilePath, strReportDir)

If (intSegmentResult > 1) Then
intLoadResult = loadAllSegments()
End If

If (intSegmentResult = 1) Then
intLoadResult = loadSegment()
End If

If (intSegmentResult < 1) Then
loadDatabase = 0
Exit Function
End If

loadDatabase = intLoadResult
Exit Function

End Function



Private Function mergeLeftovers(ByRef intSegmentNumber As Integer, ByRef blnLeftovers As _
Boolean) As Long

Dim lngLeftOverStart As Long
Dim lngLeftOverLength As Long
Dim lngLeftOverEnd As Long
Dim strPart1 As String
Dim strCombined As String
Dim intRetVal As Integer
Dim lngUserStart As Long
Dim lngUserEnd As Long
Dim intUser As Integer


lngLeftOverStart = InStrRev(strInputFile(intSegmentNumber - 1), OSCEN, SEGMENTSZ, vbBinaryCompare)
lngLeftOverLength = ((SEGMENTSZ + 1) - lngLeftOverStart)
strPart1 = Mid(strInputFile(intSegmentNumber - 1), lngLeftOverStart, lngLeftOverLength)

'Combine the end of one segment with the corresponding start of the next
lngLeftOverStart = 1
lngLeftOverEnd = InStr(lngLeftOverStart, strInputFile(intSegmentNumber), CSCEN, vbBinaryCompare)
lngLeftOverLength = ((lngLeftOverEnd + 1) - lngLeftOverStart)
strCombined = Mid(strInputFile(intSegmentNumber), lngLeftOverStart, lngLeftOverLength)
strCombined = (strPart1 & strCombined)
lngLeftOverLength = Len(strCombined)

lngUserStart = 1

intRetVal = loadScenData(strCombined, lngLeftOverStart, lngLeftOverLength)


ReDim theDatabase(intDatabasePos).UserData(0 To (theDatabase(intDatabasePos).BluePlayers + _
theDatabase(intDatabasePos).RedPlayers - 1))

'Scan each user tag in the scenario.
Do While (intUser < (theDatabase(intDatabasePos).BluePlayers + _
theDatabase(intDatabasePos).RedPlayers))


'Find the first/next user tag
lngUserStart = InStr(lngUserStart, strCombined, OUSER, vbBinaryCompare)
lngUserEnd = InStr(lngUserStart, strCombined, CUSER, vbBinaryCompare)

intRetVal = loadUserData(strCombined, lngUserStart, lngUserEnd, intUser)

lngUserStart = (lngUserStart + 1)
intUser = (intUser + 1)

Loop

If (InStr((lngLeftOverEnd + 1), strInputFile(intSegmentNumber), CSCEN, vbBinaryCompare) = 0) Then
blnLeftovers = True
intSegmentNumber = (intSegmentNumber + 1)
Else
blnLeftovers = False
End If

mergeLeftovers = lngLeftOverEnd
Exit Function
End Function

Private Function scanTag(ByRef strSegment As String, ByVal lngScenarioStart As Long, _
ByVal lngScenarioEnd As Long, ByVal strOpenTag As String, ByVal strCloseTag As String, _
ByVal intTagLength As Integer) As String

[PS-SCUD]

On Error GoTo corruptionError

Dim lngLength As Long
Dim lngStartPos As Long
Dim lngEndPos As Long
lngStartPos = lngScenarioStart
lngEndPos = lngScenarioEnd

lngStartPos = (InStr(lngStartPos, strSegment, strOpenTag, vbBinaryCompare) + intTagLength)
lngEndPos = InStr(lngStartPos, strSegment, strCloseTag, vbBinaryCompare)
lngLength = (lngEndPos - lngStartPos)

scanTag = Mid(strSegment, lngStartPos, lngLength)
Exit Function

corruptionError:

If (Err.Number <> 0) Then
MsgBox "Error reading the database. Possible corruption in file.", vbExclamation
End
Exit Function
End If

End Function



Private Function loadScenData(ByRef strSegment As String, ByVal lngScenarioStart As Long _
, ByVal lngScenarioEnd As Long) As Integer

With theDatabase(intDatabasePos)

.Name = scanTag(strSegment, lngScenarioStart, lngScenarioEnd, ONAME, CNAME, 2)

.Date = scanTag(strSegment, lngScenarioStart, lngScenarioEnd, ODATE, CLDATE, 2)

.StartTime = scanTag(strSegment, lngScenarioStart, lngScenarioEnd, OSTIME, CSTIME, 2)

.EndTime = scanTag(strSegment, lngScenarioStart, lngScenarioEnd, OETIME, CETIME, 2)

.BluePlayers = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, OBLUPL, CBLUPL, 2))
.RedPlayers = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, OREDPL, CREDPL, 2))

.gameType = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, OGTYPE, CGTYPE, 2))

.BlueMissionResult = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OBLRES, CBLRES, 2))
.RedMissionResult = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, ORDRES, CRDRES, 2))

.BlueScore = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, OBLSCR, CBLSCR, 2))
.RedScore = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, ORDSCR, CRDSCR, 2))

.BlueScoreMax = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, OBLSMX, CBLSMX, 2))
.RedScoreMax = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, ORDSMX, CRDSMX, 2))

.BlueKills = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, OBLKLS, CBLKLS, 2))
.RedKills = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, ORDKLS, CRDKLS, 2))

.BlueLost = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, OBLLOS, CBLLOS, 2))
.RedLost = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, ORDLOS, CRDLOS, 2))

.BlueFrat = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, OBLFRT, CBLFRT, 2))
.RedFrat = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, ORDFRT, CRDFRT, 2))

.BlueTSurv = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, OBLTSV, CBLTSV, 3))
.RedTSurv = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, ORDTSV, CRDTSV, 3))

.BlueTtotal = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, OBLTTO, CBLTTO, 3))
.RedTtotal = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, ORDTTO, CRDTTO, 3))

.BluePCSurv = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, OBLPCS, CBLPCS, 3))
.RedPCSurv = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, CRDPCS, CRDPCS, 3))

.BluePCtotal = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, OBLPCT, CBLPCT, 3))
.RedPCtotal = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, ORDPCT, CRDPCT, 3))

.BlueTroopSurv = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, OBLTRS, CBLTRS, 3))
.RedTroopSurv = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, ORDTRS, CRDTRS, 3))

.BlueTroopTotal = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, OBLTRT, CBLTRT, 3))
.RedTroopTotal = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, ORDTRT, CRDTRT, 3))

.BlueTruckSurv = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, OBLTCS, CBLTCS, 3))
.RedTruckSurv = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, ORDTCS, CRDTCS, 3))

.BlueTruckTotal = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, OBLTCT, CBLTCT, 3))
.RedTruckTotal = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, ORDTCT, CRDTCT, 3))

.NetworkOverload = Val(scanTag(strSegment, lngScenarioStart, lngScenarioEnd, ONTOVR, CNTOVR, 3))

End With

loadScenData = 1
Exit Function
End Function



Private Function loadUserData(ByRef strSegment As String, ByVal lngScenarioStart As String, _
ByVal lngScenarioEnd As Long, ByVal intUser As Integer) As Integer

With theDatabase(intDatabasePos).UserData(intUser)

.Name = scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, ONAME, CNAME, 2)

.Team = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OTEAM, CTEAM, 2))

.Score = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OSCORE, CSCORE, 2))

.ScoreMax = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OSCRMX, CSCRMX, 2))

.AvgKtime = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OAVGKT, CAVGKT, 2))

.TotalShots = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OTSHOT, CTSHOT, 2))

.TotalHits = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OTHITS, CTHITS, 2))

.Kills = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OKILLS, CKILLS, 2))

.Losses = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OLOSSES, CLOSSES, 2))

.Frats = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OFRATS, CFRATS, 2))

.Tkills = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OTKILS, CTKILS, 2))

.TanksLost = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OTKLST, CTKLST, 2))

.TotalTanks = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OTKTOT, CTKTOT, 2))

.PCsLost = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OPCLST, CPCLST, 2))

.TotalPCs = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OPCTOT, CPCTOT, 2))

.TroopsLost = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OTRLST, CTRLST, 2))

.TotalTroops = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OTRTOT, CTRTOT, 2))

.OthersLost = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OOTHLS, COTHLS, 2))

.TotalOthers = Val(scanTag(strSegment, lngScenarioStart, _
lngScenarioEnd, OOTHTO, COTHTO, 2))

End With


loadUserData = 1
Exit Function
End Function

'To improve loading performance, the database file is broken up into 4k segments.
'Each block is assigned to an element in the strInputFile array.
Private Function segmentData(ByVal strDatabaseFileName As String, _
ByVal strReportDir As String) As Integer

On Error GoTo IOError

Dim intSegments As Integer
'Dim lngTestBack As Long
Dim lngBlockStart As Long
Dim lngFileLength As Long
Dim lngCounter As Long
Dim errMsg As String

If (Mid((CurDir()), 1, 1) <> Mid(strReportDir, 1, 1)) Then
ChDrive ((Mid(strReportDir, 1, 1)))
End If

ChDir (strReportDir)


lngInputFile = FreeFile

Open strDatabaseFileName For Input As lngInputFile

'lngTestBack = FreeFile
'Open "testback.sst" For Binary As lngTestBack

lngFileLength = LOF(lngInputFile)

If (lngFileLength = 0) Then
MsgBox "Error: The database file is empty", vbExclamation
segmentData = 0
Close lngInputFile
Exit Function
End If

If (lngFileLength > SEGMENTSZ) Then

If ((lngFileLength Mod SEGMENTSZ) = 0) Then 'On the off chance that the file _
' is exaclty divisible by SEGMENTSZ
intSegments = (lngFileLength / SEGMENTSZ)

Else
intSegments = ((lngFileLength \ SEGMENTSZ) + 1)
End If


ReDim strInputFile(0 To (intSegments - 1))
' Resize the array to match the number of segments.



For lngCounter = 0 To ((intSegments - 1))
lngBlockStart = (lngCounter * SEGMENTSZ)


If (lngBlockStart <> 0) Then
' Start at the next SEGMENTSZ character block.
Seek lngInputFile, (lngBlockStart + 1&)
End If


'If there is at least a SEGMENTSZ character block left, then you can write
' the whole thing to a single element
If ((lngFileLength - lngBlockStart) >= SEGMENTSZ) Then
strInputFile(lngCounter) = Input(SEGMENTSZ, lngInputFile)
Else
'If there isn't a whole SEGMENTSZ block left, then write what is left over to the array element.
strInputFile(lngCounter) = Input((lngFileLength - lngBlockStart), lngInputFile)
End If


'Put #lngTestBack, , strInputFile(lngCounter)


Next lngCounter

'Close lngTestBack

Else
intSegments = 1 ' If the size of the file isn't greater than 4k, it can fit in 1 segment.
ReDim strInputFile(0)
strInputFile(0) = Input(lngFileLength, lngInputFile)
End If

segmentData = intSegments

[PS-SCUD]

'''''''''''''''''''''''''''''''''' _
Error Handler _
'''''''''''''''''''''''''''''''''''

IOError:

Const mnErrFileOpen = 55

If (Err.Number <> 0) Then
Select Case Err.Number
Case mnErrFileOpen
Dim msgResponse As Integer
msgResponse = MsgBox("Error: Database already open. Please close any other instances of SST" & vbNewLine _
& ", and make sure the database file is not open.", vbExclamation + vbRetryCancel)

If (msgResponse = 2) Then
segmentData = 0
Exit Function
End If

If (msgResponse = 4) Then
Resume
End If

segmentData = 0
Exit Function

Case Else
errMsg = "Error:"
errMsg = errMsg & " " & Err.Description
MsgBox errMsg, vbExclamation
segmentData = 0
Exit Function

End Select
End If

End Function

Private Function loadAllSegments() As Integer

Dim lngScenarioStart As Long
Dim lngScenarioEnd As Long
Dim lngUserStart As Long
Dim lngUserEnd As Long
Dim lngCounter As Long
Dim lngTotalEntries As Long
Dim intSegmentNumber As Integer
Dim blnLeftovers As Boolean
Dim intRetVal As Integer
Dim intUser As Integer

lngCounter = 0
' Count the number of scenario entries
Do While (lngCounter <= UBound(strInputFile()))

lngScenarioEnd = 1

'As long as VB can find the Close scenario character, there is another entry.
Do While (lngScenarioEnd <> 0)

lngScenarioEnd = InStr(lngScenarioEnd, strInputFile(lngCounter), CSCEN, vbBinaryCompare)

If (lngScenarioEnd <> 0) Then
lngTotalEntries = (lngTotalEntries + 1)
lngScenarioEnd = (lngScenarioEnd + 1)
End If

Loop
lngCounter = (lngCounter + 1)
Loop

'Resize theDatabase to the number of scenarios found in the entry file.
'Each element will hold an entry.
ReDim theDatabase(0 To (lngTotalEntries - 1))

lngCounter = 0

'Exctract the data from each segment in the array
Do While (intSegmentNumber <= UBound(strInputFile()))


lngScenarioStart = 1
lngUserStart = 1

Do While ((blnLeftovers = True))

lngScenarioStart = mergeLeftovers(intSegmentNumber, blnLeftovers)

If (intSegmentNumber > UBound(strInputFile())) Then
loadAllSegments = 1
Exit Function
End If


lngScenarioStart = InStr(lngScenarioStart, strInputFile(intSegmentNumber), OSCEN, vbBinaryCompare)
intDatabasePos = (intDatabasePos + 1)
Loop


lngScenarioEnd = 1

Do While ((InStr(lngScenarioEnd, strInputFile(intSegmentNumber), CSCEN, vbBinaryCompare) <> 0) _
And (blnLeftovers <> True))


'If ScenarioStart is zero here, then it's reached the end of the file.
lngScenarioStart = InStr(lngScenarioStart, strInputFile(intSegmentNumber), OSCEN, vbBinaryCompare)

If (lngScenarioStart = 0) Then
loadAllSegments = 1
Exit Function
End If

lngScenarioEnd = InStr(lngScenarioStart, strInputFile(intSegmentNumber), CSCEN, vbBinaryCompare)

If (blnLeftovers = False) Then


' Get total blue kills
intRetVal = loadScenData(strInputFile(intSegmentNumber), lngScenarioStart, lngScenarioEnd)


'Set the current user tag to the start of the scenario tag.
lngUserStart = lngScenarioStart
intUser = 0

ReDim theDatabase(intDatabasePos).UserData(0 To (theDatabase(intDatabasePos).BluePlayers + _
theDatabase(intDatabasePos).RedPlayers - 1))

'Scan each user tag in the scenario.
Do While (intUser < (theDatabase(intDatabasePos).BluePlayers + _
theDatabase(intDatabasePos).RedPlayers))

'Find the first/next user tag
lngUserStart = InStr(lngUserStart, strInputFile(intSegmentNumber), OUSER, vbBinaryCompare)
lngUserEnd = InStr(lngUserStart, strInputFile(intSegmentNumber), CUSER, vbBinaryCompare)

intRetVal = loadUserData(strInputFile(intSegmentNumber), lngUserStart, lngUserEnd, intUser)

intUser = (intUser + 1)
lngUserStart = (lngUserStart + 1)
If (lngUserStart > lngScenarioEnd) Then
MsgBox ("Error! UserStart Overrun")
End If


Loop




If (InStr((lngScenarioEnd + 1), strInputFile(intSegmentNumber), CSCEN, vbBinaryCompare) = 0) Then
blnLeftovers = True
intDatabasePos = (intDatabasePos + 1)
Else
intDatabasePos = (intDatabasePos + 1)
lngScenarioStart = (lngScenarioStart + 1)
lngScenarioEnd = (lngScenarioEnd + 1)
End If

End If

Loop

intSegmentNumber = (intSegmentNumber + 1)

Loop

Close lngInputFile

loadAllSegments = 1
Exit Function

End Function

Private Function loadSegment() As Integer

Dim lngScenarioStart As Long
Dim lngScenarioEnd As Long
Dim lngUserStart As Long
Dim lngUserEnd As Long
Dim lngTotalEntries As Long
Dim intSegmentNumber As Integer
Dim intRetVal As Integer
Dim intUser As Integer

lngScenarioStart = 1
lngScenarioEnd = 1

'Count the number of entries in the segment block.
Do While (lngScenarioEnd <> 0)

lngScenarioEnd = InStr(lngScenarioEnd, strInputFile(0), CSCEN, vbBinaryCompare)
lngTotalEntries = (lngTotalEntries + 1)
lngScenarioEnd = InStr((lngScenarioEnd + 1), strInputFile(0), CSCEN, vbBinaryCompare)

Loop

ReDim theDatabase(lngTotalEntries - 1)

lngScenarioStart = 1
intSegmentNumber = 0

Do While intSegmentNumber < lngTotalEntries


'Find the first scenario entry.
lngScenarioStart = InStr(lngScenarioStart, strInputFile(0), OSCEN, vbBinaryCompare)

intRetVal = loadScenData(strInputFile(0), lngScenarioStart, lngScenarioEnd)



'''''''''''''''''''''''''''''''''''' _
Extract other data here.
'''''''''''''''''''''''''''''''''''''

'Each userData array in the scenario entry must be resized to hold the total number
'Of users in that scenario.
ReDim theDatabase(intDatabasePos).UserData(0 To (theDatabase(intDatabasePos).BluePlayers + _
theDatabase(intDatabasePos).RedPlayers - 1))


'''''''''''''''''''''''''''''''''''' _
Extract user data here
''''''''''''''''''''''''''''''''''''''

'Set the current user tag to the start of the scenario tag.
lngUserStart = InStr(lngScenarioStart, strInputFile(0), OUSER, vbBinaryCompare)
intUser = 0

'Scan each user tag in the scenario.
Do While (intUser < (theDatabase(intDatabasePos).BluePlayers + _
theDatabase(intDatabasePos).RedPlayers))

'Find the first/next user tag
lngUserStart = InStr(lngUserStart, strInputFile(0), OUSER, vbBinaryCompare)


intRetVal = loadUserData(strInputFile(0), lngUserStart, lngUserEnd, intUser)


'''''''''''''' _
Get the rest of the data here
'''''''''''''''''

intUser = (intUser + 1)
lngUserStart = (lngUserStart + 1)

Loop

lngScenarioStart = (lngScenarioStart + 1)
intDatabasePos = (intDatabasePos + 1)
intSegmentNumber = (intSegmentNumber + 1)


Loop


Close lngInputFile

loadSegment = 1
Exit Function
End Function


'Declare Al_Delaney as God

Option Explicit




Private lngStartPos As Long
Private lngEndPos As Long
Private lngSegmentLength As Long
Private strReportFile As String



' This function will scan each htm report file passed to it, and store
' All the data in a public scenarioStat file

'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''' _
NOTE: These functions scan the HTM files in SEQUENCE _
THE ORDER IN WHICH THEY SCAN FOR VALUES I VERY IMPORTANT _
IF THE FORMAT OF THE HTM FILES IS CHANGED, OR THE SCANNING _
ORDER IS ALTERED, THEN THE RESULTS WILL BE INCORRECT _
most values will mysteriously be reported as zero.
'''''''''''''''''''''''''''''''''''''''''''''''''' '''''''''''


Public Function getScenarioData(ByVal strInputFile) As scenarioStat

Dim intCounter As Integer
Dim theScenario As scenarioStat
strReportFile = strInputFile
lngStartPos = 1

With theScenario
''''''''''''''''''''''''''''''''' _
Get the scenario name
''''''''''''''''''''''''''''''''''

.Name = scanHTM("Name:", ".sce</TD>", 15)

''''''''''''''''''''''''''''''''''' _
Get the scenario date and times
'''''''''''''''''''''''''''''''''''
.Date = scanHTM("Date:", "</TD", 15)

.StartTime = scanHTM("Time:", "</TD", 15)

.EndTime = scanHTM("<TD>", "</TD", 4)

''''''''''''''''''''''''''''''''''' _
Get the total number of players
'''''''''''''''''''''''''''''''''''

.BluePlayers = countPlayers(Blue)
.RedPlayers = countPlayers(Red)

End With
''''''''''''''''''''''''''''''''''' _
Get each side's roster
''''''''''''''''''''''''''''''''''

For intCounter = 0 To (theScenario.BluePlayers - 1)
theScenario.BlueRoster(intCounter) = getRoster(Blue, intCounter)
Next intCounter

For intCounter = 0 To (theScenario.RedPlayers - 1)
theScenario.RedRoster(intCounter) = getRoster(Red, intCounter)
Next intCounter


''''''''''''''''''''''''''''''''''' _
Get the game type: Either SP, COOP, HTH, or MissionEditor ( _
Editor stats are summarily thrown out.)
'''''''''''''''''''''''''''''''''''

If ((theScenario.BluePlayers + theScenario.RedPlayers) <> 0) Then
theScenario.gameType = findGameType()

Else
theScenario.gameType = MissionEditor 'Trash these stats.
getScenarioData = theScenario
Exit Function 'Exit to the calling function. Once it sees the MissionEditor flag,
' it will know to dump the stats out, and skip to the next file.
End If


''''''''''''''''''''''''''''''''''' _
Get blue mission result (May need to be appended later.)
'''''''''''''''''''''''''''''''''''

Select Case (scanHTM("Score:", "<", 17))
Case "MISSION COMPLETE"
theScenario.BlueMissionResult = MissionComplete
Case "MAJOR DEFEAT"
theScenario.BlueMissionResult = MajorDefeat
Case "DEFEAT"
theScenario.BlueMissionResult = Defeat

End Select

[PS-SCUD]

''''''''''''''''''''''''''''''''''' _
Get the blue and red scores
'''''''''''''''''''''''''''''''''''

With theScenario
' Since the file is scanned sequencially (for efficiencies sake) all blue
' data is gathered first.

'The Blue score starts at the first parenthesis in the file.

.BlueScore = Val(scanHTM("(", " "))

.BlueScoreMax = Val(scanHTM("of", ")", 2))


''''''''''''''''''''''''''''''''''' _
Get the blue unit losses and kills
'''''''''''''''''''''''''''''''''''


' Blue Tanks
.BlueTSurv = Val(scanHTM("tanks:", "<", 16))
.BlueTtotal = Val(scanHTM("<", "<", 10))

' Blue PCs
.BluePCSurv = Val(scanHTM("PCs:", "<", 14))
.BluePCtotal = Val(scanHTM("<", "<", 10))

' Blue Troops
.BlueTroopSurv = Val(scanHTM("troops:", "<", 17))
.BlueTroopTotal = Val(scanHTM("<", "<", 10))

' Blue trucks
.BlueTruckSurv = Val(scanHTM("trucks:", "<", 17))
.BlueTruckTotal = Val(scanHTM("<", "<", 10))



' Blue totals: Killed, lost, fratted
.BlueKills = Val(scanHTM("Total kills:", "<", 22))
.BlueLost = Val(scanHTM("Total losses:", "<", 23))
.BlueFrat = Val(scanHTM("Total fratricides:", "<", 28))

End With
''''''''''''''''''''''''''''''''''' _
Get the red unit losses and kills
'''''''''''''''''''''''''''''''''''

'Get red mission result

Select Case (scanHTM("Score:", "<", 17))

Case "MISSION COMPLETE"
theScenario.RedMissionResult = MissionComplete
Case "MAJOR DEFEAT"
theScenario.RedMissionResult = MajorDefeat
Case "DEFEAT"
theScenario.RedMissionResult = Defeat

End Select

With theScenario

'The next parenthesis is the start of the Red score.
.RedScore = Val(scanHTM("(", " "))
.RedScoreMax = Val(scanHTM("of", ")", 2))

' Red tanks
.RedTSurv = Val(scanHTM("tanks:", "<", 16))
.RedTtotal = Val(scanHTM("<", "<", 10))

' Red PCs
.RedPCSurv = Val(scanHTM("PCs:", "<", 14))
.RedPCtotal = Val(scanHTM("<", "<", 10))

' Red Troops
.RedTroopSurv = Val(scanHTM("troops:", "<", 17))
.RedTroopTotal = Val(scanHTM("<", "<", 10))

' Red trucks
.RedTruckSurv = Val(scanHTM("trucks:", "<", 17))
.RedTruckTotal = Val(scanHTM("<", "<", 10))

'Red totals
.RedKills = Val(scanHTM("Total kills:", "<", 22))
.RedLost = Val(scanHTM("Total losses:", "<", 23))
.RedFrat = Val(scanHTM("Total fratricides:", "<", 28))

End With

''''''''''''''''''''''' _
Record network overload stats
'''''''''''''''''''''''
lngStartPos = 1 ' Reset to the start of the file, because "Network overload" may or
' may not exist near the beginning of the report.

' Check the make sure the network was overloaded, if not, assign 0 to the overload variable.
If (InStr(lngStartPos, strReportFile, "network overloaded:", vbTextCompare) <> 0) Then

theScenario.NetworkOverload = Val(scanHTM("network overloaded:", "s", 29))

Else
theScenario.NetworkOverload = 0
End If

getScenarioData = theScenario
Exit Function

End Function





Private Function findGameType() As e_gameType
Dim blnRedPlayers As Boolean
Dim blnBluePlayers As Boolean
Dim blnOnePlayer As Boolean
Dim lngPlaceHolder As Long
blnOnePlayer = True


' (Blue) is only used in parenthesis when it follows a player's name
' So if I search for (Blue) and (Red) respectively, I can find out
' if there are players on both sides.
lngPlaceHolder = InStr(1, strReportFile, "(Blue)", vbTextCompare)

If (InStr(1, strReportFile, "(Blue)", vbTextCompare) <> 0) Then
blnBluePlayers = True
End If


' If there is more than one Blue or Red player, then I know it isn't a SP game.
If (lngPlaceHolder <> 0) Then
If (InStr((lngPlaceHolder + 1), strReportFile, "(Blue)", vbTextCompare) <> 0) Then
blnOnePlayer = False
End If
End If

lngPlaceHolder = InStr(1, strReportFile, "(Red)", vbTextCompare)

If (InStr(1, strReportFile, "(Red)", vbBinaryCompare) <> 0) Then
blnRedPlayers = True
End If

'I've never seen a Coop with only the red side played, but who knows...
If (lngPlaceHolder <> 0) Then
If (InStr((lngPlaceHolder), strReportFile, "(Red)", vbBinaryCompare) <> 0) Then
blnOnePlayer = False
End If
End If

If ((blnRedPlayers = True) And (blnBluePlayers = True)) Then
blnOnePlayer = False
End If

If ((blnRedPlayers = True) And (blnBluePlayers = True)) Then
findGameType = HeadToHead
Exit Function
End If

If (blnOnePlayer = True) Then
findGameType = SinglePlayer
Exit Function
End If

' If there is more than one player in the game, but there are no players on the other side
' then it is a coop.
If ((blnOnePlayer = False) And ((blnRedPlayers = False) Or (blnBluePlayers = False))) Then
findGameType = Coop
Exit Function
End If

End Function




' Count the number of players per side.

Public Function countPlayers(ByVal Team As e_side) As Integer
Dim intBlueCounter As Integer
Dim intRedCounter As Integer
Dim lngPlaceHolder As Long
Dim strTag As String
Dim intTempPlace As Integer
lngPlaceHolder = 1


If (Team = Blue) Then

'Check to see if there are no players (I.E. a mission editor game)
intTempPlace = InStr(lngPlaceHolder, strReportFile, "(Blue)", vbTextCompare)
strTag = Mid(strReportFile, (intTempPlace - 2), 1)

If (strTag = ">") Then
countPlayers = 0
Exit Function
End If

Do While (InStr(lngPlaceHolder, strReportFile, "(Blue)", vbTextCompare) <> 0)
lngPlaceHolder = (InStr(lngPlaceHolder, strReportFile, "(Blue)", vbTextCompare) + 1)
intBlueCounter = intBlueCounter + 1
Loop
countPlayers = intBlueCounter
Exit Function
End If


If (Team = Red) Then

intTempPlace = InStr(lngPlaceHolder, strReportFile, "(Blue)", vbTextCompare)
strTag = Mid(strReportFile, (intTempPlace - 2), 1)

If (strTag = ">") Then
countPlayers = 0
Exit Function
End If

Do While (InStr(lngPlaceHolder, strReportFile, "(Red)", vbTextCompare) <> 0)
lngPlaceHolder = (InStr(lngPlaceHolder, strReportFile, "(Red)", vbTextCompare) + 1)
intRedCounter = intRedCounter + 1
Loop
countPlayers = intRedCounter
Exit Function
End If

End Function



Private Function getRoster(ByVal Team As e_side, ByVal intUserNumber As Integer) As String

Dim lngPlaceHolder As Long
Dim lngNameStart As Long
Dim lngNameEnd As Long
Dim lngLength As Long
Dim intCounter As Integer
Dim strName As String
lngPlaceHolder = 1


If (Team = Blue) Then

For intCounter = 0 To intUserNumber

lngPlaceHolder = InStr(lngPlaceHolder, strReportFile, "(Blue)", vbTextCompare)

If (lngPlaceHolder = 0) Then
Exit Function
End If

lngNameEnd = (lngPlaceHolder - 1)
lngNameStart = InStrRev(strReportFile, ">", lngPlaceHolder, vbTextCompare)
lngNameStart = (lngNameStart + 1)
lngLength = (lngNameEnd - lngNameStart)
strName = Mid(strReportFile, lngNameStart, lngLength)
lngPlaceHolder = (lngPlaceHolder + 1)

getRoster = strName

Next intCounter

Exit Function
End If


If (Team = Red) Then

For intCounter = 0 To intUserNumber

lngPlaceHolder = InStr(lngPlaceHolder, strReportFile, "(Red)", vbTextCompare)

If (lngPlaceHolder = 0) Then
Exit Function
End If

lngNameEnd = (lngPlaceHolder - 1)
lngNameStart = InStrRev(strReportFile, ">", lngPlaceHolder, vbTextCompare)
lngNameStart = (lngNameStart + 1)
lngLength = (lngNameEnd - lngNameStart)
strName = Mid(strReportFile, lngNameStart, lngLength)
lngPlaceHolder = (lngPlaceHolder + 1)

Next intCounter

getRoster = strName

Exit Function
End If


End Function

[PS-SCUD]

Public Function getUserData(ByVal strInputFile As String, ByVal strName As String) As userStat

Dim theUser As userStat
Dim lngRedStart As Long
Dim lngBlueStart As Long

strReportFile = strInputFile

'Record user name
theUser.Name = strName

'Record the user's team
lngStartPos = 1
lngSegmentLength = Len(strName)
lngStartPos = InStr(lngStartPos, strReportFile, strName, vbTextCompare)
lngStartPos = (lngStartPos + lngSegmentLength)

lngBlueStart = InStr(lngStartPos, strReportFile, "(Blue)", vbTextCompare)
If (lngBlueStart = (lngStartPos + 1)) Then
theUser.Team = Blue
End If

lngRedStart = InStr(lngStartPos, strReportFile, "(Red)", vbTextCompare)
If (lngRedStart = (lngStartPos + 1)) Then
theUser.Team = Red
End If

With theUser

'Record the user's score
.Score = Val(scanHTM("Score:", " ", 1, "("))
.ScoreMax = Val(scanHTM("of", ")", 2))


'Record user 's shooting stats
.TotalHits = Val(scanHTM("Hit Percentage:", " ", 1, "("))
.TotalShots = Val(scanHTM("of", ")", 2))

'Record user 's avg kill time
.AvgKtime = Val(scanHTM("Average time to kill (seconds):", "<", 42))

'Record user 's personal kills
.Kills = Val(scanHTM("User kills:", "<", 22))

'Record user 's personal losses
.Losses = Val(scanHTM("User losses:", "<", 23))

'Record user 's frats
.Frats = Val(scanHTM("User fratricide:", "<", 27))

'Record user 's Total kills
.Tkills = Val(scanHTM("Total kills:", "<", 23))

End With

'User 's tank stats
If ((InStr(lngStartPos, strReportFile, "Total losses - tanks:", vbTextCompare) <> 0) And _
(InStr(lngStartPos, strReportFile, "Total losses - tanks:", vbTextCompare) < (lngStartPos + 300))) Then
' Make sure he has tanks listed before trying to scan for them.

theUser.TanksLost = Val(scanHTM("Total losses - tanks:", " ", 1, "("))
theUser.TotalTanks = Val(scanHTM("of", ")", 2))
Else
theUser.TanksLost = 0
theUser.PCsLost = 0
End If


'User 's PC stats
If ((InStr(lngStartPos, strReportFile, "Total losses - PCs:", vbTextCompare) <> 0) And _
(InStr(lngStartPos, strReportFile, "Total losses - PCs:", vbTextCompare) < (lngStartPos + 300))) Then

theUser.PCsLost = Val(scanHTM("Total losses - PCs:", " ", 1, "("))
theUser.TotalPCs = Val(scanHTM("of", ")", 2))

Else
theUser.PCsLost = 0
theUser.TotalPCs = 0
End If

'User 's Troop stats
If ((InStr(lngStartPos, strReportFile, "Total losses - troops:", vbTextCompare) <> 0) And _
(InStr(lngStartPos, strReportFile, "Total losses - troops:", vbTextCompare) < (lngStartPos + 300))) Then

theUser.TroopsLost = Val(scanHTM("Total losses - troops:", " ", 1, "("))
theUser.TotalTroops = Val(scanHTM("of", ")", 2))

Else
theUser.TroopsLost = 0
theUser.TotalTroops = 0
End If

'User 's Others stats
If ((InStr(lngStartPos, strReportFile, "Total losses - others:", vbTextCompare) <> 0) And _
(InStr(lngStartPos, strReportFile, "Total losses - others:", vbTextCompare) < (lngStartPos + 300))) Then

theUser.OthersLost = Val(scanHTM("Total losses - others:", " ", 1, "("))
theUser.TotalOthers = Val(scanHTM("of", ")", 2))

Else
theUser.OthersLost = 0
theUser.TotalOthers = 0
End If

getUserData = theUser
Exit Function
End Function

Private Function scanHTM(ByVal strStartCharacters, strEndCharacters As String, _
Optional ByVal intOffset As Integer, Optional ByVal strSecondStartChar As String) As String

If (intOffset = 0) Then
lngStartPos = InStr(lngStartPos, strReportFile, strStartCharacters, vbTextCompare)
If (strSecondStartChar <> "") Then
lngStartPos = InStr(lngStartPos, strReportFile, strSecondStartChar, vbTextCompare)
End If
lngEndPos = InStr(lngStartPos, strReportFile, strEndCharacters, vbTextCompare)
lngSegmentLength = (lngEndPos - (lngStartPos + 1))
scanHTM = Mid(strReportFile, (lngStartPos + 1), lngSegmentLength)
Exit Function
Else
lngStartPos = InStr(lngStartPos, strReportFile, strStartCharacters, vbTextCompare)
If (strSecondStartChar <> "") Then
lngStartPos = InStr(lngStartPos, strReportFile, strSecondStartChar, vbTextCompare)
End If
lngStartPos = (lngStartPos + intOffset)
lngEndPos = InStr(lngStartPos, strReportFile, strEndCharacters, vbTextCompare)
lngSegmentLength = (lngEndPos - lngStartPos)
scanHTM = Mid(strReportFile, lngStartPos, lngSegmentLength)
Exit Function
End If



End Function


Option Explicit
'This module contains all functions that average user data


Public Function getUserAverage(ByVal intFirstEntry As Integer, ByVal intUserIndex As Integer, _
ByVal valueType As e_statAttrib, ByVal gameType As e_gameType _
, Optional ByVal minDate As Double, Optional ByVal maxDate As Double, _
Optional ByVal strScenarioName As String, Optional ByVal playerSide As e_side) As Single



Dim sngAvg As Single
Dim sngPercent As Single
Dim intAvgCount As Integer
Dim intScenario As Integer
Dim intUser As Integer
Dim theScenario As Integer
Dim theUser As Integer
Dim intTotalScenarios As Integer
Dim dblSerialDate As Double


intTotalScenarios = UBound(theDatabase(intFirstEntry).UserData(intUser Index).ScenarioList, 1)

'What type of value should be totalled?
Select Case valueType
Case TankMortality 'Count the number of times the user has played on a team.
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

With theDatabase(theScenario).UserData(theUser)

If (.TotalTanks <> 0) Then
sngPercent = (.TanksLost / .TotalTanks)
sngAvg = (sngAvg + sngPercent)
intAvgCount = (intAvgCount + 1)
End If
End With
End If

Next intScenario

If (intAvgCount <> 0) Then
sngAvg = (sngAvg / intAvgCount)
sngAvg = (Round(sngAvg, 2) * 100)
getUserAverage = sngAvg
Exit Function
Else
getUserAverage = 0
Exit Function
End If

Case PCMortality 'Count the number of times the user has played on a team.
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

With theDatabase(theScenario).UserData(theUser)

If (.TotalPCs <> 0) Then
sngPercent = (.PCsLost / .TotalPCs)
sngAvg = (sngAvg + sngPercent)
intAvgCount = (intAvgCount + 1)
End If
End With
End If

Next intScenario

If (intAvgCount <> 0) Then
sngAvg = (sngAvg / intAvgCount)
sngAvg = (Round(sngAvg, 2) * 100)
getUserAverage = sngAvg
Exit Function
Else
getUserAverage = 0
Exit Function
End If

Case TroopMortality 'Count the number of times the user has played on a team.
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

With theDatabase(theScenario).UserData(theUser)

If (.TotalTroops <> 0) Then
sngPercent = (.TroopsLost / .TotalTroops)
sngAvg = (sngAvg + sngPercent)
intAvgCount = (intAvgCount + 1)
End If
End With
End If

Next intScenario

If (intAvgCount <> 0) Then
sngAvg = (sngAvg / intAvgCount)
sngAvg = (Round(sngAvg, 2) * 100)
getUserAverage = sngAvg
Exit Function
Else
getUserAverage = 0
Exit Function
End If

Case OtherMortality 'Count the number of times the user has played on a team.
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

With theDatabase(theScenario).UserData(theUser)

If (.TotalOthers <> 0) Then
sngPercent = (.OthersLost / .TotalOthers)
sngAvg = (sngAvg + sngPercent)
intAvgCount = (intAvgCount + 1)
End If
End With
End If

Next intScenario

If (intAvgCount <> 0) Then
sngAvg = (sngAvg / intAvgCount)
sngAvg = (Round(sngAvg, 2) * 100)
getUserAverage = sngAvg
Exit Function
Else
getUserAverage = 0
Exit Function
End If

Case Accuracy 'Count the number of times the user has played on a team.
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

With theDatabase(theScenario).UserData(theUser)

If (.TotalShots <> 0) Then
sngPercent = (.TotalHits / .TotalShots)
sngAvg = (sngAvg + sngPercent)
intAvgCount = (intAvgCount + 1)
End If
End With
End If

Next intScenario

If (intAvgCount <> 0) Then
sngAvg = (sngAvg / intAvgCount)
sngAvg = (Round(sngAvg, 2) * 100)
getUserAverage = sngAvg
Exit Function
Else
getUserAverage = 0
Exit Function
End If

End Select


End Function

[PS-SCUD]

Option Explicit
'This module contains all functions that total user data
' I.E. get total kills, losses, shots, hits, red teams played on...


Public Function getUserTotal(ByVal intFirstEntry As Integer, ByVal _
intUserIndex As Integer, ByVal valueType As e_statAttrib, ByVal gameType As e_gameType _
, Optional ByVal minDate As Double, Optional ByVal maxDate As Double, _
Optional ByVal strScenarioName As String, Optional ByVal playerSide As e_side) As Variant

Dim lngTotal As Long
Dim sngTotal As Single
Dim intScenario As Integer
Dim intUser As Integer
Dim theScenario As Integer
Dim theUser As Integer
Dim intTotalScenarios As Integer
Dim dblSerialDate As Double


intTotalScenarios = UBound(theDatabase(intFirstEntry).UserData(intUser Index).ScenarioList, 1)

'What type of value should be totalled?
Select Case valueType
Case Team 'Count the number of times the user has played on a team.
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + 1)
End If

Next intScenario

getUserTotal = lngTotal
Exit Function

Case Score
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= theDatabase(theScenario).Date Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + theDatabase(theScenario).UserData(theUser).Score)
End If

Next intScenario

getUserTotal = lngTotal
Exit Function

Case ScoreMax
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + theDatabase(theScenario).UserData(theUser).ScoreMa x)
End If

Next intScenario

getUserTotal = lngTotal
Exit Function

Case AvgKtime
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + theDatabase(theScenario).UserData(theUser).AvgKtim e)
End If

Next intScenario

getUserTotal = (lngTotal / intScenario)
Exit Function


Case TotalShots
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + theDatabase(theScenario).UserData(theUser).TotalSh ots)
End If

Next intScenario

getUserTotal = lngTotal
Exit Function

Case TotalHits
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + theDatabase(theScenario).UserData(theUser).TotalHi ts)
End If

Next intScenario

getUserTotal = lngTotal
Exit Function

Case Kills
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + theDatabase(theScenario).UserData(theUser).Kills)
End If

Next intScenario

getUserTotal = lngTotal
Exit Function

Case Losses
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + theDatabase(theScenario).UserData(theUser).Losses)
End If

Next intScenario

getUserTotal = lngTotal
Exit Function

Case Frats
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + theDatabase(theScenario).UserData(theUser).Frats)
End If

Next intScenario

getUserTotal = lngTotal
Exit Function

Case Tkills
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + theDatabase(theScenario).UserData(theUser).Tkills)
End If

Next intScenario

getUserTotal = lngTotal
Exit Function

Case TanksLost
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + theDatabase(theScenario).UserData(theUser).TanksLo st)
End If

Next intScenario

getUserTotal = lngTotal
Exit Function

Case TotalTanks
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + theDatabase(theScenario).UserData(theUser).TotalTa nks)
End If

Next intScenario

getUserTotal = lngTotal

Exit Function

Case PCsLost
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + theDatabase(theScenario).UserData(theUser).PCsLost )
End If

Next intScenario

getUserTotal = lngTotal
Exit Function

Case TotalPCs
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + theDatabase(theScenario).UserData(theUser).TotalPC s)
End If

Next intScenario

getUserTotal = lngTotal
Exit Function

Case TroopsLost
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + theDatabase(theScenario).UserData(theUser).TroopsL ost)
End If

Next intScenario

getUserTotal = lngTotal
Exit Function

Case TotalTroops

For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + theDatabase(theScenario).UserData(theUser).TotalTr oops)
End If

Next intScenario

getUserTotal = lngTotal
Exit Function

Case OthersLost
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + theDatabase(theScenario).UserData(theUser).OthersL ost)
End If

Next intScenario

getUserTotal = lngTotal
Exit Function

Case TotalOthers
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + theDatabase(theScenario).UserData(theUser).TotalOt hers)
End If

Next intScenario

getUserTotal = lngTotal
Exit Function

Case PMRating
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

sngTotal = (sngTotal + getPM(theScenario, theUser))
End If

Next intScenario

getUserTotal = sngTotal
Exit Function

Case GamesPlayed
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

lngTotal = (lngTotal + 1)
End If

Next intScenario

getUserTotal = lngTotal
Exit Function

Case HoursPlayed
For intScenario = 0 To (intTotalScenarios - 1)

theScenario = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 0)
theUser = theDatabase(intFirstEntry).UserData(intUserIndex). ScenarioList(intScenario, 1)
dblSerialDate = theDatabase(theScenario).Date

If ((theDatabase(theScenario).gameType = gameType Or gameType = AllGames) And _
(minDate <= dblSerialDate Or minDate = 0) And (maxDate >= _
dblSerialDate Or maxDate = 0) And (strScenarioName = _
theDatabase(theScenario).Name Or strScenarioName = "") And _
(theDatabase(theScenario).UserData(theUser).Tea m = playerSide Or playerSide = 0)) Then

sngTotal = (sngTotal + getHours(theScenario))
End If

Next intScenario

getUserTotal = sngTotal
Exit Function


End Select

'Error, invalid attribute chosen.
getUserTotal = -1
MsgBox ("Error: Invalid attribute")

End Function

[PS-SCUD]

Private Function getPM(ByVal theScenario As Integer, ByVal theUser As Integer) As Single

With theDatabase(theScenario).UserData(theUser)

If (.TotalPCs = 0 And .TotalTroops = 0 And .TotalOthers = 0) Then
If (.Tkills > (1.25 * .Kills))