' Given a folder name, will create an "index.htm" for the folder. ' The index.htm file will be placed in the folder and will Replace ' any existing index.htm file. Icons with ".xbm" file extensions ' will also be placed in the folder. XBM files are plain-text ' black-and-white graphic files easily generated by scripts and ' displayed by all browsers (Netscape and IE at least!). ' XBM graphics here were shamelessly based on 16x16 small Windows ' icons. If you'd prefer to use bona-fide free icons, you can find ' a nice selection of 20x23 icons at http://www.w3.org/Icons/Standard/ Option Explicit Const INDEX_FILE = "index.html" 'Set to name of desired index web page Const MAKE_PARENT_LINK = True 'Do you want a link to "../" for the parent directory? 'All below constants may be empty strings Const HEADER_FILE = "" 'Set to name of file whose text will be inserted top of page Const FOOTER_FILE = "" 'Name of file whose text will be appended to bottom of page Const GRAPHIC_PREFIX = "index_icon_" 'Prefixed to graphics like "index_icon_xls.gif" instead of just "xls.gif". Unique name essential if graphics will be in indexed folder." Const DISK_GRAPHIC_PATH = "" 'If used, must have trailing backslash. Location where graphic files are written to disk. Leave blank to write in indexed folder. Const WEB_GRAPHIC_PATH = "" 'LEAVE BLANK. If used, must have trailing backslash. Automatically calculated. Only use if disk and web paths are unrelated. Script will display message telling you when you need this. Dim strFileInfo() Dim strFolderInfo() Dim blnGoodFile Dim intCounter Dim dic, fs, fil, fils, fol, fols Dim strPDB, strBMP, strCHM, strDIR, strDLL, strDOC, strEML, strEXE Dim strHLP, strHTA, strHTM, strINI, strLOG, strMDB, strNWS, strOFF Dim strPDF, strPPT, strPRC, strTXT, strUNK, strVBP, strWAV, strXLS Dim strXML, strZIP, strWIN, str000, strSCR, strBAT, strAVI, strMPG Dim strMOV, strFLD, strLPT, strTTF, strVBS, strSNP, strOO, strSXW, strABW Dim strDirectory, strHeader, strIconFile, strIconText, strIconLink Dim strFileLink, strFileName, strFileSize, strFileModified, strIndex Dim strFileExtension, strStringName Set fs = CreateObject("Scripting.FileSystemObject") 'Check to see we got a folder to start with If Wscript.Arguments.Count = 0 Then MsgBox "Drop a directory on this script" Wscript.Quit 1 End If strDirectory = WScript.Arguments(0) If Not fs.FolderExists(strDirectory) Then MsgBox "Drop a DIRECTORY on this script." Wscript.Quit 1 End If If WEB_GRAPHIC_PATH = "" Then If RelativePath(strDirectory, DISK_GRAPHIC_PATH) = "" Then MsgBox "I can't create a relative path from """ & strDirectory & """ to """ & DISK_GRAPHIC_PATH & """. Either fix these paths or define a value for the WEB_GRAPHIC_PATH constant." WScript.Quit 1 End If End If If fs.FileExists(fs.GetAbsolutePathName(fs.BuildPath(strDirectory, INDEX_FILE))) Then If MsgBox ("Replace the existing " & INDEX_FILE & "?", 4) = vbNo Then Wscript.Quit 1 End If 'XBM graphic text declarations strHeader = "#define XBM_width 16" & vbLf & "#define XBM_height 16" & vbLf & "static char XBM_bits[] = " str000="{0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,};" strABW="{0xFE,0x0F,0x02,0x14,0x02,0x24,0x1A,0x7C,0x26,0x48,0x42,0x44,0xC2,0x47,0x22,0x48,0x12,0x5D,0x12,0x55,0x52,0x50,0xE2,0x50,0xC2,0x50,0x82,0x51,0x02,0x4F,0xFE,0x7F,};" strAVI="{0x00,0x1c,0x80,0x13,0x70,0x1e,0xcc,0x01,0x32,0x00,0xf2,0x3f,0xaa,0x6a,0x56,0x75,0x02,0x60,0x12,0x69,0xaa,0x6a,0x12,0x69,0xaa,0x6b,0x02,0x60,0xfe,0x7f,0xfc,0x7f,};" strBAT="{0x00,0x00,0xff,0xff,0x01,0xc0,0xfd,0xff,0xfd,0xea,0xfd,0xff,0x01,0xc0,0xc1,0xc1,0x41,0xc3,0xa1,0xc7,0x41,0xc2,0x81,0xc1,0x01,0xc0,0xff,0xff,0xff,0xff,0x00,0x00,};" strBMP="{0xf0,0x03,0xf1,0x23,0xd3,0x72,0xf6,0x6a,0xfd,0x36,0xfe,0x1b,0xfc,0x0d,0xfe,0x1f,0x02,0x1c,0xe4,0x0f,0x04,0x0e,0x04,0x0c,0x04,0x0e,0x04,0x0c,0x04,0x0e,0xf8,0x07,};" strCHM="{0x00,0x3e,0x00,0x41,0x80,0x80,0x40,0x8c,0x7e,0x8c,0xc2,0x8f,0x02,0x86,0x82,0x43,0xf2,0x22,0x02,0x3e,0xf2,0x04,0x02,0x3e,0xf2,0x22,0x02,0x22,0x02,0x3e,0xfe,0x07,};" strDIR="{0x00,0x00,0x7c,0x00,0xaa,0x00,0x55,0x3f,0x01,0x60,0xab,0x6a,0x55,0x75,0xab,0x6a,0x55,0x75,0xab,0x6a,0x55,0x75,0xab,0x6a,0xff,0x7f,0xfe,0x7f,0x00,0x00,0x00,0x00,};" strDLL="{0xfe,0x07,0x02,0x08,0x02,0x10,0x02,0x3c,0x02,0x20,0x72,0x20,0xd2,0x20,0xea,0x21,0x52,0x23,0xa2,0x27,0x42,0x22,0x82,0x21,0x02,0x20,0x02,0x20,0x02,0x20,0xfe,0x3f,};" strDOC="{0x00,0x00,0x00,0x00,0x00,0x00,0xbf,0xfb,0xa1,0x86,0x52,0x4a,0x52,0x2a,0x32,0x26,0x32,0x16,0x12,0x12,0x42,0x08,0x42,0x08,0x62,0x04,0x62,0x04,0xde,0x03,0x00,0x00,};" strEML="{0x40,0x00,0x20,0x07,0xb4,0x06,0xff,0xff,0x3d,0x80,0x3d,0xb0,0x7d,0xb0,0x01,0x80,0x01,0x80,0x01,0xbe,0x01,0xa4,0x01,0xa4,0xff,0xf7,0x60,0x2f,0xe0,0x07,0xc0,0x03,};" strEXE="{0x00,0x00,0x00,0x00,0xff,0xff,0x01,0xc0,0xfd,0xff,0xfd,0xea,0xfd,0xff,0x01,0xc0,0x01,0xc0,0x01,0xc0,0x01,0xc0,0x01,0xc0,0x01,0xc0,0x01,0xc0,0xff,0xff,0xff,0xff,};" strFLD="{0x00,0x00,0xf8,0x00,0x04,0x01,0xaa,0x7e,0x52,0xc1,0xaa,0xea,0xff,0xdf,0x01,0xf8,0x55,0xf5,0xaa,0xfa,0x52,0xf5,0xa4,0xea,0xfc,0xff,0xf8,0xff,0x00,0x00,0x00,0x00,};" strHLP="{0x80,0x01,0xc0,0x07,0xe0,0x1f,0xf0,0x7f,0x78,0x7c,0xfc,0x79,0x7e,0x7c,0xbf,0xdf,0xff,0xcf,0xff,0x67,0xfb,0x33,0xe3,0x19,0x8e,0x0c,0x38,0x06,0xe0,0x03,0x80,0x01,};" strHTA="{0x00,0x78,0xc0,0x8f,0xf0,0x9f,0xb8,0x3f,0xdc,0x7f,0xec,0x7c,0x76,0xf8,0xfa,0xff,0xfd,0xff,0x7d,0x00,0x7f,0xf8,0xff,0xff,0xfb,0x7f,0xf3,0x3f,0xe6,0x0f,0x1c,0x00,};" strHTM="{0xff,0xff,0x7f,0xbf,0x7d,0x5f,0x1b,0x28,0x67,0x15,0x6f,0x1b,0x57,0x37,0xb3,0x33,0x41,0x80,0x77,0x6f,0xb7,0x39,0x2f,0x29,0x57,0x37,0x6b,0x6f,0x05,0xc3,0x83,0x01,};" strINI="{0xa8,0x0a,0x54,0x15,0xaa,0x2a,0x02,0x20,0x02,0x20,0x72,0x23,0x02,0x20,0xf2,0x23,0x02,0x21,0xb2,0x26,0x42,0x25,0xb2,0x26,0x82,0x23,0x02,0x20,0x02,0x20,0xfc,0x1f,};" strLOG="{0x50,0x15,0xa8,0x2a,0x54,0x55,0x04,0x40,0x04,0x40,0xf4,0x4f,0x04,0x40,0xf4,0x4f,0x04,0x40,0xf4,0x49,0x04,0x4c,0x74,0x4a,0x04,0x4f,0x84,0x48,0x04,0x40,0xf8,0x3f,};" strLPT="{0x00,0x0e,0x00,0x31,0x80,0xc0,0x60,0x20,0x58,0x10,0x86,0x69,0x31,0xee,0xc1,0xf8,0x01,0xfe,0x81,0xff,0x83,0x7f,0x8e,0x7f,0xb2,0x7f,0xcc,0x1f,0xb0,0x07,0xc0,0x01,};" strMDB="{0xf8,0x01,0x2c,0x03,0x36,0x06,0x3b,0x05,0x95,0x04,0x4f,0x06,0x23,0x05,0x13,0x09,0x07,0x12,0xde,0x24,0xfc,0x4b,0x00,0x92,0x00,0xa6,0x00,0xd8,0x00,0x78,0x00,0x00,};" strMOV="{0xf0,0x1f,0x10,0x20,0x10,0x40,0x10,0xf0,0x10,0x80,0x11,0x80,0xfb,0xb3,0x47,0xbe,0x3d,0xa6,0x04,0xbe,0x4c,0xb7,0xfc,0x87,0x10,0x80,0x10,0x80,0x10,0x80,0xf0,0xff,};" strMPG="{0xff,0xff,0x05,0xa0,0x05,0xa0,0x07,0xe0,0x07,0xe0,0x05,0xa0,0x05,0xa0,0xff,0xff,0xff,0xff,0x05,0xa0,0x05,0xa0,0x07,0xe0,0x07,0xe0,0x05,0xa0,0x05,0xa0,0xff,0xff,};" strNWS="{0x00,0x00,0x00,0x00,0x00,0x00,0xff,0x7f,0x01,0x40,0x01,0xd8,0xf1,0xd9,0x01,0xc0,0xf1,0xc0,0x01,0xc0,0x01,0xc0,0xff,0xff,0xfe,0xff,0x00,0x00,0x00,0x00,0x00,0x00,};" strOO ="{0x00,0xE0,0x00,0x30,0x00,0x1F,0x80,0x0F,0xC0,0x00,0x40,0x1E,0x00,0x07,0x80,0x03,0xC0,0x01,0xF8,0x00,0xFC,0x00,0x0E,0x00,0x07,0x00,0x01,0x00,0x00,0x00,0x00,0x00,};" strOFF="{0x00,0x60,0xf0,0x7b,0xf8,0x3f,0xe8,0x3f,0xec,0x1f,0xc4,0x1f,0xf6,0x0f,0xfa,0x0f,0x8e,0x07,0x00,0x06,0x00,0x03,0x00,0x03,0x80,0x01,0xc0,0x01,0xc0,0x00,0xc0,0x00,};" strPDB="{0xe0,0xff,0x20,0x80,0xbe,0xff,0xb1,0xea,0xbf,0xd5,0xbf,0xea,0xbf,0xd5,0xb1,0xea,0xbe,0xd5,0x31,0xc0,0x31,0xd1,0xbf,0xe0,0xa0,0xff,0xa0,0xff,0xc0,0x7f,0x00,0x1f,};" strPDF="{0x80,0x01,0x80,0x01,0xff,0x3f,0x01,0x61,0x01,0x61,0x01,0x63,0x81,0x64,0x81,0xfc,0xc1,0xe2,0x61,0xe0,0x31,0x60,0x19,0x60,0x01,0x60,0x01,0x60,0xff,0x7f,0xff,0x7f,};" strPPT="{0x00,0x00,0xff,0xff,0x01,0x80,0x01,0x80,0xf9,0xbf,0x05,0xa0,0xc5,0xa6,0xe5,0xa0,0xe5,0xa7,0xc5,0xa3,0x05,0xa0,0xfd,0xbf,0x01,0x80,0x01,0x80,0xff,0xff,0x00,0x00,};" strPRC="{0xe0,0x03,0x38,0x18,0x0c,0x3c,0x86,0x7e,0x86,0x67,0x83,0xe3,0x83,0xc7,0x03,0xc0,0x03,0xc0,0xe3,0xc1,0xc7,0xc1,0xe6,0x61,0x7e,0x61,0x3c,0x30,0x18,0x1c,0xc0,0x07,};" strSCR="{0x55,0x95,0xf6,0xbf,0x87,0xbf,0xce,0xbf,0x87,0xbf,0x36,0xbf,0x7f,0xbe,0xfe,0xbc,0xff,0xbb,0xfe,0xbf,0xfd,0xbf,0x00,0x80,0x7d,0x80,0x10,0x80,0x01,0x80,0xfe,0xff,};" strSNP="{0xfc,0x0f,0x04,0x18,0x04,0x28,0xc4,0x63,0xe4,0x67,0x34,0x60,0xd4,0x63,0x74,0x66,0x64,0x6e,0xc4,0x6b,0x04,0x6c,0xe4,0x67,0xc4,0x63,0x04,0x60,0xfc,0x7f,0xfc,0x7f,};" strSXW="{0xFC,0x7F,0x04,0x40,0x04,0x7C,0x04,0x74,0xF4,0x7D,0x04,0x60,0xF4,0x7F,0x04,0x60,0xF4,0x67,0x04,0x60,0xF4,0x7F,0x04,0x60,0xF4,0x61,0x04,0x60,0xFC,0x7F,0xFC,0x7F,};" strTTF="{0xfe,0x07,0x02,0x0c,0x02,0x14,0x02,0x3c,0xfa,0x30,0xaa,0x30,0xe2,0x37,0x62,0x35,0x22,0x31,0x72,0x31,0x02,0x31,0x82,0x33,0x02,0x30,0x02,0x30,0xfe,0x3f,0xfe,0x3f,};" strTXT="{0xe0,0x3f,0xf0,0x7f,0x08,0xa0,0xc8,0xb7,0xe4,0x93,0x04,0x98,0x02,0x88,0x02,0x9c,0x01,0x84,0x01,0x9e,0xff,0x83,0xd0,0x9f,0x10,0x80,0xd0,0x9f,0x10,0xc0,0xe0,0x7f,};" strUNK="{0xfe,0x07,0x02,0x08,0x02,0x10,0x02,0x3c,0x02,0x20,0x02,0x20,0x8a,0x23,0xf2,0x27,0xca,0x27,0xf2,0x25,0xca,0x27,0x72,0x24,0x02,0x20,0x02,0x20,0x02,0x20,0xfe,0x3f,};" strVBP="{0x00,0x00,0x06,0x20,0x1a,0x50,0x66,0xb0,0x5a,0xe0,0x72,0x40,0xd6,0x30,0x38,0x7b,0xd0,0x7e,0x1c,0x3b,0x37,0x66,0xc3,0x5a,0x8e,0x6b,0x3c,0x58,0xf0,0x7e,0xc0,0x23,};" strVBS="{0xff,0xff,0xc1,0x87,0x21,0x88,0xd1,0x9d,0x09,0x96,0xe9,0x8f,0x09,0x82,0xd1,0x85,0x21,0x88,0xf1,0x93,0xc9,0x91,0x65,0x88,0xc9,0x84,0xf1,0x83,0x01,0x80,0xff,0xff,};" strWAV="{0x80,0x01,0xc0,0x03,0xa0,0x00,0xd0,0x04,0x48,0x84,0x46,0x64,0xc1,0x14,0x41,0x05,0xc1,0xf5,0xc7,0x04,0x4e,0x14,0x58,0x64,0xf0,0x84,0xe0,0x04,0xc0,0x03,0x80,0x01,};" strWIN="{0x00,0x00,0x00,0x1e,0x80,0x7f,0xc1,0xed,0xf5,0xcc,0xfc,0xcc,0xc1,0xde,0xf5,0xff,0xfc,0xed,0xc1,0xcc,0xf5,0xcc,0xfc,0xde,0xc1,0xff,0xf5,0xe1,0x7c,0x80,0x00,0x00,};" strXLS="{0x00,0x00,0x00,0x00,0x1f,0x7c,0x21,0x42,0x46,0x3d,0x8c,0x1e,0x18,0x0f,0x30,0x06,0x70,0x04,0xe8,0x78,0xf4,0x71,0xfa,0x23,0xff,0x47,0xff,0xff,0x00,0xf8,0x00,0x00,};" strXML="{0xff,0x0f,0x01,0x10,0x01,0x20,0x01,0x78,0xc1,0x41,0x29,0x4b,0xa5,0x53,0xe9,0x4b,0xc1,0x41,0x01,0x40,0xf9,0x4f,0x01,0x40,0xf9,0x4f,0x01,0x40,0x01,0x40,0xff,0x7f,};" strZIP="{0xc0,0x1f,0x2e,0x20,0xf1,0x5f,0xff,0x57,0x01,0x54,0x01,0x54,0x01,0x54,0x01,0x54,0x01,0x54,0x01,0x54,0xff,0x5f,0x20,0x20,0xc0,0x1f,0x00,0x0c,0x80,0x7f,0x80,0x7f,};" 'Brute-force dictionary of what icon to generate for what file extension Set dic = CreateObject("Scripting.Dictionary") dic.Add "abw", "ABW" dic.Add "aif", "WAV" dic.Add "arc", "ZIP" dic.Add "arj", "ZIP" dic.Add "art", "BMP" dic.Add "asf", "AVI" dic.Add "asp", "VBS" dic.Add "asx", "AVI" dic.Add "au", "WAV" dic.Add "avi", "AVI" dic.Add "awt", "ABW" dic.Add "b64", "ZIP" dic.Add "bas", "VBS" dic.Add "bat", "BAT" dic.Add "bmp", "BMP" dic.Add "c", "VBP" dic.Add "cab", "ZIP" dic.Add "cfg", "INI" dic.Add "chm", "CHM" dic.Add "cmd", "BAT" dic.Add "com", "EXE" dic.Add "cpp", "VBP" dic.Add "css", "XML" dic.Add "dib", "BMP" dic.Add "dif", "XLS" dic.Add "dll", "DLL" dic.Add "doc", "DOC" dic.Add "dot", "DOC" dic.Add "eml", "EML" dic.Add "exe", "EXE" dic.Add "fot", "TTF" dic.Add "frm", "VBP" dic.Add "gif", "BMP" dic.Add "gz", "ZIP" dic.Add "h", "VBP" dic.Add "hlp", "HLP" dic.Add "hta", "HTA" dic.Add "htm", "HTM" dic.Add "html", "HTM" dic.Add "inc", "VBP" dic.Add "ini", "INI" dic.Add "jpeg", "BMP" dic.Add "jpg", "BMP" dic.Add "js", "VBS" dic.Add "jse", "VBS" dic.Add "log", "LOG" dic.Add "lzh", "ZIP" dic.Add "m3u", "WAV" dic.Add "mda", "MDB" dic.Add "mdb", "MDB" dic.Add "mde", "MDB" dic.Add "me", "TXT" dic.Add "mht", "HTA" dic.Add "mhtml", "HTA" dic.Add "mid", "WAV" dic.Add "midi", "WAV" dic.Add "mim", "ZIP" dic.Add "mov", "MOV" dic.Add "mp2", "MOV" dic.Add "mp3", "WAV" dic.Add "mpe", "MOV" dic.Add "mpeg", "MOV" dic.Add "mpg", "MOV" dic.Add "nws", "NWS" dic.Add "ocx", "DLL" dic.Add "oxt", "SXW" dic.Add "pbm", "BMP" dic.Add "pcx", "BMP" dic.Add "pdb", "PRC" dic.Add "pdf", "PDF" dic.Add "pgm", "BMP" dic.Add "php", "VBS" dic.Add "pl", "VBS" dic.Add "png", "BMP" dic.Add "pot", "PPT" dic.Add "ppa", "PPT" dic.Add "ppm", "BMP" dic.Add "ppt", "PPT" dic.Add "pqa", "PRC" dic.Add "prc", "PRC" dic.Add "prn", "LPT" dic.Add "ps", "LPT" dic.Add "qt", "MOV" dic.Add "ra", "WAV" dic.Add "rm", "MOV" dic.Add "rmi", "WAV" dic.Add "rmp", "MOV" dic.Add "rtf", "LOG" dic.Add "rv", "MOV" dic.Add "scr", "SCR" dic.Add "slk", "XLS" dic.Add "smi", "MOV" dic.Add "smil", "MOV" dic.Add "snd", "WAV" dic.Add "snippet", "SNP" dic.Add "spl", "MOV" dic.Add "swf", "MOV" dic.Add "sxw", "SXW" dic.Add "tar", "ZIP" dic.Add "tif", "BMP" dic.Add "tiff", "BMP" dic.Add "ttf", "TTF" dic.Add "txt", "TXT" dic.Add "url", "HTM" dic.Add "vbe", "VBS" dic.Add "vbp", "VBP" dic.Add "vbs", "VBS" dic.Add "wav", "WAV" dic.Add "wbk", "DOC" dic.Add "wm", "AVI" dic.Add "wma", "AVI" dic.Add "wmf", "AVI" dic.Add "wmv", "AVI" dic.Add "wri", "LOG" dic.Add "ws", "VBS" dic.Add "wsc", "VBS" dic.Add "wsf", "VBS" dic.Add "wsh", "VBS" dic.Add "xlb", "XLS" dic.Add "xlc", "XLS" dic.Add "xls", "XLS" dic.Add "xlv", "XLS" dic.Add "xml", "XML" dic.Add "xsl", "XML" dic.Add "z", "ZIP" dic.Add "zip", "ZIP" 'Read the directory, stuff name, size, and date into arrays Set fols = fs.GetFolder(strDirectory).SubFolders For each fol in fols On Error Resume Next Err.Clear ReDim Preserve strFolderInfo(UBound(strFolderInfo) + 1) If Err Then ReDim strFolderInfo(0) strFolderInfo(UBound(strFolderInfo)) = fol.Name & vbTab & fol.Size & vbTab & fol.DateLastModified Next Set fils = fs.GetFolder(strDirectory).Files For each fil in fils If ((Right(fil.Name, 4) <> ".xbm") And (fil.Name <> INDEX_FILE)) Then 'Don't index my own files! On Error Resume Next Err.Clear ReDim Preserve strFileInfo(UBound(strFileInfo) + 1) If Err Then ReDim strFileInfo(0) strFileInfo(UBound(strFileInfo)) = fil.Name & vbTab & fil.Size & vbTab & fil.DateLastModified End If Next 'Sort both arrays by name SortAscending strFolderInfo, vbTab, 0 SortAscending strFileInfo, vbTab, 0 'Generate the web page strIndex = "" & vbCrLf strIndex = strIndex & "" & vbCrLf strIndex = strIndex & "" & vbCrLf strIndex = strIndex & "" & vbCrLf 'Insert the header (if any) strIndex = strIndex & File2String(HEADER_FILE) & vbCrLf 'Start the file list table strIndex = strIndex & "" & vbCrLf 'Add the usual "Parent Directory" link If MAKE_PARENT_LINK Then strIconFile = DISK_GRAPHIC_PATH & GRAPHIC_PREFIX & "fld.xbm" If InStr(strIconFile, "\\") <> 1 Then If InStr(strIconFile, ":") <> 2 Then strIconFile = fs.GetAbsolutePathName(fs.BuildPath(strDirectory, strIconFile)) End If End If If WEB_GRAPHIC_PATH = "" Then strIconLink = RelativePath(strDirectory, strIconFile) Else strIconLink = WEB_GRAPHIC_PATH & GRAPHIC_PREFIX & "fld.xbm" End If strIconText = strHeader & strFLD 'Write the parent directory icon file to disk if needed If Not fs.FileExists(strIconFile) Then String2File strIconText, strIconFile strIndex = strIndex & " " & vbCrLf End If For intCounter = LBound(strFolderInfo) To UBound(strFolderInfo) 'Figure out all the FOLDER names we'll need strFileName = Split(strFolderInfo(intCounter), vbTab)(0) If strFileName <> "" Then 'Don't generate output if there are no folders! strFileLink = Replace(strFileName, " ", "%20") strIconFile = DISK_GRAPHIC_PATH & GRAPHIC_PREFIX & "dir.xbm" If InStr(strIconFile, "\\") <> 1 Then If InStr(strIconFile, ":") <> 2 Then strIconFile = fs.GetAbsolutePathName(fs.BuildPath(strDirectory, strIconFile)) End If End If If WEB_GRAPHIC_PATH = "" Then strIconLink = RelativePath(strDirectory, strIconFile) Else strIconLink = WEB_GRAPHIC_PATH & GRAPHIC_PREFIX & "dir.xbm" End If strIconText = strHeader & strDIR strFileSize = Split(strFolderInfo(intCounter), vbTab)(1) strFileModified = Split(strFolderInfo(intCounter), vbTab)(2) 'Write the icon file to disk if needed If Not fs.FileExists(strIconFile) Then String2File strIconText, strIconFile 'Add a line to the web page strIndex = strIndex & " " & vbCrLf End If Next For intCounter = LBound(strFileInfo) To UBound(strFileInfo) 'Figure out all the FILE names we'll need strFileName = Split(strFileInfo(intCounter), vbTab)(0) strFileLink = Replace(strFileName, " ", "%20") strFileSize = Split(strFileInfo(intCounter), vbTab)(1) strFileModified = Split(strFileInfo(intCounter), vbTab)(2) 'Figure out what icon to use strFileExtension = Lcase(Mid(strFileName, InStrRev(strFileName, ".") + 1)) If dic.Exists(strFileExtension) Then strStringName = Ucase(dic(strFileExtension)) Else strStringName = "UNK" End If strIconFile = DISK_GRAPHIC_PATH & GRAPHIC_PREFIX & LCase(strStringName) & ".xbm" If InStr(strIconFile, "\\") <> 1 Then If InStr(strIconFile, ":") <> 2 Then strIconFile = fs.GetAbsolutePathName(fs.BuildPath(strDirectory, strIconFile)) End If End If If WEB_GRAPHIC_PATH = "" Then strIconLink = RelativePath(strDirectory, strIconFile) Else strIconLink = WEB_GRAPHIC_PATH & GRAPHIC_PREFIX & "fld.xbm" End If strStringName = "str" & Ucase(strStringName) strIconText = Eval("strHeader & " & Eval("strStringName")) 'Write the icon file to disk if needed If Not fs.FileExists(strIconFile) Then String2File strIconText, strIconFile 'Add a line to the web page strIndex = strIndex & " " & vbCrLf Next strIndex = strIndex & "
 Parent Directory  
 " & strFileName & "" & strFileSize _ & "  " & strFileModified & "
 " & strFileName & "" & strFileSize _ & "  " & strFileModified & "
" & vbCrLf 'Insert the footer (if any) strIndex = strIndex & File2String(FOOTER_FILE) & vbCrLf 'Close the html strIndex = strIndex & "" String2File strIndex, fs.GetAbsolutePathName(fs.BuildPath(strDirectory, INDEX_FILE)) Sub SortAscending(strArray, strSplitCharacter, intSortByElement) 'Bubble sort! No laughing allowed! It works, and it's easy to understand! 'Sorts a single-dimension array whose data elements are delimited text. Dim blnChanged 'As Boolean Dim strBuffer 'As String Dim intCounter 'As Integer If LBound(strArray) = UBound(strArray) Then Exit Sub blnChanged = True Do Until Not blnChanged blnChanged = False For intCounter = Lbound(strArray) + 1 to Ubound(strArray) If Lcase(Split(strArray(intCounter -1), strSplitCharacter)(intSortByElement)) > Lcase(Split(strArray(intCounter), strSplitCharacter)(intSortByElement)) Then blnChanged = True strBuffer = strArray(intCounter -1) strArray(intCounter -1) = strArray(intCounter) strArray(intCounter) = strBuffer End If Next Loop End Sub Sub String2File(strData, strFileName) 'Writes a string to a file Dim fs 'As Scripting.FileSystemObject Dim ts 'As Scripting.TextStream Const ForWriting = 2 Set fs = CreateObject("Scripting.FileSystemObject") Set ts = fs.OpenTextFile(strFileName, ForWriting, True) ts.Write(strData) 'Clean up ts.Close Set ts = Nothing Set fs = Nothing End Sub Function File2String(strFile) 'As String Dim fs 'As Scripting.FileSystemObject Dim ts 'As Scripting.TextStream Const ForReading = 1 Set fs = CreateObject("Scripting.FileSystemObject") If fs.FileExists(strFile) Then Set ts = fs.OpenTextFile(strFile, ForReading, True) If ts.AtEndOfStream Then File2String ="" Else File2String = ts.ReadAll End If ts.Close Else File2String = "" End If End Function Function RelativePath(strFrom, strTo) 'Returns a string containing a URL-relative path 'between the two folders or files. For example, if 'strFrom was "C:\a\b\c\d\e" and strTo was "C:\a\b\x\y", 'then the result would be "../../../x/y/" Dim intEnd, intCount Dim strFromPath, strToPath, strRelativePath Dim fs 'Check for trivial input If strTo = "" Or strTo = "./" Or strTo = ".\" Then RelativePath = strFrom Exit Function End If Set fs = CreateObject("Scripting.FileSystemObject") 'Preserve input variables strFromPath = strFrom strToPath = strTo 'Append a slash to folders (assuming we are doing local stuff) If Right(strFromPath, 1) <> "\" Then If fs.FolderExists(strFromPath) Then strFromPath = strFromPath & "\" End If If Right(strToPath, 1) <> "\" Then If fs.FolderExists(strToPath) Then strToPath = strToPath & "\" End If 'To see how much the paths have in common, we see which is shortest If Len(strFromPath) > Len(strToPath) Then intEnd = Len(strToPath) Else intEnd = Len(strFromPath) End If 'Find the common path For intCount = 1 To intEnd If Mid(strFromPath, intCount, 1) <> Mid(strToPath, intCount, 1) Then Exit For Next If intCount = 1 Then 'The first character is different: They are on different drives? Give up! RelativePath = "" Exit Function End If 'Replace the slashes strFromPath = Replace(strFromPath, "\", "/") strToPath = Replace(strToPath, "\", "/") 'Back up the common counter to the nearest slash intCount = InStrRev(Left(strToPath, intCount), "/") + 1 'Trim the paths strFromPath = Mid(strFromPath, intCount) strToPath = Mid(strToPath, intCount) 'Start with the strToPath as the base for the relative path strRelativePath = Replace(strToPath, " ", "%20") 'Walk up a level for every directory in strFromPath For intCount = 1 To Len(strFromPath) If Mid(strFromPath, intCount, 1) = "/" Then strRelativePath = "../" & strRelativePath Next RelativePath = strRelativePath End Function