[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
'=============================================================================