home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 2001 May / VPR0105A.BIN / OLS / NIKKI / nikki.lzh / nikki / MkIndex.vbs < prev    next >
Text File  |  2001-02-19  |  3KB  |  65 lines
  1. Option Explicit
  2. Dim WshShell, fs, Header, MyDoc, DFolder, FRset, DFile
  3. Set WshShell = WScript.CreateObject("WScript.Shell")
  4. Set fs = WScript.CreateObject("Scripting.FileSystemObject")
  5. MyDoc = WshShell.SpecialFolders("MyDocuments")
  6. DFolder = MyDoc & "\IDiary"
  7. Header = "<HTML><HEAD><META HTTP-EQUIV=" & ADQ("Content-Type") & " CONTENT=" & ADQ("text/html;CHARSET=x-sjis") & ">"
  8. mkLmenu
  9. MkFrameSet
  10. Set WshShell = Nothing
  11. Set fs = Nothing
  12. '
  13. '----(MStrの両側にダブルクオーテーションを付加する)----
  14. Function ADQ(MStr)
  15.     ADQ = Chr(34) & MStr & Chr(34)
  16. End Function
  17. '-----------------------------------------------------------
  18. Sub mkLmenu()
  19.     Dim Fname, oFolder, OBJ, NN, DT, MM, Match, X
  20.     Fname = DFolder & "\Lmenu.htm"
  21.     Set FRset = fs.CreateTextFile(Fname, True)
  22. '
  23.     FRset.WriteLine (Header)
  24.     FRset.WriteLine ("<TITLE>日記リスト</TITLE>")
  25.     FRset.WriteLine ("</HEAD>")
  26.     FRset.WriteLine ("<BODY BGCOLOR=" & ADQ("#ffffff") & ">")
  27. '
  28.     Set oFolder = fs.GetFolder(DFolder)
  29.     For Each OBJ In oFolder.Files
  30.         NN = OBJ.Name
  31.         Match = IsNumeric(Mid(NN, 2, 6))
  32.         If Not (Left(NN, 1) = "D" And Len(NN) = 11 And Right(NN, 4) = ".htm") Then Match = False
  33.         If Match = True Then
  34.             X = CLng(Mid(NN, 2, 2)): If X < 1 Then Match = False
  35.             X = CLng(Mid(NN, 4, 2)): If X < 1 Or X > 12 Then Match = False
  36.             X = CLng(Mid(NN, 6, 2)): If X < 1 Or X > 31 Then Match = False
  37.         End If
  38.         If Match = True Then
  39.             DT = "20" + Mid(NN, 2, 2) + "/" + Mid(NN, 4, 2) + "/" + Mid(NN, 6, 2)
  40.             MM = "<P><A HREF=" & ADQ(NN) & " TARGET=" & ADQ("R") & ">"
  41.             MM = MM & "<FONT SIZE=" & ADQ("-1") & ">" & DT & "</FONT></A></P>"
  42.             FRset.WriteLine (MM)
  43.             DFile = NN
  44.         End If
  45.     Next
  46.     FRset.WriteLine ("</BODY></HTML>")
  47.     FRset.Close
  48. End Sub
  49. '------------------------------------------------------
  50. Sub MkFrameSet()
  51.     Dim Fname
  52.     Fname = MyDoc & "\IDiary.htm"
  53.     Set FRset = fs.CreateTextFile(Fname, True)
  54.     FRset.WriteLine (Header)
  55.     FRset.WriteLine ("<TITLE>インターネット日記</TITLE>")
  56.     FRset.WriteLine ("</HEAD>")
  57.     FRset.WriteLine ("<FRAMESET FRAMEBORDER=1 COLS=" & ADQ("10%,90%") & ">")
  58.     FRset.WriteLine ("<FRAME SRC=" & ADQ("IDiary/Lmenu.htm") & " NAME=" & ADQ("L") & ">")
  59.     FRset.WriteLine ("<FRAME SRC=" & ADQ("IDiary/" & DFile) & " NAME=" & ADQ("R") & ">")
  60.     FRset.WriteLine ("<NOFRAMES><BODY>フレームを表示できるブラウザが必要です｡</BODY></NOFRAMES>")
  61.     FRset.WriteLine ("</FRAMESET></HTML>")
  62.     FRset.Close
  63. End Sub
  64.  
  65.