<HTML>
<HEAD>
 <TITLE>
  Конец всем бардакам!
 </TITLE>
<SCRIPT LANGUAGE=VBScript>
Set objFSO = CreateObject("Scripting.FileSystemObject"
 'Определение корневой папки
'Определение корневой папки
strRoot = "E:\"
strFileSearch = "index.htm"
strText = strRoot
MsgBox strText
'Символ табуляции
strTabular = "  "
'Счетчик найденых файлов
lngFindFiles = 0
'Счетчик вложенности папки
lngChild = 0
'== Главная задача - построение всего дерева
  Call SeekFolder(strRoot, strFileSearch, 0)
'Дописать отчет о поиске
  

ocument.
Write("<HR><P>Поиск проводился в папке " & _
                 strRoot & "<BR>Найдено " & lngFindFiles & _
                 " файлов " & strFileSearch & "</P>"
 'Перебор подпапок в переданной папке
'Перебор подпапок в переданной папке
Function SeekFolder(strFolParent, strFileSearch, lngTabular)
Dim folParent   
'Родительская папка
Dim folCurrent  
'Проверяемая подпапка
Dim blGoodLuck  
'Флаг результатов поиска файла
 Set folParent = objFSO.GetFolder(strFolParent)
 lngChild = GetChildenLevel(strFolParent)
 
'Перебери все подпапки в текущей папке
 For Each folCurrent in folParent.Subfolders
  
'Если текущая подпапка содержит подпапки, то...
  If folCurrent.Subfolders.Count > 0 
Then
   '...вызови себя еще раз...
   Call SeekFolder(folCurrent.Path, strFileSearch, lngChild + 1)
  
End If
  'Проверь все файлы в текущей подпапке
  blGoodLuck = _
    objFSO.FileExists(folCurrent.Path & "\" & strFileSearch)
  
'Если результат поиска удачен, то...
  If blGoodLuck 
Then
   '...сформируй необходимые ссылки
   lngFindFiles = lngFindFiles + 1 
'Добавить к счетчику найденых файлов
   

ocument.
Write CreateTree(folCurrent.Path)
   

ocument.
Write CreateAncor(folCurrent.Path, strFileSearch, lngChild + 2)
  
End If
 Next
End Function
'Форматирование кода вывода полного имени папки
Function CreateAncor(strFolCurrent, strFileSearch, lngTabular)
 strText = Right(strFolCurrent, 
Len(strFolCurrent) - InStrRev(strFolCurrent, 
"\", 
Len(strFolCurrent) - 1))
 strText = GetTabular(lngTabular - 2) & "<A href=" & Chr(34) & strFolCurrent 
& Chr(34) & ">" & strText & "</A>" & "\<A href=" & Chr(34) & strFolCurrent & 
"/" & strFileSearch & Chr(34) & ">" & strFileSearch & "</A><BR>" & vbCrLf
 CreateAncor = strText
End Function
'Получение родитльской папки
Function GetParentFolder(strChildFolder)
  btLenChildName = InStrRev(strChildFolder, "\"
 
  GetParentFolder = 
Mid(strChildFolder, 1, btLenChildName)
End Function
'Формирование дерева для указания вложенности папки
Function CreateTree(strTemp)
  
'Получить строку вложенности, отличную от родительской папки
  strTemp = Right(strTemp, 
Len(strTemp) - 
Len(strRoot))
  lngCounter = 0
  
For lngTemp = 1 
To Len(strTemp)
    strMid = Mid(strTemp,lngTemp,1)
   
If strMid = "\" 
Then
    strReturn = strReturn & GetTabular(GetChildenLevel(Left(strTemp, lngTemp 
+ 1))) & strFolder & "<BR>" & vbCrLf
    lngCounter = lngCounter + 1
    strFolder = ""
   
Else
    strFolder = strFolder & strMid
   
End If
  Next
  If lngCounter > 0 
Then
   CreateTree = strReturn
  
End If
End Function
'Получение уровня вложенности папки (уже без Root)
Function GetChildenLevel(strTemp)
  
'Получить количество разделителей в этой строке
  For lngMid = 1 
To Len(strTemp)
   
If Mid(strTemp, lngMid,1) = "\" 
Then lngChildLevel = lngChildLevel + 1
  
Next
  GetChildenLevel = lngChildLevel
End Function
'Получение строки из заданного количества табуляций
Function GetTabular(lngTabular)
 
For lngTemp = 1 
To lngTabular
  strTemp = strTemp & strTabular
 
Next
 GetTabular = strTemp
End Function
</SCRIPT>
<STYLE>
A {Font-family:Courier 
New}
Body {Font-family:Courier 
New}
</STYLE>
</HEAD>
<BODY bgcolor=buttonface>
</H1>
</BODY>
</HTML>