[решено] Поиск мультимедиа файлов - Компьютерный форум OSzone.net

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Скриптовые языки администрирования Windows (http://forum.oszone.net/forumdisplay.php?f=102)

- - [решено] Поиск мультимедиа файлов (http://forum.oszone.net/showthread.php?t=197929)

Поиск мультимедиа файлов

Нужен скрипт для поиска файлов по расширениям (.avi, .mp3, .mp4 и т.п.).
Поиск должен осуществляться по всем дискам на компьютере. И в конце записывать результаты в файл, который бы сохранял: путь к файлу, имя компьютера, желательно, IP.

P.S.: Агенты на работе начали распространять видео и ходить искать на 400 компах не весело.

Заранее благодарен.

Ну так начинай - народ по ходу дела подскажет, подправит...

Думаете, если бы я мог, то попросил бы помощи?

Цитата:

Цитата T3D

Думаете, если бы я мог, то попросил бы помощи? »

Думаем, что мог бы отфильтровать форум по 'расш' и найти http://forum.oszone.net/thread-169019.html

Код:

Dim strDelFile

Dim objFSO

Dim arrDelFile

Dim arrRashir

Dim i

Dim arrDriveItem

Dim objSubFolder

Dim FSO

Dim f



Set objFSO = CreateObject("Scripting.FileSystemObject")

Set FSO = CreateObject("Scripting.FileSystemObject") 

Set f = FSO.OpenTextFile("123.txt", 2, True) 

'Открываем файл, если он не создан, создаем его

'Путь к лог-файлу



'Заполнение массива с разришениями'

For Each arrRashir In Array(".mp3", ".avi", ".mp4", ".mkv", ".wmv")

Next



'Процедура создающая массив содержащий информацию о всех дисках'

For Each arrDriveItem In objFSO.Drives

  If arrDriveItem.DriveType = 2 Then GetFolders arrDriveItem.Path & "\"

Next



'Процедура подбора'

Sub GetFolders(strFolderName) 

On Error Resume Next

        For Each objSubFolder In objFSO.GetFolder(strFolderName).SubFolders 

        For Each 'Привязать расширения'

                If LCase(objSubFolder.Name) = LCase(arrRashir(i)) Then

                        If Err.Number = 0 Then

                                strDelFile = (strDelFile & strFolderName & vbNewLine)

                                f.WriteLine (arrDelFolders(i) & "  " & date & "  " & time)

                        Else

                                Err.Clear

                        End If

                Else 

        GetFolders objSubFolder.Path

                End If  

        Next    

End Sub

Вот, попытался сделать что-то. Не могу понять как мне привязать массив с расширениями к процедуре перебора.

P.S.: процедуры брал из скрипта по поиску и удалению папки, так что не ругайтесь, если что не так.

VBS вариант на WMI:

Код:

strFile = ".\FileList.txt"



Set objWMI = GetObject("winmgmts:\\.\root\cimv2")

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objWSS = CreateObject("WScript.Shell")



Set colItem = objWMI.ExecQuery("SELECT DeviceID From Win32_LogicalDisk Where DriveType=3")

For Each objItem In colItem

  strDRV=strDRV &"Drive='"& objItem.DeviceID &"' OR "

Next



strSELECT="SELECT Name From CIM_DataFile Where ("& Left(strDRV,Len(strDRV)-4) &") AND ("& _

  "Extension='AVI' OR " & _

  "Extension='MP3' OR " & _

  "Extension='MP4')"



Set colItem = objWMI.ExecQuery(strSELECT)

Set objFile = objFSO.OpenTextFile(strFile,2,vbTrue)



objFile.WriteLine objWSS.ExpandEnvironmentStrings("%ComputerName%"& vbCRLF)

For Each objItem In colItem

  objFile.WriteLine(objItem.Name)

Next



objFile.Close

P.S. я в таких случаях просто называю файл именем машины