' RunFilesUserProgram.vbs
'========================   Описание   =====================================
' Запуск выделенных файлов по очереди в нужных вам программах прописанных в скрипте
' если расширение не совпадает с ассоциациями, просто открывается программа
'========================  Параметры =====================================
' 1-й параметр: файл список
' 2-й параметр: N - номер ассоциаций
'========================   Примеры   =====================================
' %L 1 - открываются файлы в AkelPad
' %L 2 - открываются файлы в Imagine
' %L 3 - открываются файлы в Vlc
'
' Автор:             Аверин Андрей
' Версия:          1.0 (21.11.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'========================================================================
If WScript.Arguments.Count <2 Then
   MsgBox "Не хватает параметров!", vbOKOnly & vbInformation, "" : WScript.Quit
End If

Dim WSH, File
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
Set ListFile = FSO.OpenTextFile(GetPath(WScript.Arguments(0)), 1)

Do While Not ListFile.AtEndOfStream
   Param = GetPath(ListFile.ReadLine)
   Ext = LCase(FSO.GetExtensionName(Param))
   File = ""
' Ассоциации. LineExt - строка расширений, Program - Программа
' Необходимо вставить свои пути
   Select Case WScript.Arguments(1)
     Case 1
       LineExt = ";txt;ini;mnu;"
       Program = "%COMMANDER_PATH%\AkelPad.exe"
       CheckExt
     Case 2
       LineExt = ";jpg;png;gif;"
       Program = "%COMMANDER_PATH%\Plugins\wlx\Imagine\Imagine.exe"
       CheckExt
     Case 3
       LineExt = ";mp3;wma;"
       Program = "%COMMANDER_PATH%\Programs\Players\Winamp\Winamp.exe"
       CheckExt
' условий может быть сколько угодно
'     Case 4
'       LineExt = ";ext1;ext2;ext3;"
'       Program = "%COMMANDER_PATH%\Программа.exe"
'       CheckExt
'     Case 5
'       LineExt = ";ext1;ext2;ext3;"
'       Program = "%COMMANDER_PATH%\Программа.exe"
'       CheckExt
   End Select
   Program = GetPath(Program)
   If Not FSO.FileExists(Program) Then
     MsgBox "Не верно указана программа", vbOKOnly & vbInformation, "" : WsEnd
   End If
  WSH.Run Chr(34) & Program & Chr(34) & File , 1, False
Loop
WsEnd

Function GetPath(pPath) : GetPath = WSH.ExpandEnvironmentStrings(pPath) : End Function
Sub WsEnd : ListFile.Close : Set ListFile = Nothing : Set FSO = Nothing : Set WSH = Nothing : WScript.Quit : End Sub

Sub CheckExt
   If InStr(LineExt, ";" & Ext & ";") > 0 Then File = Chr(32) & Chr(34) & Param & Chr(34)
End Sub

' RunFilesNInProgram2.vbs
'========================   Описание   =====================================
' Запуск выделенных файлов по очереди в прописанной в скрипте программе с ограничениями по количеству
' если расширение файла не совпадает с поддерживаемыми , просто открывается программа
' если перетянуть любой файл на кнопку, то он также откроется в программе
'=======================   Параметры  =====================================
' 1-й параметр: список_файлов.tmp (обязательный)
' 2-й параметр: максимальное количество открытия файлов
'========================   Примеры   =====================================
' %L - открыть выделенные файлы (максимум задаётся в переменной n)
' %L 5 -  открыть выделенные файлы (максимум 5)
' при перетаскивании на кнопку открывается один файл
' Автор:             Аверин Андрей
' Версия:          1.1 ( 30.11.2011 - 01.12.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'=================   Изменяемые параметры   ================================
Program = "%COMMANDER_PATH%\Programs\Text\WinDjView\WinDjView.exe"    ' программа
LineExt = ";djv;djvu;" ' строка поддерживаемых расширений
n = 5 ' максимальное количество открытия файлов (переопределяется 2-м параметром)
'=========================================================================
Dim WSH
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
Cnt = WScript.Arguments.Count : k = 0

Program = GetPath(Program)
If Not FSO.FileExists(Program) Then
   MsgBox "Не верно указана программа", vbOKOnly & vbInformation, "" : WsEnd
End If
If Cnt = 0 Then
   RunProgram : WsEnd
End If
Param = GetPath(WScript.Arguments(0))
If LCase(FSO.GetExtensionName(Param)) = "tmp" Then
   List = Split(FSO.OpenTextFile(Param).ReadAll, vbNewLine)
   If Cnt > 1 Then n = CInt(WScript.Arguments(1))
Else
   Cnt = 1 : RunProgram : WsEnd
End If

For i = 0 To Ubound(List)
   Param = GetPath(List(i))
   Ext = LCase(FSO.GetExtensionName(Param))
   If InStr(LineExt, ";" & Ext & ";") > 0 Then
     Cnt = 1 : k = k + 1 : RunProgram
   End If
   If n =< k Then Exit For
Next
if k = 0 Then
   Cnt = 0 : Param = "" : RunProgram
End If
WsEnd

Function GetPath(pPath) : GetPath = WSH.ExpandEnvironmentStrings(pPath) : End Function
Sub WsEnd : Set FSO = Nothing : Set WSH = Nothing : WScript.Quit : End Sub

Sub RunProgram
   If Cnt = 1 Then Param = Chr(32) & Chr(34) & Param & Chr(34)
  WSH.Run Chr(34) & Program & Chr(34) & Param , 1, False
End Sub

' RunFilesInProgram.vbs
'========================   Описание   =====================================
' Запуск выделенных файлов по очереди в программе
' если расширение файла не совпадает с поддерживаемыми , просто открывается программа
' если перетянуть любой файл на кнопку, то он также откроется в программе
' Пример: %L
'
' Автор:             Аверин Андрей
' Версия:          1.1 (21.11.2011 - 01.12.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'=================   Изменяемые параметры   ================================
Program = "%COMMANDER_PATH%\AkelPad.exe"    ' программа
LineExt = ";txt;ini;mnu;" ' строка поддерживаемых расширений
'========================================================================
Dim WSH
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
Cnt = WScript.Arguments.Count : k = 0

Program = GetPath(Program)
If Not FSO.FileExists(Program) Then
   MsgBox "Не верно указана программа", vbOKOnly & vbInformation, "" : WsEnd
End If
If Cnt = 0 Then
   RunProgram : WsEnd
End If
Param = GetPath(WScript.Arguments(0))
If LCase(FSO.GetExtensionName(Param)) = "tmp" Then
   List = Split(FSO.OpenTextFile(Param).ReadAll, vbNewLine)
Else
   Cnt = 1 : RunProgram : WsEnd
End If

For i = 0 To Ubound(List)
   Param = GetPath(List(i))
   Ext = LCase(FSO.GetExtensionName(Param))
   If InStr(LineExt, ";" & Ext & ";") > 0 Then
     Cnt = 1 : k = 1 : RunProgram
   End If
Next
if k = 0 Then
   Cnt = 0 : Param = "" : RunProgram
End If
WsEnd

Function GetPath(pPath) : GetPath = WSH.ExpandEnvironmentStrings(pPath) : End Function
Sub WsEnd : Set FSO = Nothing : Set WSH = Nothing : WScript.Quit : End Sub

Sub RunProgram
   If Cnt = 1 Then Param = Chr(32) & Chr(34) & Param & Chr(34)
  WSH.Run Chr(34) & Program & Chr(34) & Param , 1, False
End Sub

' M3u-Skaner2.vbs
'========================   Описание   =====================================
' Проверка путей файлов (mp3, wma) в выделенных M3U листах
'=======================   Параметры  =====================================
' 1-й параметр: Список .M3U файлов
' 2-й параметр: Папка музыкальной библиотеки
' 3-й параметр:
'    0 - Проверяет M3U файлы (по умолчанию)
'    1 - Обновляет или создаёт файл-список из всех треков музыкальной библиотеки
'    2 - Обновляет файл-список всех треков библиотеки + Проверяет M3U файлы
'    3 - Открывает файл-список всех треков музыкальной библиотеки в редакторе
'========================   Примеры   =====================================
' %L "d:\Музыка"    - Проверка M3U файлов
' %L "d:\Музыка" 1 - Обновить или создать файл-список из всей музыкальной библиотеки
'====================   Как работает скрипт   ================================
' Создаётся список всех треков музыкальных файлов из заданной папки
' Сравниваются имена из M3U листов с созданным списком
' Существующий M3U копируется в M3U.bak,
' на его месте создаётся новый .M3U лист из найденных в списке имён.
' Не найденные имена треков записываются в файл M3U.not
' (время создании списка зависит от к-ва композиций, в моей ~50000 - создаётся несколько минут)
' Автор:             Аверин Андрей
' Версия:          1.5 (28.04.2011 - 14.11.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'========================================================================

Cnt = WScript.Arguments.Count
If Cnt < 1 Then
    MsgBox "Не хватает параметров!!!", vbOKOnly & vbCritical, "Проверка путей mp3 файлов"
    WScript.Quit
Else
'====================   Изменяемые пути   ==================================
Program = "%COMMANDER_PATH%\AkelPad.exe" ' текстовый редактор
FileListMus = "%COMMANDER_PATH%\Files\Lists\MusicList\MusicList.txt" ' файл-список всех треков музыкальной библиотеки
IncorrectNameArtistsRu = "%COMMANDER_PATH%\Files\Lists\MusicList\IncorrectNameArtistsRu.txt"
IncorrectNameArtistsEn = "%COMMANDER_PATH%\Files\Lists\MusicList\IncorrectNameArtistsEn.txt"
FullNameArtiists = "%COMMANDER_PATH%\Files\Lists\MusicList\FullNameArtiists.txt"
FuncPlus = "%COMMANDER_PATH%\Scripts\Include\FunctionsPlus.vbs"  ' файл с дополнительными функциями
'========================================================================
    Dim FSO
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Execute FSO.OpenTextFile(GetPath(FuncPlus)).ReadAll ' добавление функций из файла
    mListFile = GetPath(FileListMus) : pMusic = GetPath(WScript.Arguments(1))
    nCount = 0
    If Cnt > 2 Then nCount = WScript.Arguments(2)
    If Cnt = 0 Or Cnt = 2 Then
      FindStr = Array("mptri.net"," new."," - Zzzz","Www.Notamusic.Net","Www.Foxplay.Biz","mp3ostrov.com","Mp3wall.Ru","[Www.Djpypsik.Jino-Net.Ru]","(Mp3ex.Net)","!!!","!!","(Www.Primemusic.Ru)"," hes "," ant "," dont ","Mcs'","Instr.","&&","& &","-.","»","«"," -.","dj.","Pres.","Caucasus.Net","Www.Mp3s.Su","Smotra.RuWap.Kengu.Ru","Muslimusic.Net","(Malinki.Ru)","(Www.Mp3sfinder.Com)","(Tutfree.Ru)"  ,"(Www.Pctrecords.Com)","(Zvukoff.Ru)"," !","D.J.","Феат.","Www.Russianrap.Info","djs","(Muzofon.Com)","#","''"," , ","mr..","mr.","mr","_","Rmx","Dr.","- -","Didj ","-and-"," and ","Dj","  's"," 's","- ","..."," -","----","---","--","vsdj"," vs.."," vs."," vs ","&"," ft..","ft."," ft ",",","`","~","Feat..","Feat."," Feat ","(",")","––","–","    ","   ","  "," .","+","[","]","modj o","gadj o",")..","w & w","- Remix","( Feat"," )","( ",". mp3","Mcs","vs. e ","a - via ","–","(& "," ()",".agr."," its "," mr. "," Prod.)",")(",") ("," im ","Pri Uchastii","Pri Uch"," - blap.","Dj ’s","feat. "," При Участии ",", "," ft. "," pres "," pres. "," present "," feat "," vs "," vs. ","ft. ","vs. "," ft ","(vs ",";","уч.", "’", "feat", " Vs. ", "Ремикс", "Ремих")
      NewStr = Array("",".","","","","","","","","","",""," he's "," an't "," don't "," Mc's ","Instrumental"," & "," & ",".","'","'",".","Dj"," Pres. ","","","","","","","","","","!","Dj","&","","Dj's","","","'",", "," mr. ","mr "," mr. "," ","Remix","Dr. "," - ","Dj "," & "," & ","Dj ","'s ","'s "," - ","... "," - ","-","-","-"," & Dj "," & "," & "," & "," & "," & "," & "," & ",", ","'",""," & "," & "," & "," (",") ","-","-"," "," "," ",".","&","(",")","modjo","gadjo",").","w&w","Remix","(&",")","(",".mp3","Mc's","vse ","a-via ","-","(","","."," it's ","mr. ",")"," & "," & "," i'm ","&","&",".","Dj's","& "," & "," & "," & "," & "," & "," & "," & "," & "," & ","& ","& "," & ","(& "," &","&","'", " ", " & ", "Remix", "Remix")
    End If
    Select Case nCount
      Case 0 Call ScanerM3u
      Case 1 Call CreateMusicList(mListFile, pMusic)
      Case 2 Call CreateMusicList(mListFile, pMusic) : Call ScanerM3u
      Case 3
        CreateObject("WScript.Shell").Run Chr(34) & GetPath(Program) & Chr(34) & Chr(32) & Chr(34) & mListFile & Chr(34)
        Call WsEnd
    End Select
End If

WsEnd

Sub ScanerM3u
    If Not FSO.FileExists(mListFile) Then CreateMusicList
    On Error Resume Next
    Text = FSO.OpenTextFile(mListFile, 1).ReadAll
    If InStr(Text, vbNewLine) = 0 Then Text = FSO.OpenTextFile(mListFile, 1, False, -1).ReadAll
    Set ListFile = FSO.OpenTextFile(GetPath(WScript.Arguments(0)), 1)
    Do While Not ListFile.AtEndOfStream
      noName = "" : noText = "" : mText = "" : m3uFile = ListFile.ReadLine
      If LCase(FSO.GetExtensionName(m3uFile)) = "m3u" Then
        m3uText = FSO.OpenTextFile(m3uFile).ReadAll
        m3uText = RegExpReplace(m3uText, "(\n)(#extinf)(.*)(\n)", "$1", 0, 1, 1)
        List = Split(m3uText, vbNewLine) : List = DelDublicateArr(List)
        For i = 0 To Ubound(List)
          If InStr(List(i), ":\") > 0 Or InStr(List(i), ".") > 0 Then
            If FSO.FileExists(List(i)) Then
              mText = mText & List(i) & vbNewLine
            Else
              NameExt = FSO.GetFileName(List(i)) : inNe = InStr(LCase(Text), LCase(NameExt))
              If inNe > 0 Then
                LeftText = Left(Text, inNe - 1)
                NewPath = Mid(LeftText, InStrRev(LeftText, vbNewLine) + 2) & NameExt
                mText = mText & NewPath & vbNewLine
              Else
                NameExt = RegExpReplace(NameExt, "^[\d]*", "", 0, 1, 1) ' удаление начальных цифр в треках
                NameExt = Trim(RegExpReplace(NameExt, "^[-. !;:,#№&@*_+='~`%$^()[]*", "", 0, 1, 1)) ' удаление мусора в начале треков
                inNe = InStr(LCase(Text), LCase(NameExt))
                If inNe > 0 Then
                  LeftText = Left(Text, inNe - 1)
                  NewPath = Mid(LeftText, InStrRev(LeftText, vbNewLine) + 2) & NameExt
                  mText = mText & NewPath & vbNewLine
                Else
                  noText = noText & List(i) & vbNewLine : noName = noName & NameExt & vbNewLine
                End If
              End If
            End If
          End If
        Next
      End If
' исправление названий треков
      If Len(noText) > 0 Then
        nText = noText : noText = "" : nName = noName : noName = ""
        For i = 0 To Ubound(FindStr)
          nName = Replace(nName, FindStr(i), NewStr(i))
        Next
        nTxt = Split(nText, vbNewLine) : nNm = Split(nName, vbNewLine)

        For i = 0 To Ubound(nNm)
          NameExt = nNm(i) : inNe = InStr(LCase(Text), LCase(NameExt))
          If inNe > 0 Then
            LeftText = Left(Text, inNe - 1)
            NewPath = Mid(LeftText, InStrRev(LeftText, vbNewLine) + 2) & NameExt
            mText = mText & NewPath & vbNewLine
          Else
            inn = InStr(NameExt, " - ")
            If inn > 0 Then
              Lef = Left(NameExt, inn - 1)
              Lef = RegExpReplace(Lef, " и ", " & ", 0, 1, 1)
              Lef = RegExpReplace(Lef, " i ", " & ", 0, 1, 1)
              NameExt = Lef & Mid(NameExt, inn)
              inNe = InStr(LCase(Text), LCase(NameExt))
              If inNe > 0 Then
                LeftText = Left(Text, inNe - 1)
                NewPath = Mid(LeftText, InStrRev(LeftText, vbNewLine) + 2) & NameExt
                mText = mText & NewPath & vbNewLine
              Else
                noText = noText & nTxt(i) & vbNewLine
                noName = noName & NameExt & vbNewLine
              End If
            End If
          End If
        Next
      End If
' исправление имён артистов
      If Len(noText) > 0 Then
        nText = noText : noText = "" : nName = noName : noName = ""
        nName = SearchAndReplaceFileList(nName, IncorrectNameArtistsRu)
        nName = SearchAndReplaceFileList(nName, IncorrectNameArtistsEn)
        nTxt = Split(nText, vbNewLine) : nNm = Split(nName, vbNewLine)

        For i = 0 To Ubound(nNm)
          NameExt = nNm(i) : inNe = InStr(LCase(Text), LCase(NameExt))
          If inNe > 0 Then
            LeftText = Left(Text, inNe - 1)
            NewPath = Mid(LeftText, InStrRev(LeftText, vbNewLine) + 2) & NameExt
            mText = mText & NewPath & vbNewLine
          Else
            inn = InStr(NameExt, " - ")
            If inn > 0 Then
              Lef = Left(NameExt, inn - 1) : sp = InStr(Lef, Chr(32))
              If sp = 0 Then
                Lef = Lef & Chr(32)
                Lef = SearchAndReplaceFileList(Lef, FullNameArtiists)
                NameExt = Lef & Mid(NameExt, inn + 1)
                inNe = InStr(LCase(Text), LCase(NameExt))
                If inNe > 0 Then
                  LeftText = Left(Text, inNe - 1)
                  NewPath = Mid(LeftText, InStrRev(LeftText, vbNewLine) + 2) & NameExt
                  mText = mText & NewPath & vbNewLine
                Else
                  noText = noText & nTxt(i) & vbNewLine : noName = noName & NameExt & vbNewLine
                End If
              End If
            End If
          End If
        Next
      End If

      mText = Join(DelDublicateArr(Split(mText, vbNewLine)), vbNewLine)
      FSO.CopyFile m3uFile, m3uFile & ".bak"
      FSO.OpenTextFile(m3uFile, 2).Write mText
      FSO.CreateTextFile(m3uFile & ".not").Write noText
      FSO.CreateTextFile(m3uFile & "_Name.not").Write noName
    Loop
    Set ListFile = Nothing : Call WsEnd
End Sub

Function GetPath(pPath)
    GetPath = CreateObject("WScript.Shell").ExpandEnvironmentStrings(pPath)
End Function

Sub WsEnd
    Set FSO = Nothing : WScript.Quit
End Sub

' RestorePoint.vbs
'====================================
Titles = "Создание точки восстановления"
If WScript.Arguments.Count > 0 Then
   If GetObject("winmgmts:\\.\root\default:Systemrestore").CreateRestorePoint("Restore Point Today", 0, 100) = 0 Then
     MsgBox Titles & " прошло успешно. Через некоторое время ее можно будет увидеть.", 64, Titles
   Else
     MsgBox Titles & " прошло неудачно. Пожалуйста, проверьте ваш диск.", 64, Titles
   End If
Else
   With CreateObject("Shell.Application")
   .ShellExecute "wscript.exe", Chr(34) & WScript.ScriptFullName & Chr(34) & " RunAsAdmin", , "runas", 1
   End With
End If

' DownloadWGetWithBuffer.vbs
'========================   Описание   =====================================
' Производит скачивание файла в текущую панель, адрес из буфера обмена
' Автор:             SkOle & Аверин Андрей
' Версия:          1.1 (29.11.2011)
' Site:                  http://tc-image.3dn.ru
'====================   Изменяемые пути   ===================================
Program = "%COMMANDER_PATH%\Utilities\Inet\WGet\WGet.exe"
'=========================================================================
Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
If Len(Clip) > 0 Then
   For i = 1 To Len(Str)
     Code = Asc(Mid(Str, i, 1))
     If (Code > 191) Or (Code = 32) Or (Code = 168) Or (Code = 184) Then
       Clip = Clip & "%" & Hex(Code)
     Else
       Clip = Clip & Mid(Str, i, 1)
     End If
   Next
   With CreateObject("WScript.Shell")
     .Run Chr(34) & .ExpandEnvironmentStrings(Program) & Chr(34) & " -N -nd -v -c -t 0 --ftp-user=anonymous " & Clip, 2
   End With
End If

' DownloadWGet.vbs
'========================   Описание   =====================================
'  Производит скачивание файлов и сайтов из локальных сетей и Интернет, возможна докачка,
'  скачиваемый файл можно задавать как в ручную, так и из файла с расширением URL
'=======================   Параметры  =====================================
'  "%L"(именно в кавычках!)
' Автор:             SkOle & Аверин Андрей
' Версия:          1.1 (05.06.2007 - 29.11.2011)
' Site:                  http://tc-image.3dn.ru
'====================   Изменяемые пути   ===================================
Program = "%COMMANDER_PATH%\Utilities\Inet\WGet\WGet.exe"
'=========================================================================
Titles = "Cкачивание файлов и сайтов из локальных сетей"
Line = vbNewLine & "Введите ссылку для скачивания"
Params = " -r -c -nd --tries=1000000"
With CreateObject("Scripting.FileSystemObject")
   If WScript.Arguments.Count > 0 Then
     Set TempFile = .OpenTextFile(WScript.Arguments(0), 1)
     Do While Not TempFile.AtEndOfStream
       File = TempFile.ReadLine
       If LCase(.GetExtensionName(File)) <> "url" Then
         URL = InputBox("Файл " & File & " не является URL-ом." & Line, Titles)
         If Len(URL) > 0 Then RunProgram(Params & Chr(32) & URL)
       Else
        RunProgram(" -i " & File & Params)
      End If
     Loop
     TempFile.Close : Set TempFile = Nothing
   Else
     URL = InputBox("Не указаны параметры." & Line, Titles)
     If Len(URL) > 0 Then RunProgram(Params & Chr(32) & URL)
   End If
End With
WScript.Quit

Sub RunProgram(P)
   With CreateObject("WScript.Shell")
     .Run .ExpandEnvironmentStrings(Program) & P, 7, False
   End With
End Sub

' RunFilesNInProgram.vbs
'========================   Описание   =====================================
' Запуск выделенных файлов по очереди в прописанной в скрипте программе с ограничениями по количеству
' если расширение файла не совпадает с поддерживаемыми , просто открывается программа
' если перетянуть любой файл на кнопку, то он также откроется в программе
'=======================   Параметры  =====================================
' 1-й параметр: список_файлов.tmp (обязательный)
' 2-й параметр: максимальное количество открытия файлов
'========================   Примеры   =====================================
' %L - открыть выделенные файлы (максимум задаётся в переменной n)
' %L 5 -  открыть выделенные файлы (максимум 5)
' при перетаскивании на кнопку открывается один файл
' Автор:             Аверин Андрей
' Версия:          1.1 ( 30.11.2011 - 01.12.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'=================   Изменяемые параметры   ================================
Program = "%COMMANDER_PATH%\AkelPad.exe"    ' программа
LineExt = ";txt;ini;mnu;" ' строка поддерживаемых расширений
n = 10 ' максимальное количество открытия файлов (переопределяется 2-м параметром)
'=========================================================================
Dim WSH
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
Cnt = WScript.Arguments.Count : k = 0

Program = GetPath(Program)
If Not FSO.FileExists(Program) Then
   MsgBox "Не верно указана программа", vbOKOnly & vbInformation, "" : WsEnd
End If
If Cnt = 0 Then
   RunProgram : WsEnd
End If
Param = GetPath(WScript.Arguments(0))
If LCase(FSO.GetExtensionName(Param)) = "tmp" Then
   List = Split(FSO.OpenTextFile(Param).ReadAll, vbNewLine)
   If Cnt > 1 Then n = CInt(WScript.Arguments(1))
Else
   Cnt = 1 : RunProgram : WsEnd
End If

For i = 0 To Ubound(List)
   Param = GetPath(List(i))
   Ext = LCase(FSO.GetExtensionName(Param))
   If InStr(LineExt, ";" & Ext & ";") > 0 Then
     Cnt = 1 : k = k + 1 : RunProgram
   End If
   If n =< k Then Exit For
Next
If k = 0 Then
   Cnt = 0 : Param = "" : RunProgram
End If
WsEnd

Function GetPath(pPath) : GetPath = WSH.ExpandEnvironmentStrings(pPath) : End Function
Sub WsEnd : Set FSO = Nothing : Set WSH = Nothing : WScript.Quit : End Sub

Sub RunProgram
   If Cnt = 1 Then Param = Chr(32) & Chr(34) & Param & Chr(34)
  WSH.Run Chr(34) & Program & Chr(34) & Param , 1, False
End Sub

' ScanDisksForCopyFile.vbs
'========================   Описание   =====================================
' Сканирование всех файлов на всех дисках.
' Копирование по 2 файла различных типов в заданную папку (CollFold)
' (информация записывается в CollFileINI файл)
' (время сканирования зависит от к-ва и объёма дисков)
'
' Автор:             Аверин Андрей
' Версия:          1.1 (10.07.2011 - 05.12.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'========================================================================
Dim srtExt, Spisok1, Spisok2, sum1, sum2, NoFolder
Set FSO = CreateObject("Scripting.FileSystemObject")
'====================   Изменяемые пути   ===================================
CollFold = "c:\CollectionFiles\" ' папка куда копируются файлы
CollFileINI = GetPath("%COMMANDER_PATH%\Files\Lists\Collection\CollectionFiles.ini") ' файл, куда записывается информация
'=========================================================================
nn = 2 ' к-во копируемых файлов одного типа
LineExt = ";"
LineNoDisk = "t;u;" ' строка дисков исключающихся из сканрования "c;d;e;"
Sect1 = "[Extensions1]" : Sect2 = "[Extensions2]"
vb = vbNewLine : Spisok1 = vb : Spisok2 = vb
If Not FSO.FolderExists(CollFold) Then FSO.CreateFolder(CollFold)
If Not FSO.FileExists(CollFileINI) Then
    FSO.CreateTextFile(CollFileINI)
Else
    On Error Resume Next
    Text = FSO.OpenTextFile(CollFileINI).ReadAll
    If Len(Text) > 0 Then
      j = InStr(Text, Sect2)
      If j > 0 Then
       Spisok2 = Mid(Text, j + 13) : Text = Left(Text, j - 1)
      End If
      j = InStr(Text, Sect1)
      If j > 0 Then
        Spisok1 = Mid(Text, j + 13) : Text = Left(Text, j - 1)
      End If
       summa1 = CInt(NumberExt(Text, vb & "ext1="))
       summa2 = CInt(NumberExt(Text, vb & "ext2="))
    End If
End If

For Each Drive In FSO.Drives ' цикл пока все диски на компьютере не закончатся
    NoFolder = "" : sDisc = ""
    sDisc = Drive.DriveLetter
    Select Case sDisc ' папки на дисках игнорируемые сканированием, можно добавить свои диски и папки
      Case "C" NoFolder = "c:\tc image"
      Case "D" NoFolder = "d:\загрузка;d:\картинки;d:\фильмы_сериалы"
      Case "E" NoFolder = "d:\Архив"
      Case "V" NoFolder = "v:\музыка\'"
      Case "W"NoFolder = "w:\видео\"
      Case Else
        NoFolder = "1"
    End Select
    If InStr(LCase(LineNoDisk), LCase(sDisc)) = 0 Then
      On Error Resume Next
      sDisc = sDisc & ":\"
      NoFolder = UCase(NoFolder & ";" & sDisc & "$recycle.bin;" & sDisc & "System Volume Information;" & CollFold)
      Set CFolder = FSO.GetFolder(sDisc) : FolderProcess(CFolder) : Set CFolder = Nothing
    End If
Next

' запись статистики в файл
sum1 = sum1 + summa1 : sum2 = sum2 + summa2
Text = "[Result]" & vb & "ext1=" & sum1 & vb & "ext2=" & sum2 & vb & "summa=" & sum1 + sum2 & vb &_
               Sect1 & vb & Spisok1 & vb & Sect2 & vb & Spisok2
Text = Replace(Text, vb & vb, vb)
FSO.OpenTextFile(CollFileINI, 2).Write Text
MsgBox "Всё сделано!"
Set CFolder = Nothing : Set FSO = Nothing : WScript.Quit

Function FolderProcess(CurrFolder)
    On Error Resume Next
    For Each SF in CurrFolder.SubFolders
      If InStr(NoFolder, UCase(SF)) = 0 Then FolderProcess(SF)
    Next
    For Each FF in CurrFolder.Files
      SelFile = FF.Path
      If Len(SelFile) > 0 Then
        Ext = LCase(FSO.GetExtensionName(FF.Path))
        If InStr(Spisok2, vb & Ext & vb) = 0 And InStr(Ext, "php") = 0 And InStr(Ext, "=") = 0 Then
          ne = Len(Ext)
          If ne > 0 And ne < 15 Then ' длина расширений файлов до 15 символов
            If FSO.GetFile(SelFile).Size < 40000000 Then ' копируются файлы меньше ~50 Мб
              srtExt = vb & Ext & "=" : Cnt = 0
              Value = CInt(NumberExt(Spisok1, srtExt))
              If Value < nn Then
                NewName = CollFold & FSO.GetFileName(SelFile)
                If Not FSO.FileExists(NewName) Then
                  Cnt = Value + 1
                  FSO.CopyFile SelFile, NewName
                  If nn = Cnt Then
                    Spisok2 = Spisok2 & Ext & vb
                    Spisok1 = Replace(Spisok1, srtExt & Value & vb, vb)
                    sum2 = sum2 + 1
                  Else
                    If InStr(Spisok1, srtExt & Value & vb) > 0 Then
                      Spisok1 = Replace(Spisok1, srtExt & Value & vb, srtExt & Cnt & vb)
                    Else
                      Spisok1 = srtExt & Cnt & Spisok1 : sum1 = sum1 + 1
                    End If
                  End If
                End If
              End If
            End If
          End If
        End If
      End If
    Next
End Function

Function GetPath(aPath) : GetPath = CreateObject("WScript.Shell").ExpandEnvironmentStrings(aPath) : End Function

Function NumberExt(inText, inSt)
    NumberExt = 0 : sp = InStr(inText, inSt)
    If sp > 0 Then
      sText = Mid(inText, sp + Len(inSt)) : NumberExt = Left(sText, InStr(sText, vb) - 1)
    End If
End Function

' CreateRegFile.vbs
'========================   Описание   =====================================
' Создание .Reg файла для внесения ассоциаций указанных типов файлов нужной программой
'=======================   Параметры  =====================================
' 1-й параметр: путь\к\создаваемому\файлу.Reg
' 2-й параметр: путь\к\программе
' 3-й параметр: строка расширений
' 4-й параметр: путь\к\значку.icl,номер значка (по умолчанию - программа,0)
'========================   Примеры   =====================================
' "%%COMMANDER_PATH%%\Files\Reg\Music\AssociationsExt_VLC.reg" "%%COMMANDER_PATH%%\Programs\Players\VLC\Vlc.exe" "avi;mpg" "%%COMMANDER_PATH%%\Wcmicons.dll,576"
' Автор:             Аверин Андрей
' Версия:          1.0 (13.12.2011)
' Mail:                 Averin-And@yandex.ru
'========================================================================
With WScript
   Cnt = .Arguments.Count
   If Cnt < 3 Then
     MsgBox "Не хватает параметров! Минимум должно быть 3 параметра", vbOKOnly & vbInformation, ""
     WScript.Quit
   Else
     Name = GetPath(.Arguments(0))
     Prog = ReplPath(GetPath(.Arguments(1)))
     ExtLine = LCase(.Arguments(2))
     If Cnt > 3 Then
       Icon = ReplPath(GetPath(.Arguments(3)))
     Else
       Icon = Prog & ",0"
     End If
   End If
End With
vb = vbNewLine
Text = "Windows Registry Editor Version 5.00"
Ext = Split(ExtLine, ";")

For i = 0 To Ubound(Ext)
   fExt = Ext(i) & "file"
   hkcr = "[HKEY_CLASSES_ROOT\" & fExt
   Text = Text  & vb & vb &_
                "[HKEY_CLASSES_ROOT\." & Ext(i) & "]" & vb &_
                "@=" & Chr(34) & fExt & Chr(34) & vb & vb &_
                hkcr & "]" & vb & vb &_
                hkcr & "\DefaultIcon]" & vb &_
                "@=" & Chr(34) & Icon & Chr(34) & vb & vb &_
                hkcr & "\shell]" & vb & vb &_
                hkcr & "\shell\open]" & vb & vb &_
                hkcr & "\shell\open\command]" & vb & vb &_
                "@=" & Chr(34) & "\" & Chr(34) & Prog & "\" & Chr(34) & " \" & Chr(34) & "%1\" & Chr(34) & Chr(34)
Next

CreateObject("Scripting.FileSystemObject").CreateTextFile(Name).Write Text

Function GetPath(pPath)
   GetPath = CreateObject("WScript.Shell").ExpandEnvironmentStrings(pPath)
End Function

Function ReplPath(pPath)
   ReplPath = Replace(pPath, "\", "\\")
End Function