[решено] Случайный перебор по списку без повторения

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

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

Случайный перебор по списку без повторения

Прошу помощи в оптимизации скрипта. Цель - выбрать все файлы из вложенных папок, подходящие под определённое условие (черный список\белый список) и запустить их в случайном порядке без повторений. В принципе задача довольно простая, и мною за десять минут был набросан приведённый ниже скрипт. Оттестировал на домашнем компьютере с папкой в пару сотен файлов, всё отлично работает. Но после запуска на довольно слабом по современным меркам компьютере и объеме файлов в ~16 тысяч столкнулся с заметными подвисаниями в пару десятков секунд перед переходом к следующему файлу. Собственно, проблема в функции :RebuildArray, которая каждый раз при запуске случайного файла, удаляет его из массива, генерируемого при старте скрипта. Думал над тем, как её ускорить - ничего не приходит в голову. Нужен именно батник, использование perl\python\чего-нибудь ещё - невозможно.

Код:

@Echo Off

SetLocal EnableDelayedExpansion



::========Настройки========

:: Путь к рабочей директории, будут обработаны все файлы и поддиректории в ней

Set BasePath=D:\Video\MLP

:: Черный список - всё, что здесь перечислено, исключается из обработки.

:: Проверяются пути и имена файлов или их части, каждое значение должно быть заключено в кавычки.

Set BlackList=".ass" ".srt"

:: Белый список - действует аналогично черному списку, но в обработку попадает лишь перечисленное.

:: Белый список применяется ДО черного, но не отменяет его действие

Set WhiteList="Season_1" "Season_2" "Season_3"



:Main

:: Запуск в случайном порядке без повторений всех найденных файлов (ассоциированной с этим файлом программой)

Call :MakeArray||(Echo    ERROR: No files found&Exit /B 1)

For /L %%? In (1,1,%ArraySize%) Do (

        Call :GetRandomElement||(Echo    ERROR: No more files in the queue&Exit /B 1)

        Call Set "File=%%Array[!Selected!]%%"

        :: Вывод сообщения и запуск файла, переход на следующий после подтверждения

        CLS

        For /F "delims=" %%F In ("!File!") Do (

                Echo.

                Echo    Location: %%~dpF

                Echo    File: %%~nxF

                Echo.

        )

        Start "" "!File!"

        Echo    Press any key to next file [%%?/%ArraySize%]

        Pause>nul

        Call :RebuildArray

)

Exit /B



:MakeArray

:: Создаём массив из подходящих под условия файлов

Set ArraySize=0

:: Подготовка к работе черного и белого списков

For %%? In (Include Exclude) Do (Set %%?=)

For %%L In ("Include:WhiteList:/I" "Exclude:BlackList:/V /I") Do For /F "tokens=1-3 delims=:" %%A In ("%%~L") Do (

        If Not "!%%B!"=="" (

                For %%W In (!%%B!) Do (Set %%A=!%%A! /C:"%%~W")

                Set "%%A=|FindStr %%C!%%A!"

        )

)

:: Построение массива

For /F "delims=" %%F In ('Dir "!BasePath!" /A-D /B /S!Include!!Exclude!') Do (

        Set /A ArraySize+=1

        Set "Array[!ArraySize!]=%%F"

)

If "!ArraySize!"=="0" Exit /B 1

Exit /B



:GetRandomElement

:: Если в массиве не осталось элементов, кидаем ошибку

If %ArraySize% LEQ 0 Exit /B 1

:: Инициализируем ГПСЧ и получаем номер случайного элемента массива

Echo !Random!!Random!>nul

Set /A Selected=1+%ArraySize%*!Random!/32768

Exit /B



:RebuildArray

:: Пересобираем массив со сдвигом значений, исключая из него выбранный элемент

Set Array[%Selected%]=

For /L %%E In (%Selected%,1,%ArraySize%) Do (

        :: Проверка на конечный элемент массива

        If "%Selected%"=="%ArraySize%" (

                Set /A ArraySize-=1

                Exit /B

        )

        Set /A Next=%%E+1

        Call Set Array[%%E]=%%Array[!Next!]%%

)

Set /A ArraySize-=1

Exit /B

Цитата:

Цитата Anonymоus

Нужен именно батник, использование perl\python\чего-нибудь ещё - невозможно. »

А как насчёт WSH?

Цитата:

Цитата Iska

А как насчёт WSH? »

Вполне подойдёт, это же не сторонний интерпретатор.

Anonymоus, пробуйте (требуется установленный .Net Framework):

Код:

Option Explicit



Const WshRunning  = 0

Const WshFinished = 1

Const WshFailed   = 2





Dim strSourceFolder

Dim arrBlackList

Dim arrWhiteList



Dim objFSO

Dim objWshShell



Dim strContent

Dim strLine



Dim objArrayList



Dim elem

Dim strKey



Dim objRandom

Dim intIndex





strSourceFolder = "D:\Video\MLP"



arrBlackList    = Array(".ass", ".srt")

arrWhiteList    = Array("Season_1", "Season_2", "Season_3")





Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")



If objFSO.FolderExists(strSourceFolder) Then

        Set objWshShell = WScript.CreateObject("WScript.Shell")

        

        With objWshShell.Exec("""%comspec%"" /c ""dir /a:-d /b /s """ & strSourceFolder & """""")

                If .Status <> WshFailed Then

                        strContent = ""

                        

                        Do

                                strContent = strContent & .StdOut.ReadAll()

                        Loop Until .Status = WshFinished

                End If

        End With

        

        With WScript.CreateObject("System.Collections.ArrayList")

                For Each strLine In Split(strContent, vbCrLf)

                        For Each elem In arrWhiteList

                                If InStr(1, strLine, elem, vbTextCompare) > 0 Then

                                        If Not .Contains(strLine) Then

                                                .Add strLine

                                        End If

                                End If

                        Next

                Next

                

                For Each strKey In .Clone

                        For Each elem In arrBlackList

                                If InStr(1, strKey, elem, vbTextCompare) > 0 Then

                                        .Remove strKey

                                        

                                        Exit For

                                End If

                        Next

                Next

                

                Set objRandom = WScript.CreateObject("System.Random")

                

                Do While .Count > 0

                        intIndex = objRandom.Next_2(0, .Count)

                        

                        MsgBox .Item(intIndex)

                        objWshShell.Run """" & .Item(intIndex) & """", 1, True

                        

                        .RemoveAt intIndex

                Loop

                

                Set objRandom = Nothing

        End With

        

        Set objWshShell = Nothing

Else

        WScript.Echo "Source folder [" & strSourceFolder & "] not found."

        WScript.Quit 1

End If



Set objFSO = Nothing



WScript.Quit 0

Iska, благодарю за скрипт, протестировал на большом количестве файлов, по быстродействию намного быстрее батника. Правда, при тестировании всплыла проблема с кодировкой в путях с использованием кириллицы. На месседжбоксе перед запуском файла видно, что путь выглядит как "E:\HSA\„ў*з\2012\05\dump_ra.7z", соответственно после нажатия на "OK" получаю ошибку:

Код:

Сценарий:        D:\Sandbox\random.vbs

Строка:        75

Символ:        4

Ошибка:        Не удается найти указанный файл. 

Код:        80070002

Источник:         (null)

Попробуйте так:

Код:

Option Explicit



Const WshRunning  = 0

Const WshFinished = 1

Const WshFailed   = 2



Dim strSourceFolder

Dim arrBlackList

Dim arrWhiteList





Dim objFSO

Dim objWshShell



Dim strContent

Dim strLine



Dim elem

Dim strKey



Dim objRandom

Dim intIndex





strSourceFolder = "D:\Video\MLP"



arrBlackList    = Array(".ass", ".srt")

arrWhiteList    = Array("Season_1", "Season_2", "Season_3")





Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")



If objFSO.FolderExists(strSourceFolder) Then

        Set objWshShell = WScript.CreateObject("WScript.Shell")

        

        With objWshShell.Exec("""%comspec%"" /c ""dir /a:-d /b /s """ & strSourceFolder & """""")

                If .Status <> WshFailed Then

                        strContent = ""

                        

                        Do

                                strContent = strContent & .StdOut.ReadAll()

                        Loop Until .Status = WshFinished

                End If

        End With

        

        strContent = StrConvert(strContent, "windows-1251", "cp866")

        

        With WScript.CreateObject("System.Collections.ArrayList")

                For Each strLine In Split(strContent, vbCrLf)

                        For Each elem In arrWhiteList

                                If InStr(1, strLine, elem, vbTextCompare) > 0 Then

                                        If Not .Contains(strLine) Then

                                                .Add strLine

                                        End If

                                End If

                        Next

                Next

                

                For Each strKey In .Clone

                        For Each elem In arrBlackList

                                If InStr(1, strKey, elem, vbTextCompare) > 0 Then

                                        .Remove strKey

                                        

                                        Exit For

                                End If

                        Next

                Next

                

                Set objRandom = WScript.CreateObject("System.Random")

                

                Do While .Count > 0

                        intIndex = objRandom.Next_2(0, .Count)

                        

                        MsgBox .Item(intIndex)

                        objWshShell.Run """" & .Item(intIndex) & """", 1, True

                        

                        .RemoveAt intIndex

                Loop

                

                Set objRandom = Nothing

        End With

        

        Set objWshShell = Nothing

Else

        WScript.Echo "Source folder [" & strSourceFolder & "] not found."

        WScript.Quit 1

End If



Set objFSO = Nothing



WScript.Quit 0

'=============================================================================



'=============================================================================

' HKEY_CLASSES_ROOT\MIME\Database\Charset

' cp866, windows-1251, koi8-r, unicode, utf-8, _autodetect

'=============================================================================

Function StrConvert(ByVal strText, ByVal strSourceCharset, ByVal strDestCharset)

        Const adTypeText      = 2

        Const adModeReadWrite = 3

        

        

        With WScript.CreateObject("ADODB.Stream")

                .Type      = adTypeText

                .Mode      = adModeReadWrite

                

                .Open

                

                .Charset   = strSourceCharset

                .WriteText strText

                

                .Position  = 0

                .Charset   = strDestCharset

                StrConvert = .ReadText

                

                .Close

        End With

End Function

'=============================================================================