<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>