VERSION 5.00
Begin VB.Form frmCGSC 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Create HTML index files for CGSC"
   ClientHeight    =   3045
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4680
   MaxButton       =   0   'False
   ScaleHeight     =   3045
   ScaleWidth      =   4680
   StartUpPosition =   2  'CenterScreen
   Begin VB.DirListBox dirMisc 
      Height          =   540
      Left            =   2580
      TabIndex        =   7
      Top             =   2340
      Visible         =   0   'False
      Width           =   555
   End
   Begin VB.FileListBox File1 
      Height          =   675
      Left            =   2520
      Pattern         =   "*.mus"
      TabIndex        =   6
      Top             =   1620
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.DirListBox Dir2 
      Height          =   765
      Left            =   3480
      TabIndex        =   3
      Top             =   1620
      Visible         =   0   'False
      Width           =   1095
   End
   Begin VB.CommandButton cmdStart 
      Caption         =   "&Start"
      Height          =   375
      Left            =   3180
      TabIndex        =   2
      Top             =   2640
      Width           =   1455
   End
   Begin VB.DirListBox Dir1 
      Height          =   2565
      Left            =   60
      TabIndex        =   1
      Top             =   420
      Width           =   2295
   End
   Begin VB.DriveListBox Drive1 
      Height          =   315
      Left            =   60
      TabIndex        =   0
      Top             =   60
      Width           =   2355
   End
   Begin VB.Label lblDir 
      Caption         =   "C:\"
      Height          =   195
      Left            =   2580
      TabIndex        =   5
      Top             =   420
      Visible         =   0   'False
      Width           =   1935
   End
   Begin VB.Label lblProc 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "Processing:"
      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
      Left            =   2580
      TabIndex        =   4
      Top             =   120
      Visible         =   0   'False
      Width           =   1005
   End
End
Attribute VB_Name = "frmCGSC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

 Const charc64 = " !#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~ ¡¢£¤¥¦§¨©ª«¬­®¯°±²³´µ¶·¸¹º»¼½¾¿ÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖ×ØÙÚÛÜÝÞßàáâãäåæçèéêëìíîïðñòóôõö÷øùúûüýþÿ"
Const charibmU = " !#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[$]^<-#|----||\\/\\//\#_#|/XO#|#+||&\ |#--|#|#/||/\\-/--||||---/\\//#-#|----||\\/\\//\#_#|/XO#|#+||&\ |#--|#|#/||/\\-/--||||---/\\//#"
Const charibmL = " !#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[$]^<-abcdefghijklmnopqrstuvwxyz+||&\ |#--|#|#/||/\\-/--||||---/\\//#-abcdefghijklmnopqrstuvwxyz+||&\ |#--|#|#/||/\\-/--||||---/\\//#"

Private Sub cmdStart_Click()
    Dim i As Integer
    Dim j As Integer
    Dim strTemp As String
    
    cmdStart.Enabled = False
    Drive1.Enabled = False
    Dir1.Enabled = False
    lblProc.Visible = True
    lblDir.Visible = True

    Open Dir1.Path & "\index.html" For Output As 10
    Open App.Path & "\header.html" For Input As 9
    Do Until EOF(9)
        Line Input #9, strTemp
        i = InStr(strTemp, "###TITLE###")
        If i > 0 Then
            strTemp = Left$(strTemp, i - 1) & "CGSC" & Mid$(strTemp, i + 11)
        End If
        Print #10, strTemp
    Loop
    Close 9
    
    Print #10, "<TABLE>"
    Print #10, "<TR>"
    Print #10, "<TD><B>Author</B></TD>"
    Print #10, "<TD></TD>"
    Print #10, "<TD></TD>"
    Print #10, "<TD><B>MUS</B></TD>"
    Print #10, "<TD><B>STR</B></TD>"
    Print #10, "<TD><B>WDS</B></TD>"
    Print #10, "</TR>"
    
    For i = 0 To Dir1.ListCount - 1
        File1.Path = Dir1.List(i)
        DoEvents
        If File1.ListCount > 0 Then
            Call ProcDir(Dir1.List(i))
        ElseIf InStr(Dir1.List(i), "\00_") > 0 Then
            Call ProcDirZero(Dir1.List(i))
        Else
            dirMisc.Path = Dir1.List(i)
            For j = 0 To dirMisc.ListCount - 1
                File1.Path = dirMisc.List(j)
                DoEvents
                If File1.ListCount > 0 Then
                    Call ProcDir(dirMisc.List(j))
                End If
            Next j
        End If
    Next i
    
    Print #10, "</TABLE>"
    
    Open App.Path & "\footer.html" For Input As 9
    Do Until EOF(9)
        Line Input #9, strTemp
        Print #10, strTemp
    Loop
    Close 9
    Close 10

    cmdStart.Enabled = True
    Drive1.Enabled = True
    Dir1.Enabled = True
    lblProc.Visible = False
    lblDir.Visible = False
    
    Unload Me
End Sub

Private Sub Drive1_Change()
    On Error Resume Next
    Dir1.Path = Drive1.Drive
End Sub

Private Sub Form_Load()
    Drive1.Drive = "C:\"
    Dir1.Path = App.Path & "\..\.."
End Sub

Private Sub ProcDir(ByVal pstrDir As String)
    Dim strAuthor As String
    Dim strSubDir As String
    Dim strTemp As String
    Dim intMus As Integer
    Dim intStr As Integer
    Dim intWds As Integer
    Dim lngBlocks As Long
    Dim lngFileSize As Long
    Dim strFile As String
    Dim i As Integer
    Dim j As Integer
    
    strAuthor = Mid$(pstrDir, Len(Dir1.Path) + 2)
    lblDir = strAuthor
    DoEvents
    
    Open pstrDir & "\index.html" For Output As 5
    Open pstrDir & "\index2.html" For Output As 6
    
    Open App.Path & "\header.html" For Input As 9
    Do Until EOF(9)
        Line Input #9, strTemp
        i = InStr(strTemp, "###TITLE###")
        If i > 0 Then
            strTemp = Left$(strTemp, i - 1) & strAuthor & Mid$(strTemp, i + 11)
        End If
        Print #5, strTemp
        Print #6, strTemp
    Loop
    Close 9
    
    Print #5, "<TABLE>"
    Print #5, "<TR>"
    Print #5, "<TD><B>Size</B></TD>"
    Print #5, "<TD><B>Title</B></TD>"
    Print #5, "<TD><B>MUS</B></TD>"
    Print #5, "<TD><B>STR</B></TD>"
    Print #5, "<TD><B>WDS</B></TD>"
    Print #5, "</TR>"
    Print #6, "<TABLE>"
    Print #6, "<TR>"
    Print #6, "<TD><B>Size</B></TD>"
    Print #6, "<TD><B>Title</B></TD>"
    Print #6, "<TD><B>MUS</B></TD>"
    Print #6, "<TD><B>STR</B></TD>"
    Print #6, "<TD><B>WDS</B></TD>"
    Print #6, "<TD><B>Desciption</B></TD>"
    Print #6, "</TR>"
    
    Dir2.Path = pstrDir
    For i = 0 To Dir2.ListCount - 1
        strSubDir = Dir2.List(i)
        Do
            j = InStr(strSubDir, "\")
            If j = 0 Then Exit Do
            strSubDir = Mid$(strSubDir, j + 1)
        Loop
        File1.Path = Dir2.List(i)
        intMus = intMus + File1.ListCount
        For j = 0 To File1.ListCount - 1
            strFile = File1.List(j)
            strFile = Left$(strFile, Len(strFile) - 4)
            lngBlocks = 0
            On Error Resume Next
            lngFileSize = 0
            lngFileSize = FileLen(File1.Path & "\" & strFile & ".MUS")
            lngBlocks = lngBlocks + Int(lngFileSize / 254 + 0.99999)
            lngFileSize = 0
            lngFileSize = FileLen(File1.Path & "\" & strFile & ".STR")
            lngBlocks = lngBlocks + Int(lngFileSize / 254 + 0.99999)
            lngFileSize = 0
            lngFileSize = FileLen(File1.Path & "\" & strFile & ".WDS")
            lngBlocks = lngBlocks + Int(lngFileSize / 254 + 0.99999)
            On Error GoTo 0
            Print #5,
            Print #6,
            Print #5, "<TR>"
            Print #6, "<TR>"
            Print #5, "<TD ALIGN=""RIGHT"">"; lngBlocks; "</TD>"
            Print #6, "<TD ALIGN=""RIGHT"">"; lngBlocks; "</TD>"
            Print #5, "<TD>"; strSubDir; "/"; strFile; "</TD>"
            Print #6, "<TD>"; strSubDir; "/"; strFile; "</TD>"
            Print #5, "<TD><A HREF="; Chr$(34); strSubDir; "/"; strFile; ".mus"; Chr$(34); ">MUS</A></TD>"
            Print #6, "<TD><A HREF="; Chr$(34); strSubDir; "/"; strFile; ".mus"; Chr$(34); ">MUS</A></TD>"
            If FileExists(File1.Path & "\" & strFile & ".STR") Then
                intStr = intStr + 1
                Print #5, "<TD><A HREF="; Chr$(34); strSubDir; "/"; strFile; ".str"; Chr$(34); ">STR</A></TD>"
                Print #6, "<TD><A HREF="; Chr$(34); strSubDir; "/"; strFile; ".str"; Chr$(34); ">STR</A></TD>"
            Else
                Print #5, "<TD></TD>"
                Print #6, "<TD></TD>"
            End If
            If FileExists(File1.Path & "\" & strFile & ".WDS") Then
                intWds = intWds + 1
                Print #5, "<TD><A HREF="; Chr$(34); strSubDir; "/"; strFile; ".wds"; Chr$(34); ">WDS</A></TD>"
                Print #6, "<TD><A HREF="; Chr$(34); strSubDir; "/"; strFile; ".wds"; Chr$(34); ">WDS</A></TD>"
            Else
                Print #5, "<TD></TD>"
                Print #6, "<TD></TD>"
            End If
            Print #5, "</TR>"
            Call DisplayDesc(File1.Path & "\" & strFile & ".MUS")
            Print #6, "</TR>"
        Next j
    Next i
    
    
    File1.Path = pstrDir
    intMus = intMus + File1.ListCount
    
    For j = 0 To File1.ListCount - 1
        strFile = File1.List(j)
        strFile = Left$(strFile, Len(strFile) - 4)
        lngBlocks = 0
        On Error Resume Next
        lngFileSize = 0
        lngFileSize = FileLen(File1.Path & "\" & strFile & ".MUS")
        lngBlocks = lngBlocks + Int(lngFileSize / 254 + 0.99999)
        lngFileSize = 0
        lngFileSize = FileLen(File1.Path & "\" & strFile & ".STR")
        lngBlocks = lngBlocks + Int(lngFileSize / 254 + 0.99999)
        lngFileSize = 0
        lngFileSize = FileLen(File1.Path & "\" & strFile & ".WDS")
        lngBlocks = lngBlocks + Int(lngFileSize / 254 + 0.99999)
        On Error GoTo 0
        Print #5,
        Print #6,
        Print #5, "<TR>"
        Print #6, "<TR>"
        Print #5, "<TD ALIGN=""RIGHT"">"; lngBlocks; "</TD>"
        Print #6, "<TD ALIGN=""RIGHT"">"; lngBlocks; "</TD>"
        Print #5, "<TD>"; strFile; "</TD>"
        Print #6, "<TD>"; strFile; "</TD>"
        Print #5, "<TD><A HREF="; Chr$(34); strFile; ".mus"; Chr$(34); ">MUS</A></TD>"
        Print #6, "<TD><A HREF="; Chr$(34); strFile; ".mus"; Chr$(34); ">MUS</A></TD>"
        If FileExists(File1.Path & "\" & strFile & ".STR") Then
            intStr = intStr + 1
            Print #5, "<TD><A HREF="; Chr$(34); strFile; ".str"; Chr$(34); ">STR</A></TD>"
            Print #6, "<TD><A HREF="; Chr$(34); strFile; ".str"; Chr$(34); ">STR</A></TD>"
        Else
            Print #5, "<TD></TD>"
            Print #6, "<TD></TD>"
        End If
        If FileExists(File1.Path & "\" & strFile & ".WDS") Then
            intWds = intWds + 1
            Print #5, "<TD><A HREF="; Chr$(34); strFile; ".wds"; Chr$(34); ">WDS</A></TD>"
            Print #6, "<TD><A HREF="; Chr$(34); strFile; ".wds"; Chr$(34); ">WDS</A></TD>"
        Else
            Print #5, "<TD></TD>"
            Print #6, "<TD></TD>"
        End If
        Print #5, "</TR>"
        Call DisplayDesc(File1.Path & "\" & strFile & ".MUS")
        Print #6, "</TR>"
    Next j
    
    Open App.Path & "\footer.html" For Input As 9
    Do Until EOF(9)
        Line Input #9, strTemp
        Print #5, strTemp
        Print #6, strTemp
    Loop
    Close 9
    
    Close 5
    Close 6
    
    Print #10,
    Print #10, "<TR>"
    Print #10, "<TD>"; strAuthor; "</TD>"
    Print #10, "<TD><A HREF="; Chr$(34); strAuthor; "/index.html"; Chr$(34); ">[Short]</A></TD>"
    Print #10, "<TD><A HREF="; Chr$(34); strAuthor; "/index2.html"; Chr$(34); ">[Long]</A></TD>"
    strTemp = "" & intMus: If strTemp = "0" Then strTemp = ""
    Print #10, "<TD ALIGN=""RIGHT"">"; strTemp; "</TD>"
    strTemp = "" & intStr: If strTemp = "0" Then strTemp = ""
    Print #10, "<TD ALIGN=""RIGHT"">"; strTemp; "</TD>"
    strTemp = "" & intWds: If strTemp = "0" Then strTemp = ""
    Print #10, "<TD ALIGN=""RIGHT"">"; strTemp; "</TD>"
    Print #10, "</TR>"
End Sub

Private Function FileExists(pstrFile As String)
    Dim varDateTime As Variant
    
    On Error Resume Next
    varDateTime = 0
    varDateTime = FileDateTime(pstrFile)
    If varDateTime > 0 Then
        FileExists = True
    Else
        FileExists = False
    End If
End Function

Private Sub DisplayDesc(pstrFile As String)
    Dim inf(1 To 5) As String
    Dim strContents As String
    Dim finalpost As Long
    Dim c$
    Dim i As Integer
    Dim x As Integer
    Dim y As Integer
    Dim lin As Integer
    Dim post As Long
    Dim j As Integer
    
    Open pstrFile For Binary Access Read As 1
    strContents = Space$(LOF(1))
    Get #1, , strContents
    Close 1

    finalpost = 9
    finalpost = finalpost + Asc(Mid$(strContents, 4, 1) + Chr$(0)) * 256 + Asc(Mid$(strContents, 3, 1) + Chr$(0))
    finalpost = finalpost + Asc(Mid$(strContents, 6, 1) + Chr$(0)) * 256 + Asc(Mid$(strContents, 5, 1) + Chr$(0))
    finalpost = finalpost + Asc(Mid$(strContents, 8, 1) + Chr$(0)) * 256 + Asc(Mid$(strContents, 7, 1) + Chr$(0))

    If Mid$(strContents, finalpost - 1, 1) = "O" Then
        strContents = Mid$(strContents, finalpost)
    Else
        'Try a more dodgy way to find the end of the music
        strContents = Mid$(strContents, 9)
        
        post = 0
        For i = 1 To 3
            post = InStr(post + 1, strContents, "O")
            If post = 0 Then Exit For
        Next i
        If post = 0 Then
            Print #6, "<TD></TD>"
            Exit Sub
        End If
        
        strContents = Mid$(strContents, post + 1)
    End If

    lin = 1
    If Left$(strContents, 4) = "G" + Chr$(157) + " " + Chr$(157) Then strContents = Mid$(strContents, 5)
    
    For i = 1 To Len(strContents)
        c$ = ""
        x = Asc(Mid$(strContents, i, 1) + Chr$(0))
        y = InStr(charc64, Chr$(x))
        If y <> 0 Then c$ = Mid$(charibmU, y, 1)
        If x = 34 Then c$ = Chr$(34)
        If x = 13 Then c$ = "": lin = lin + 1: If lin = 6 Then Exit For
        If x = 0 Then Exit For
        
        Select Case x
        Case 5: c$ = "</FONT><FONT COLOR=""#fcfcfc"">" 'white
        Case 28: c$ = "</FONT><FONT COLOR=""#fc0000"">" 'red
        Case 30: c$ = "</FONT><FONT COLOR=""#00fc00"">" 'green
        Case 31: c$ = "</FONT><FONT COLOR=""#0000fc"">" 'blue
        Case 129: c$ = "</FONT><FONT COLOR=""#fca000"">" 'orange
        Case 144: c$ = "</FONT><FONT COLOR=""#000000"">" 'black
        Case 149: c$ = "</FONT><FONT COLOR=""#a00000"">" 'brown
        Case 150: c$ = "</FONT><FONT COLOR=""#fc8080"">" 'lt red
        Case 151: c$ = "</FONT><FONT COLOR=""#555555"">" 'grey 1
        Case 152: c$ = "</FONT><FONT COLOR=""#888888"">" 'grey 2
        Case 153: c$ = "</FONT><FONT COLOR=""#99fc99"">" 'lt green
        Case 154: c$ = "</FONT><FONT COLOR=""#9999fc"">" 'lt blue
        Case 155: c$ = "</FONT><FONT COLOR=""#bbbbbb"">" 'grey 3
        Case 156: c$ = "</FONT><FONT COLOR=""#fc00fc"">" 'purple
        Case 158: c$ = "</FONT><FONT COLOR=""#fcfc00"">" 'yellow
        Case 159: c$ = "</FONT><FONT COLOR=""#00fcfc"">" 'cyan
        End Select
        
        Select Case c$
        Case " ": c$ = "&nbsp;"
        Case "&": c$ = "&amp;"
        Case "<": c$ = "&lt;"
        Case ">": c$ = "&gt;"
        End Select
        
        inf$(lin) = inf$(lin) + c$
    Next i

    Print #6, "<TD BGCOLOR=""#000000""><TT><FONT COLOR=""#fcfcfc"">"
    For j = 1 To 5
      Print #6, inf$(j); "<BR>"
    Next j
    Print #6, "</FONT></TT></TD>"
End Sub

Private Sub ProcDirZero(ByVal pstrDir As String)
    Print #10,
    Print #10, "<TR>"
    Print #10, "<TD><A HREF="; Chr$(34); Mid$(pstrDir, Len(Dir1.Path) + 2); "\"; Chr$(34); ">"; Mid$(pstrDir, Len(Dir1.Path) + 2); "</A></TD>"
    Print #10, "<TD></TD>"
    Print #10, "<TD></TD>"
    Print #10, "<TD ALIGN=""RIGHT""></TD>"
    Print #10, "<TD ALIGN=""RIGHT""></TD>"
    Print #10, "<TD ALIGN=""RIGHT""></TD>"
    Print #10, "</TR>"
End Sub