home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / computes-gazette-sid-collections / CGSC / 00_Utils / Stats / Stats.frm (.txt) next >
Visual Basic Form  |  2019-04-13  |  9KB  |  269 lines
  1. VERSION 5.00
  2. Begin VB.Form frmStats 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "CGSC Statistics"
  5.    ClientHeight    =   1785
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   2700
  9.    MaxButton       =   0   'False
  10.    ScaleHeight     =   1785
  11.    ScaleWidth      =   2700
  12.    StartUpPosition =   2  'CenterScreen
  13.    Begin VB.CommandButton cmdProcess 
  14.       Caption         =   "&Process"
  15.       Height          =   375
  16.       Left            =   60
  17.       TabIndex        =   1
  18.       Top             =   1380
  19.       Width           =   1275
  20.    End
  21.    Begin VB.CommandButton cmdClose 
  22.       Caption         =   "&Close"
  23.       Height          =   375
  24.       Left            =   1380
  25.       TabIndex        =   0
  26.       Top             =   1380
  27.       Width           =   1275
  28.    End
  29.    Begin VB.Label Label1 
  30.       AutoSize        =   -1  'True
  31.       BackStyle       =   0  'Transparent
  32.       Caption         =   "DISKS"
  33.       BeginProperty Font 
  34.          Name            =   "MS Sans Serif"
  35.          Size            =   8.25
  36.          Charset         =   0
  37.          Weight          =   700
  38.          Underline       =   0   'False
  39.          Italic          =   0   'False
  40.          Strikethrough   =   0   'False
  41.       EndProperty
  42.       Height          =   195
  43.       Index           =   4
  44.       Left            =   480
  45.       TabIndex        =   11
  46.       Top             =   1020
  47.       Width           =   570
  48.    End
  49.    Begin VB.Label Label1 
  50.       AutoSize        =   -1  'True
  51.       BackStyle       =   0  'Transparent
  52.       Caption         =   "BLOCKS"
  53.       BeginProperty Font 
  54.          Name            =   "MS Sans Serif"
  55.          Size            =   8.25
  56.          Charset         =   0
  57.          Weight          =   700
  58.          Underline       =   0   'False
  59.          Italic          =   0   'False
  60.          Strikethrough   =   0   'False
  61.       EndProperty
  62.       Height          =   195
  63.       Index           =   3
  64.       Left            =   480
  65.       TabIndex        =   5
  66.       Top             =   780
  67.       Width           =   735
  68.    End
  69.    Begin VB.Label Label1 
  70.       AutoSize        =   -1  'True
  71.       BackStyle       =   0  'Transparent
  72.       Caption         =   "WDS"
  73.       BeginProperty Font 
  74.          Name            =   "MS Sans Serif"
  75.          Size            =   8.25
  76.          Charset         =   0
  77.          Weight          =   700
  78.          Underline       =   0   'False
  79.          Italic          =   0   'False
  80.          Strikethrough   =   0   'False
  81.       EndProperty
  82.       Height          =   195
  83.       Index           =   2
  84.       Left            =   480
  85.       TabIndex        =   4
  86.       Top             =   540
  87.       Width           =   450
  88.    End
  89.    Begin VB.Label Label1 
  90.       AutoSize        =   -1  'True
  91.       BackStyle       =   0  'Transparent
  92.       Caption         =   "STR"
  93.       BeginProperty Font 
  94.          Name            =   "MS Sans Serif"
  95.          Size            =   8.25
  96.          Charset         =   0
  97.          Weight          =   700
  98.          Underline       =   0   'False
  99.          Italic          =   0   'False
  100.          Strikethrough   =   0   'False
  101.       EndProperty
  102.       Height          =   195
  103.       Index           =   1
  104.       Left            =   480
  105.       TabIndex        =   3
  106.       Top             =   300
  107.       Width           =   390
  108.    End
  109.    Begin VB.Label Label1 
  110.       AutoSize        =   -1  'True
  111.       BackStyle       =   0  'Transparent
  112.       Caption         =   "MUS"
  113.       BeginProperty Font 
  114.          Name            =   "MS Sans Serif"
  115.          Size            =   8.25
  116.          Charset         =   0
  117.          Weight          =   700
  118.          Underline       =   0   'False
  119.          Italic          =   0   'False
  120.          Strikethrough   =   0   'False
  121.       EndProperty
  122.       Height          =   195
  123.       Index           =   0
  124.       Left            =   480
  125.       TabIndex        =   2
  126.       Top             =   60
  127.       Width           =   420
  128.    End
  129.    Begin VB.Label lblDISKS 
  130.       Alignment       =   1  'Right Justify
  131.       BackStyle       =   0  'Transparent
  132.       Caption         =   "0"
  133.       Height          =   195
  134.       Left            =   1200
  135.       TabIndex        =   10
  136.       Top             =   1020
  137.       Width           =   855
  138.    End
  139.    Begin VB.Label lblBLOCKS 
  140.       Alignment       =   1  'Right Justify
  141.       BackStyle       =   0  'Transparent
  142.       Caption         =   "0"
  143.       Height          =   195
  144.       Left            =   1200
  145.       TabIndex        =   9
  146.       Top             =   780
  147.       Width           =   855
  148.    End
  149.    Begin VB.Label lblWDS 
  150.       Alignment       =   1  'Right Justify
  151.       BackStyle       =   0  'Transparent
  152.       Caption         =   "0"
  153.       Height          =   195
  154.       Left            =   1200
  155.       TabIndex        =   8
  156.       Top             =   540
  157.       Width           =   855
  158.    End
  159.    Begin VB.Label lblSTR 
  160.       Alignment       =   1  'Right Justify
  161.       BackStyle       =   0  'Transparent
  162.       Caption         =   "0"
  163.       Height          =   195
  164.       Left            =   1200
  165.       TabIndex        =   7
  166.       Top             =   300
  167.       Width           =   855
  168.    End
  169.    Begin VB.Label lblMUS 
  170.       Alignment       =   1  'Right Justify
  171.       BackStyle       =   0  'Transparent
  172.       Caption         =   "0"
  173.       Height          =   195
  174.       Left            =   1200
  175.       TabIndex        =   6
  176.       Top             =   60
  177.       Width           =   855
  178.    End
  179. Attribute VB_Name = "frmStats"
  180. Attribute VB_GlobalNameSpace = False
  181. Attribute VB_Creatable = False
  182. Attribute VB_PredeclaredId = True
  183. Attribute VB_Exposed = False
  184. Option Explicit
  185. 'This program can be used to display
  186. 'the number of MUS, STR and WDS files
  187. 'in the Compute's Gazette SID Collection.
  188. Private mlngMUS As Long
  189. Private mlngSTR As Long
  190. Private mlngWDS As Long
  191. Private mlngBlocks As Long
  192. Private Sub cmdClose_Click()
  193.     Unload Me
  194. End Sub
  195. Private Sub cmdProcess_Click()
  196.     Dim strROOT As String
  197.     Dim i As Integer
  198.     mlngMUS = 0
  199.     mlngSTR = 0
  200.     mlngWDS = 0
  201.     mlngBlocks = 0
  202.     Me.MousePointer = vbHourglass
  203.     cmdProcess.Enabled = False
  204.     cmdClose.Enabled = False
  205.     Call UpdateDisplay
  206.     strROOT = UCase$(App.Path)
  207.     i = InStr(strROOT, "\00_UTILS\")
  208.     If i = 0 Then
  209.         MsgBox "Cannot find the location of the CGSC root directory.", vbCritical
  210.         cmdProcess.Enabled = True
  211.         cmdClose.Enabled = True
  212.         Exit Sub
  213.     End If
  214.     strROOT = Left$(strROOT, i)
  215.     Call ProcessDir(strROOT)
  216.     Call UpdateDisplay
  217.     cmdProcess.Enabled = True
  218.     cmdClose.Enabled = True
  219.     Me.MousePointer = vbDefault
  220. End Sub
  221. Private Sub UpdateDisplay()
  222.     lblMUS = "" & mlngMUS
  223.     lblSTR = "" & mlngSTR
  224.     lblWDS = "" & mlngWDS
  225.     lblBLOCKS = "" & mlngBlocks
  226.     lblDISKS = "" & Int(mlngBlocks / 660 + 0.9999)
  227.     DoEvents
  228. End Sub
  229. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  230.     If cmdClose.Enabled = False Then Cancel = True
  231. End Sub
  232. Private Sub ProcessDir(ByVal strDIR As String)
  233.     Dim cDIRLIST As Collection
  234.     Dim strCurrent As String
  235.     Dim strTemp As String
  236.     Dim varTemp As Variant
  237.     Dim lngSize As Long
  238.     Dim lngSizeB As Long
  239.     Dim i As Integer
  240.     Set cDIRLIST = New Collection
  241.     strTemp = Dir$(strDIR & "*.*", vbDirectory)
  242.     Do Until strTemp = ""
  243.         If strTemp <> "." And strTemp <> ".." Then
  244.             If (GetAttr(strDIR & strTemp) Or vbDirectory) = vbDirectory Then
  245.                 cDIRLIST.Add strDIR & strTemp & "\"
  246.             Else
  247.                 lngSize = FileLen(strDIR & strTemp)
  248.                 lngSizeB = Int(lngSize / 254 + 0.9999)
  249.                 Select Case UCase$(Right$(strDIR & strTemp, 4))
  250.                 Case ".MUS"
  251.                     mlngMUS = mlngMUS + 1
  252.                     mlngBlocks = mlngBlocks + lngSizeB
  253.                 Case ".STR"
  254.                     mlngSTR = mlngSTR + 1
  255.                     mlngBlocks = mlngBlocks + lngSizeB
  256.                 Case ".WDS"
  257.                     mlngWDS = mlngWDS + 1
  258.                     mlngBlocks = mlngBlocks + lngSizeB
  259.                 End Select
  260.             End If
  261.         End If
  262.         strTemp = Dir$()
  263.     Loop
  264.     For Each varTemp In cDIRLIST
  265.         Call ProcessDir(varTemp)
  266.     Next varTemp
  267.     Set cDIRLIST = Nothing
  268. End Sub
  269.