Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - ASP и VBScript

Страница: 1 |

 

  Вопрос: Рекурсивный обход каталога Добавлено: 24.04.06 11:02  

Автор вопроса:  testir
Задача состоит в следующем:
НУжно искать в определённо заданном каталоге, файлы недельной или какой-либо другой давности создания.
Необходимо обходить все вложенные каталоги.
Кто-нибудь реализовывал такой рекурсивный обход на VBS ?
Если не трудно помогите плиз, или если кто делал подобное, скиньте на testir@mail.ru

Ответить

  Ответы Всего ответов: 1  

Номер ответа: 1
Автор ответа:
 ZagZag



ICQ: 295002202 

Вопросов: 87
Ответов: 1684
 Профиль | | #1 Добавлено: 27.04.06 02:28
Эта HTMLка делает как ты просишь, только заточена она была для работы на
компьютере пользователя.
<HTML>
<HEAD>
 <TITLE>
  Конец всем бардакам!
 </TITLE>
<SCRIPT LANGUAGE=VBScript>
Set objFSO = CreateObject("Scripting.FileSystemObject";)
'Определение корневой папки
strRoot = "E:\"
strFileSearch = "index.htm"
strText = strRoot
MsgBox strText
'Символ табуляции
strTabular = "&nbsp;&nbsp;"
'Счетчик найденых файлов
lngFindFiles = 0
'Счетчик вложенности папки
lngChild = 0
'== Главная задача - построение всего дерева
  Call SeekFolder(strRoot, strFileSearch, 0)
'Дописать отчет о поиске
  ;Document.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 'Добавить к счетчику найденых файлов
   ;Document.Write CreateTree(folCurrent.Path)
   ;Document.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>

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам