home *** CD-ROM | disk | FTP | other *** search
/ 8bitfiles.net/archives / archives.tar / archives / computes-gazette-sid-collections / CGSC / 00_Utils / MakeHTML / CGSC2HTML.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2019-04-13  |  16.4 KB  |  442 lines
  1. VERSION 5.00
  2. Begin VB.Form frmCGSC 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Create HTML index files for CGSC"
  5.    ClientHeight    =   3045
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   4680
  9.    MaxButton       =   0   'False
  10.    ScaleHeight     =   3045
  11.    ScaleWidth      =   4680
  12.    StartUpPosition =   2  'CenterScreen
  13.    Begin VB.DirListBox dirMisc 
  14.       Height          =   540
  15.       Left            =   2580
  16.       TabIndex        =   7
  17.       Top             =   2340
  18.       Visible         =   0   'False
  19.       Width           =   555
  20.    End
  21.    Begin VB.FileListBox File1 
  22.       Height          =   675
  23.       Left            =   2520
  24.       Pattern         =   "*.mus"
  25.       TabIndex        =   6
  26.       Top             =   1620
  27.       Visible         =   0   'False
  28.       Width           =   855
  29.    End
  30.    Begin VB.DirListBox Dir2 
  31.       Height          =   765
  32.       Left            =   3480
  33.       TabIndex        =   3
  34.       Top             =   1620
  35.       Visible         =   0   'False
  36.       Width           =   1095
  37.    End
  38.    Begin VB.CommandButton cmdStart 
  39.       Caption         =   "&Start"
  40.       Height          =   375
  41.       Left            =   3180
  42.       TabIndex        =   2
  43.       Top             =   2640
  44.       Width           =   1455
  45.    End
  46.    Begin VB.DirListBox Dir1 
  47.       Height          =   2565
  48.       Left            =   60
  49.       TabIndex        =   1
  50.       Top             =   420
  51.       Width           =   2295
  52.    End
  53.    Begin VB.DriveListBox Drive1 
  54.       Height          =   315
  55.       Left            =   60
  56.       TabIndex        =   0
  57.       Top             =   60
  58.       Width           =   2355
  59.    End
  60.    Begin VB.Label lblDir 
  61.       Caption         =   "C:\"
  62.       Height          =   195
  63.       Left            =   2580
  64.       TabIndex        =   5
  65.       Top             =   420
  66.       Visible         =   0   'False
  67.       Width           =   1935
  68.    End
  69.    Begin VB.Label lblProc 
  70.       AutoSize        =   -1  'True
  71.       BackStyle       =   0  'Transparent
  72.       Caption         =   "Processing:"
  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.       Left            =   2580
  84.       TabIndex        =   4
  85.       Top             =   120
  86.       Visible         =   0   'False
  87.       Width           =   1005
  88.    End
  89. Attribute VB_Name = "frmCGSC"
  90. Attribute VB_GlobalNameSpace = False
  91. Attribute VB_Creatable = False
  92. Attribute VB_PredeclaredId = True
  93. Attribute VB_Exposed = False
  94. Option Explicit
  95.  Const charc64 = " !#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~
  96. Const charibmU = " !#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[$]^<-#|----||\\/\\//\#_#|/XO#|#+||&\ |#--|#|#/||/\\-/--||||---/\\//#-#|----||\\/\\//\#_#|/XO#|#+||&\ |#--|#|#/||/\\-/--||||---/\\//#"
  97. Const charibmL = " !#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[$]^<-abcdefghijklmnopqrstuvwxyz+||&\ |#--|#|#/||/\\-/--||||---/\\//#-abcdefghijklmnopqrstuvwxyz+||&\ |#--|#|#/||/\\-/--||||---/\\//#"
  98. Private Sub cmdStart_Click()
  99.     Dim i As Integer
  100.     Dim j As Integer
  101.     Dim strTemp As String
  102.     cmdStart.Enabled = False
  103.     Drive1.Enabled = False
  104.     Dir1.Enabled = False
  105.     lblProc.Visible = True
  106.     lblDir.Visible = True
  107.     Open Dir1.Path & "\index.html" For Output As 10
  108.     Open App.Path & "\header.html" For Input As 9
  109.     Do Until EOF(9)
  110.         Line Input #9, strTemp
  111.         i = InStr(strTemp, "###TITLE###")
  112.         If i > 0 Then
  113.             strTemp = Left$(strTemp, i - 1) & "CGSC" & Mid$(strTemp, i + 11)
  114.         End If
  115.         Print #10, strTemp
  116.     Loop
  117.     Close 9
  118.     Print #10, "<TABLE>"
  119.     Print #10, "<TR>"
  120.     Print #10, "<TD><B>Author</B></TD>"
  121.     Print #10, "<TD></TD>"
  122.     Print #10, "<TD></TD>"
  123.     Print #10, "<TD><B>MUS</B></TD>"
  124.     Print #10, "<TD><B>STR</B></TD>"
  125.     Print #10, "<TD><B>WDS</B></TD>"
  126.     Print #10, "</TR>"
  127.     For i = 0 To Dir1.ListCount - 1
  128.         File1.Path = Dir1.List(i)
  129.         DoEvents
  130.         If File1.ListCount > 0 Then
  131.             Call ProcDir(Dir1.List(i))
  132.         ElseIf InStr(Dir1.List(i), "\00_") > 0 Then
  133.             Call ProcDirZero(Dir1.List(i))
  134.         Else
  135.             dirMisc.Path = Dir1.List(i)
  136.             For j = 0 To dirMisc.ListCount - 1
  137.                 File1.Path = dirMisc.List(j)
  138.                 DoEvents
  139.                 If File1.ListCount > 0 Then
  140.                     Call ProcDir(dirMisc.List(j))
  141.                 End If
  142.             Next j
  143.         End If
  144.     Next i
  145.     Print #10, "</TABLE>"
  146.     Open App.Path & "\footer.html" For Input As 9
  147.     Do Until EOF(9)
  148.         Line Input #9, strTemp
  149.         Print #10, strTemp
  150.     Loop
  151.     Close 9
  152.     Close 10
  153.     cmdStart.Enabled = True
  154.     Drive1.Enabled = True
  155.     Dir1.Enabled = True
  156.     lblProc.Visible = False
  157.     lblDir.Visible = False
  158.     Unload Me
  159. End Sub
  160. Private Sub Drive1_Change()
  161.     On Error Resume Next
  162.     Dir1.Path = Drive1.Drive
  163. End Sub
  164. Private Sub Form_Load()
  165.     Drive1.Drive = "C:\"
  166.     Dir1.Path = App.Path & "\..\.."
  167. End Sub
  168. Private Sub ProcDir(ByVal pstrDir As String)
  169.     Dim strAuthor As String
  170.     Dim strSubDir As String
  171.     Dim strTemp As String
  172.     Dim intMus As Integer
  173.     Dim intStr As Integer
  174.     Dim intWds As Integer
  175.     Dim lngBlocks As Long
  176.     Dim lngFileSize As Long
  177.     Dim strFile As String
  178.     Dim i As Integer
  179.     Dim j As Integer
  180.     strAuthor = Mid$(pstrDir, Len(Dir1.Path) + 2)
  181.     lblDir = strAuthor
  182.     DoEvents
  183.     Open pstrDir & "\index.html" For Output As 5
  184.     Open pstrDir & "\index2.html" For Output As 6
  185.     Open App.Path & "\header.html" For Input As 9
  186.     Do Until EOF(9)
  187.         Line Input #9, strTemp
  188.         i = InStr(strTemp, "###TITLE###")
  189.         If i > 0 Then
  190.             strTemp = Left$(strTemp, i - 1) & strAuthor & Mid$(strTemp, i + 11)
  191.         End If
  192.         Print #5, strTemp
  193.         Print #6, strTemp
  194.     Loop
  195.     Close 9
  196.     Print #5, "<TABLE>"
  197.     Print #5, "<TR>"
  198.     Print #5, "<TD><B>Size</B></TD>"
  199.     Print #5, "<TD><B>Title</B></TD>"
  200.     Print #5, "<TD><B>MUS</B></TD>"
  201.     Print #5, "<TD><B>STR</B></TD>"
  202.     Print #5, "<TD><B>WDS</B></TD>"
  203.     Print #5, "</TR>"
  204.     Print #6, "<TABLE>"
  205.     Print #6, "<TR>"
  206.     Print #6, "<TD><B>Size</B></TD>"
  207.     Print #6, "<TD><B>Title</B></TD>"
  208.     Print #6, "<TD><B>MUS</B></TD>"
  209.     Print #6, "<TD><B>STR</B></TD>"
  210.     Print #6, "<TD><B>WDS</B></TD>"
  211.     Print #6, "<TD><B>Desciption</B></TD>"
  212.     Print #6, "</TR>"
  213.     Dir2.Path = pstrDir
  214.     For i = 0 To Dir2.ListCount - 1
  215.         strSubDir = Dir2.List(i)
  216.         Do
  217.             j = InStr(strSubDir, "\")
  218.             If j = 0 Then Exit Do
  219.             strSubDir = Mid$(strSubDir, j + 1)
  220.         Loop
  221.         File1.Path = Dir2.List(i)
  222.         intMus = intMus + File1.ListCount
  223.         For j = 0 To File1.ListCount - 1
  224.             strFile = File1.List(j)
  225.             strFile = Left$(strFile, Len(strFile) - 4)
  226.             lngBlocks = 0
  227.             On Error Resume Next
  228.             lngFileSize = 0
  229.             lngFileSize = FileLen(File1.Path & "\" & strFile & ".MUS")
  230.             lngBlocks = lngBlocks + Int(lngFileSize / 254 + 0.99999)
  231.             lngFileSize = 0
  232.             lngFileSize = FileLen(File1.Path & "\" & strFile & ".STR")
  233.             lngBlocks = lngBlocks + Int(lngFileSize / 254 + 0.99999)
  234.             lngFileSize = 0
  235.             lngFileSize = FileLen(File1.Path & "\" & strFile & ".WDS")
  236.             lngBlocks = lngBlocks + Int(lngFileSize / 254 + 0.99999)
  237.             On Error GoTo 0
  238.             Print #5,
  239.             Print #6,
  240.             Print #5, "<TR>"
  241.             Print #6, "<TR>"
  242.             Print #5, "<TD ALIGN=""RIGHT"">"; lngBlocks; "</TD>"
  243.             Print #6, "<TD ALIGN=""RIGHT"">"; lngBlocks; "</TD>"
  244.             Print #5, "<TD>"; strSubDir; "/"; strFile; "</TD>"
  245.             Print #6, "<TD>"; strSubDir; "/"; strFile; "</TD>"
  246.             Print #5, "<TD><A HREF="; Chr$(34); strSubDir; "/"; strFile; ".mus"; Chr$(34); ">MUS</A></TD>"
  247.             Print #6, "<TD><A HREF="; Chr$(34); strSubDir; "/"; strFile; ".mus"; Chr$(34); ">MUS</A></TD>"
  248.             If FileExists(File1.Path & "\" & strFile & ".STR") Then
  249.                 intStr = intStr + 1
  250.                 Print #5, "<TD><A HREF="; Chr$(34); strSubDir; "/"; strFile; ".str"; Chr$(34); ">STR</A></TD>"
  251.                 Print #6, "<TD><A HREF="; Chr$(34); strSubDir; "/"; strFile; ".str"; Chr$(34); ">STR</A></TD>"
  252.             Else
  253.                 Print #5, "<TD></TD>"
  254.                 Print #6, "<TD></TD>"
  255.             End If
  256.             If FileExists(File1.Path & "\" & strFile & ".WDS") Then
  257.                 intWds = intWds + 1
  258.                 Print #5, "<TD><A HREF="; Chr$(34); strSubDir; "/"; strFile; ".wds"; Chr$(34); ">WDS</A></TD>"
  259.                 Print #6, "<TD><A HREF="; Chr$(34); strSubDir; "/"; strFile; ".wds"; Chr$(34); ">WDS</A></TD>"
  260.             Else
  261.                 Print #5, "<TD></TD>"
  262.                 Print #6, "<TD></TD>"
  263.             End If
  264.             Print #5, "</TR>"
  265.             Call DisplayDesc(File1.Path & "\" & strFile & ".MUS")
  266.             Print #6, "</TR>"
  267.         Next j
  268.     Next i
  269.     File1.Path = pstrDir
  270.     intMus = intMus + File1.ListCount
  271.     For j = 0 To File1.ListCount - 1
  272.         strFile = File1.List(j)
  273.         strFile = Left$(strFile, Len(strFile) - 4)
  274.         lngBlocks = 0
  275.         On Error Resume Next
  276.         lngFileSize = 0
  277.         lngFileSize = FileLen(File1.Path & "\" & strFile & ".MUS")
  278.         lngBlocks = lngBlocks + Int(lngFileSize / 254 + 0.99999)
  279.         lngFileSize = 0
  280.         lngFileSize = FileLen(File1.Path & "\" & strFile & ".STR")
  281.         lngBlocks = lngBlocks + Int(lngFileSize / 254 + 0.99999)
  282.         lngFileSize = 0
  283.         lngFileSize = FileLen(File1.Path & "\" & strFile & ".WDS")
  284.         lngBlocks = lngBlocks + Int(lngFileSize / 254 + 0.99999)
  285.         On Error GoTo 0
  286.         Print #5,
  287.         Print #6,
  288.         Print #5, "<TR>"
  289.         Print #6, "<TR>"
  290.         Print #5, "<TD ALIGN=""RIGHT"">"; lngBlocks; "</TD>"
  291.         Print #6, "<TD ALIGN=""RIGHT"">"; lngBlocks; "</TD>"
  292.         Print #5, "<TD>"; strFile; "</TD>"
  293.         Print #6, "<TD>"; strFile; "</TD>"
  294.         Print #5, "<TD><A HREF="; Chr$(34); strFile; ".mus"; Chr$(34); ">MUS</A></TD>"
  295.         Print #6, "<TD><A HREF="; Chr$(34); strFile; ".mus"; Chr$(34); ">MUS</A></TD>"
  296.         If FileExists(File1.Path & "\" & strFile & ".STR") Then
  297.             intStr = intStr + 1
  298.             Print #5, "<TD><A HREF="; Chr$(34); strFile; ".str"; Chr$(34); ">STR</A></TD>"
  299.             Print #6, "<TD><A HREF="; Chr$(34); strFile; ".str"; Chr$(34); ">STR</A></TD>"
  300.         Else
  301.             Print #5, "<TD></TD>"
  302.             Print #6, "<TD></TD>"
  303.         End If
  304.         If FileExists(File1.Path & "\" & strFile & ".WDS") Then
  305.             intWds = intWds + 1
  306.             Print #5, "<TD><A HREF="; Chr$(34); strFile; ".wds"; Chr$(34); ">WDS</A></TD>"
  307.             Print #6, "<TD><A HREF="; Chr$(34); strFile; ".wds"; Chr$(34); ">WDS</A></TD>"
  308.         Else
  309.             Print #5, "<TD></TD>"
  310.             Print #6, "<TD></TD>"
  311.         End If
  312.         Print #5, "</TR>"
  313.         Call DisplayDesc(File1.Path & "\" & strFile & ".MUS")
  314.         Print #6, "</TR>"
  315.     Next j
  316.     Open App.Path & "\footer.html" For Input As 9
  317.     Do Until EOF(9)
  318.         Line Input #9, strTemp
  319.         Print #5, strTemp
  320.         Print #6, strTemp
  321.     Loop
  322.     Close 9
  323.     Close 5
  324.     Close 6
  325.     Print #10,
  326.     Print #10, "<TR>"
  327.     Print #10, "<TD>"; strAuthor; "</TD>"
  328.     Print #10, "<TD><A HREF="; Chr$(34); strAuthor; "/index.html"; Chr$(34); ">[Short]</A></TD>"
  329.     Print #10, "<TD><A HREF="; Chr$(34); strAuthor; "/index2.html"; Chr$(34); ">[Long]</A></TD>"
  330.     strTemp = "" & intMus: If strTemp = "0" Then strTemp = ""
  331.     Print #10, "<TD ALIGN=""RIGHT"">"; strTemp; "</TD>"
  332.     strTemp = "" & intStr: If strTemp = "0" Then strTemp = ""
  333.     Print #10, "<TD ALIGN=""RIGHT"">"; strTemp; "</TD>"
  334.     strTemp = "" & intWds: If strTemp = "0" Then strTemp = ""
  335.     Print #10, "<TD ALIGN=""RIGHT"">"; strTemp; "</TD>"
  336.     Print #10, "</TR>"
  337. End Sub
  338. Private Function FileExists(pstrFile As String)
  339.     Dim varDateTime As Variant
  340.     On Error Resume Next
  341.     varDateTime = 0
  342.     varDateTime = FileDateTime(pstrFile)
  343.     If varDateTime > 0 Then
  344.         FileExists = True
  345.     Else
  346.         FileExists = False
  347.     End If
  348. End Function
  349. Private Sub DisplayDesc(pstrFile As String)
  350.     Dim inf(1 To 5) As String
  351.     Dim strContents As String
  352.     Dim finalpost As Long
  353.     Dim c$
  354.     Dim i As Integer
  355.     Dim x As Integer
  356.     Dim y As Integer
  357.     Dim lin As Integer
  358.     Dim post As Long
  359.     Dim j As Integer
  360.     Open pstrFile For Binary Access Read As 1
  361.     strContents = Space$(LOF(1))
  362.     Get #1, , strContents
  363.     Close 1
  364.     finalpost = 9
  365.     finalpost = finalpost + Asc(Mid$(strContents, 4, 1) + Chr$(0)) * 256 + Asc(Mid$(strContents, 3, 1) + Chr$(0))
  366.     finalpost = finalpost + Asc(Mid$(strContents, 6, 1) + Chr$(0)) * 256 + Asc(Mid$(strContents, 5, 1) + Chr$(0))
  367.     finalpost = finalpost + Asc(Mid$(strContents, 8, 1) + Chr$(0)) * 256 + Asc(Mid$(strContents, 7, 1) + Chr$(0))
  368.     If Mid$(strContents, finalpost - 1, 1) = "O" Then
  369.         strContents = Mid$(strContents, finalpost)
  370.     Else
  371.         'Try a more dodgy way to find the end of the music
  372.         strContents = Mid$(strContents, 9)
  373.         
  374.         post = 0
  375.         For i = 1 To 3
  376.             post = InStr(post + 1, strContents, "O")
  377.             If post = 0 Then Exit For
  378.         Next i
  379.         If post = 0 Then
  380.             Print #6, "<TD></TD>"
  381.             Exit Sub
  382.         End If
  383.         
  384.         strContents = Mid$(strContents, post + 1)
  385.     End If
  386.     lin = 1
  387.     If Left$(strContents, 4) = "G" + Chr$(157) + " " + Chr$(157) Then strContents = Mid$(strContents, 5)
  388.     For i = 1 To Len(strContents)
  389.         c$ = ""
  390.         x = Asc(Mid$(strContents, i, 1) + Chr$(0))
  391.         y = InStr(charc64, Chr$(x))
  392.         If y <> 0 Then c$ = Mid$(charibmU, y, 1)
  393.         If x = 34 Then c$ = Chr$(34)
  394.         If x = 13 Then c$ = "": lin = lin + 1: If lin = 6 Then Exit For
  395.         If x = 0 Then Exit For
  396.         
  397.         Select Case x
  398.         Case 5: c$ = "</FONT><FONT COLOR=""#fcfcfc"">" 'white
  399.         Case 28: c$ = "</FONT><FONT COLOR=""#fc0000"">" 'red
  400.         Case 30: c$ = "</FONT><FONT COLOR=""#00fc00"">" 'green
  401.         Case 31: c$ = "</FONT><FONT COLOR=""#0000fc"">" 'blue
  402.         Case 129: c$ = "</FONT><FONT COLOR=""#fca000"">" 'orange
  403.         Case 144: c$ = "</FONT><FONT COLOR=""#000000"">" 'black
  404.         Case 149: c$ = "</FONT><FONT COLOR=""#a00000"">" 'brown
  405.         Case 150: c$ = "</FONT><FONT COLOR=""#fc8080"">" 'lt red
  406.         Case 151: c$ = "</FONT><FONT COLOR=""#555555"">" 'grey 1
  407.         Case 152: c$ = "</FONT><FONT COLOR=""#888888"">" 'grey 2
  408.         Case 153: c$ = "</FONT><FONT COLOR=""#99fc99"">" 'lt green
  409.         Case 154: c$ = "</FONT><FONT COLOR=""#9999fc"">" 'lt blue
  410.         Case 155: c$ = "</FONT><FONT COLOR=""#bbbbbb"">" 'grey 3
  411.         Case 156: c$ = "</FONT><FONT COLOR=""#fc00fc"">" 'purple
  412.         Case 158: c$ = "</FONT><FONT COLOR=""#fcfc00"">" 'yellow
  413.         Case 159: c$ = "</FONT><FONT COLOR=""#00fcfc"">" 'cyan
  414.         End Select
  415.         
  416.         Select Case c$
  417.         Case " ": c$ = " "
  418.         Case "&": c$ = "&"
  419.         Case "<": c$ = "<"
  420.         Case ">": c$ = ">"
  421.         End Select
  422.         
  423.         inf$(lin) = inf$(lin) + c$
  424.     Next i
  425.     Print #6, "<TD BGCOLOR=""#000000""><TT><FONT COLOR=""#fcfcfc"">"
  426.     For j = 1 To 5
  427.       Print #6, inf$(j); "<BR>"
  428.     Next j
  429.     Print #6, "</FONT></TT></TD>"
  430. End Sub
  431. Private Sub ProcDirZero(ByVal pstrDir As String)
  432.     Print #10,
  433.     Print #10, "<TR>"
  434.     Print #10, "<TD><A HREF="; Chr$(34); Mid$(pstrDir, Len(Dir1.Path) + 2); "\"; Chr$(34); ">"; Mid$(pstrDir, Len(Dir1.Path) + 2); "</A></TD>"
  435.     Print #10, "<TD></TD>"
  436.     Print #10, "<TD></TD>"
  437.     Print #10, "<TD ALIGN=""RIGHT""></TD>"
  438.     Print #10, "<TD ALIGN=""RIGHT""></TD>"
  439.     Print #10, "<TD ALIGN=""RIGHT""></TD>"
  440.     Print #10, "</TR>"
  441. End Sub
  442.