VERSION 5.00
Begin VB.Form frmStats 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "CGSC Statistics"
   ClientHeight    =   1785
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   2700
   MaxButton       =   0   'False
   ScaleHeight     =   1785
   ScaleWidth      =   2700
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdProcess 
      Caption         =   "&Process"
      Height          =   375
      Left            =   60
      TabIndex        =   1
      Top             =   1380
      Width           =   1275
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "&Close"
      Height          =   375
      Left            =   1380
      TabIndex        =   0
      Top             =   1380
      Width           =   1275
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "DISKS"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Index           =   4
      Left            =   480
      TabIndex        =   11
      Top             =   1020
      Width           =   570
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "BLOCKS"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Index           =   3
      Left            =   480
      TabIndex        =   5
      Top             =   780
      Width           =   735
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "WDS"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Index           =   2
      Left            =   480
      TabIndex        =   4
      Top             =   540
      Width           =   450
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "STR"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Index           =   1
      Left            =   480
      TabIndex        =   3
      Top             =   300
      Width           =   390
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "MUS"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Index           =   0
      Left            =   480
      TabIndex        =   2
      Top             =   60
      Width           =   420
   End
   Begin VB.Label lblDISKS 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "0"
      Height          =   195
      Left            =   1200
      TabIndex        =   10
      Top             =   1020
      Width           =   855
   End
   Begin VB.Label lblBLOCKS 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "0"
      Height          =   195
      Left            =   1200
      TabIndex        =   9
      Top             =   780
      Width           =   855
   End
   Begin VB.Label lblWDS 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "0"
      Height          =   195
      Left            =   1200
      TabIndex        =   8
      Top             =   540
      Width           =   855
   End
   Begin VB.Label lblSTR 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "0"
      Height          =   195
      Left            =   1200
      TabIndex        =   7
      Top             =   300
      Width           =   855
   End
   Begin VB.Label lblMUS 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "0"
      Height          =   195
      Left            =   1200
      TabIndex        =   6
      Top             =   60
      Width           =   855
   End
Attribute VB_Name = "frmStats"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'This program can be used to display
'the number of MUS, STR and WDS files
'in the Compute's Gazette SID Collection.
Private mlngMUS As Long
Private mlngSTR As Long
Private mlngWDS As Long
Private mlngBlocks As Long
Private Sub cmdClose_Click()
    Unload Me
End Sub
Private Sub cmdProcess_Click()
    Dim strROOT As String
    Dim i As Integer
    mlngMUS = 0
    mlngSTR = 0
    mlngWDS = 0
    mlngBlocks = 0
    Me.MousePointer = vbHourglass
    cmdProcess.Enabled = False
    cmdClose.Enabled = False
    Call UpdateDisplay
    strROOT = UCase$(App.Path)
    i = InStr(strROOT, "\00_UTILS\")
    If i = 0 Then
        MsgBox "Cannot find the location of the CGSC root directory.", vbCritical
        cmdProcess.Enabled = True
        cmdClose.Enabled = True
        Exit Sub
    End If
    strROOT = Left$(strROOT, i)
    Call ProcessDir(strROOT)
    Call UpdateDisplay
    cmdProcess.Enabled = True
    cmdClose.Enabled = True
    Me.MousePointer = vbDefault
End Sub
Private Sub UpdateDisplay()
    lblMUS = "" & mlngMUS
    lblSTR = "" & mlngSTR
    lblWDS = "" & mlngWDS
    lblBLOCKS = "" & mlngBlocks
    lblDISKS = "" & Int(mlngBlocks / 660 + 0.9999)
    DoEvents
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If cmdClose.Enabled = False Then Cancel = True
End Sub
Private Sub ProcessDir(ByVal strDIR As String)
    Dim cDIRLIST As Collection
    Dim strCurrent As String
    Dim strTemp As String
    Dim varTemp As Variant
    Dim lngSize As Long
    Dim lngSizeB As Long
    Dim i As Integer
    Set cDIRLIST = New Collection
    strTemp = Dir$(strDIR & "*.*", vbDirectory)
    Do Until strTemp = ""
        If strTemp <> "." And strTemp <> ".." Then
            If (GetAttr(strDIR & strTemp) Or vbDirectory) = vbDirectory Then
                cDIRLIST.Add strDIR & strTemp & "\"
            Else
                lngSize = FileLen(strDIR & strTemp)
                lngSizeB = Int(lngSize / 254 + 0.9999)
                Select Case UCase$(Right$(strDIR & strTemp, 4))
                Case ".MUS"
                    mlngMUS = mlngMUS + 1
                    mlngBlocks = mlngBlocks + lngSizeB
                Case ".STR"
                    mlngSTR = mlngSTR + 1
                    mlngBlocks = mlngBlocks + lngSizeB
                Case ".WDS"
                    mlngWDS = mlngWDS + 1
                    mlngBlocks = mlngBlocks + lngSizeB
                End Select
            End If
        End If
        strTemp = Dir$()
    Loop
    For Each varTemp In cDIRLIST
        Call ProcessDir(varTemp)
    Next varTemp
    Set cDIRLIST = Nothing
End Sub