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

[Anonymоus]

Прошу помощи в оптимизации скрипта. Цель - выбрать все файлы из вложенных папок, подходящие под определённое условие (черный список\белый список) и запустить их в случайном порядке без повторений. В принципе задача довольно простая, и мною за десять минут был набросан приведённый ниже скрипт. Оттестировал на домашнем компьютере с папкой в пару сотен файлов, всё отлично работает. Но после запуска на довольно слабом по современным меркам компьютере и объеме файлов в ~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

[Iska]

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

[Anonymоus]

А как насчёт WSH? »
Вполне подойдёт, это же не сторонний интерпретатор.

[Iska]

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

[Anonymоus]

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

Сценарий: D:\Sandbox\random.vbs
Строка: 75
Символ: 4
Ошибка: Не удается найти указанный файл.
Код: 80070002
Источник: (null)

[Iska]

Попробуйте так:
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
'=============================================================================