'M3u-Skaner.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

' Автор:             Аверин Андрей
' Версия:          1.2 (28.04.2011 - 12.10.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" ' файл-список всех треков музыкальной библиотеки
'========================================================================
        Dim FSO, Text
        Set FSO = CreateObject("Scripting.FileSystemObject")
        mListFile = GetPath(FileListMus)
        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 ", ";", "уч.", "’")
          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", "& ", " & ", " & ", " & ", " & ", " & ", " & ", " & ", " & ", " & ", "& ", "& ", " & ", "(& ", " &", "&", "'")
        End If
        Select Case nCount
          Case 0
            Call ScanerM3u
          Case 1
            Call CreateMusicList
          Case 2
            Call CreateMusicList
            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

Sub WsEnd
        Set FSO = Nothing
        WScript.Quit
End Sub

Sub ScanerM3u
        If Not FSO.FileExists(mListFile) Then CreateMusicList
        Text = FSO.OpenTextFile(mListFile, 1, False, -1).ReadAll
        Set ListFile = FSO.OpenTextFile(GetPath(WScript.Arguments(0)), 1)
        Do While Not ListFile.AtEndOfStream
          noText = ""
          mText = ""
          m3uFile = ListFile.ReadLine
          If LCase(FSO.GetExtensionName(m3uFile)) = "m3u" Then
            m3uText = FSO.OpenTextFile(m3uFile).ReadAll
            m3uText = RegExpReplace(m3uText, "(\n)(#extinf)(.*)(\n)", "$1")
            m3uText = RegExpReplace(m3uText, "#extm3u\n", "")
            List = Split(m3uText, vbNewLine)
            For i = 1 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]*", "")
                    NameExt = Trim(RegExpReplace(NameExt, "^[-. !;:,#№&@*_+='~`%$^()[]*", ""))
                    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
                    End If        
                  End If
                End If
              End If
            Next
          End If
          nText = noText
          noText = ""
          For i = 0 To Ubound(FindStr)
            nText = Replace(nText, FindStr(i), NewStr(i))
          Next
          nTxt = Split(nText, vbNewLine)
          For i = 0 To Ubound(nTxt)
            NameExt = FSO.GetFileName(nTxt(i))
            NameExt = RegExpReplace(NameExt, "^[\d]*", "")
            NameExt = Trim(RegExpReplace(NameExt, "^[-. !;:,#№&@*_+='~`%$^()[]*", ""))
            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, " и ", " & ")
                Lef = RegExpReplace(Lef, " i ", " & ")
                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
                End If         
              End If
            End If        
          Next
          FSO.CopyFile m3uFile, m3uFile & ".bak"
          FSO.OpenTextFile(m3uFile, 2).Write mText
          FSO.CreateTextFile(m3uFile & ".not").Write noText
        Loop
        Set ListFile = Nothing
        Call WsEnd
End Sub

Sub CreateMusicList
        pMusic = GetPath(WScript.Arguments(1))
        if FSO.FolderExists(pMusic) = False Then
          MsgBox "Указана неверная директория!", vbCritical, "Ошибка"
          WsEnd
        Else
          Set FF = FSO.GetFolder(pMusic)
          ScanFoldMp3(FF)
          Set FF = Nothing
          FSO.CreateTextFile(mListFile, True, True).Write Text
          MsgBox "всё"
        End If
End Sub

Sub ScanFoldMp3(FF)
        For Each SF In FF.SubFolders
          ScanFoldMp3(SF)
        Next
        For Each F In FF.Files
           nFile = F.Path
           If InStr(";mp3;wma;", LCase(FSO.GetExtensionName(nFile))) > 0 Then Text = Text & nFile & vbNewLine
           'Text = Text & F.Path & vbNewLine
        Next
End Sub

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

Function RegExpReplace(pText, pFindStr, pNewStr)
        With New RegExp
          .Pattern = pFindStr : .IgnoreCase = True : .Global = True
          RegExpReplace = .Replace(pText, pNewStr)
        End With
End Function

' LinkFromAssociationsTC.vbs
'========================   Описание   =====================================
' Создание ярлыков выделенных файлов, связанных с Программой, ассоциированной в Total Commander
'=======================   Параметры  =====================================
' 1-й параметр: файл список
' 2-й параметр: файл с секцией ассоциаций
' 3-й параметр: путь сохранения ярлыка
'=======================   Дополнение   ====================================
' Можно составить СВОЙ ФАЙЛ АССОЦИАЦИЙ ListAssFiles.txt, вне файла Wincmd.ini
' где синтаксис будет таким же как и в секции [Associations]
' Filter1=;*.TXT;*.inc;
' Filter1_open=""%COMMANDER_PATH%\AkelPad.exe" "%1""
' Filter2=;*.JPG;*.bmp;
' Filter2_open=""%COMMANDER_PATH%\Plugins\wlx\Imagine\Imagine.exe" "%1""
'=======================   Параметры  =====================================
'  %L "%%COMMANDER_PATH%%\WinAssociations.ini" "%t"
'  %L "%%COMMANDER_PATH%%\Wincmd.ini" "%p"
'  %L "%%COMMANDER_PATH%%\UserAssociations_1.txt" "%APPDATA%\Microsoft\Internet Explorer\Quick Launch\"
' "%%COMMANDER_PATH%%\ListAssFiles.txt" "%%COMMANDER_PATH%%\Associations_2.txt" %%USERPROFILE%%\Desktop\"
'
' Автор:             Аверин Андрей
' Версия:          2.0 (2010 - 14.11.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'====================   Изменяемые пути   ===================================
INI = "%COMMANDER_PATH%\Scripts\Include\FunctionsINIRWS.vbs"
'========================================================================
Dim FSO, WSH
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
Execute FSO.OpenTextFile(GetPath(INI)).ReadAll

Set ListFile = FSO.OpenTextFile(WScript.Arguments(0), 1)
TPath = GetPath(WScript.Arguments(2))

Do While Not ListFile.AtEndOfStream
   SelFile = ListFile.ReadLine
   Name = FSO.GetBaseName(SelFile) : Ext = FSO.GetExtensionName(SelFile)
   ExtAss = UCase(";*." & Ext & ";")' Готовим строку для поиска в ассоциациях

   TPathN = TPath & "\" & Name & "." & Ext & ".lnk" ' Параметры ярлыка по умолчанию
   Icon = TRG & ",0"

   If FSO.FolderExists(SelFile) Then
     Icon = ",0" : TPathN = TPath & "\" & Name & "." & "lnk"
   End if

   AsText = ReadINISection(WScript.Arguments(1), "Associations")
   AsText = LCase(RegExpReplace(AsText, "( [|])(.*)(" & vbNewLine & ")", "$3")) ' удаление игнорируемых расширений
   ListAss =  Split(AsText, vbNewLine)

   For i = 0 To Ubound(ListAss)
     If Len(ListAss(i)) > 0 Then
       if InStr(UCase(ListAss(i)), ExtAss) > 1 Then
         if InStr(UCase(ListAss(i+1)),"OPEN") > 1 Then
           LA = ListAss(i+1)
           TRG = Mid(LA, InStr(1, LA, "=") + 1)
           If Mid(TRG, 1, 1) = Chr(34) Then TRG = Mid(TRG, 2)
           If Mid(TRG, 1, 1) = Chr(34) Then TRG = Mid(TRG, 2)
           TRG =Mid(TRG, 1, InStr(TRG, Chr(34)) - 1)
           TPathN = TPath & "\" & Name & "." & Ext & ".lnk"
           If InStr(1,UCase(ListAss(i + 2)),"ICON") > 1 Then
             LA = ListAss(i+2)
             Icon = Mid(LA, InStr(1, LA, "=") + 1 , Len(LA) - InStr(1, LA, "="))
             Icon = GetPath(Icon)
           End If
         End if
         Exit For
       End if
     End If
   Next
   If Len(TRG) > 0 Then
     TRG = GetPath(TRG)
     With WSH.CreateShortcut(TPathN)
       .Arguments = Chr(34) & SelFile & Chr(34)
       .Description = SelFile
       .IconLocation = icon
       .TargetPath = TRG
       .WindowStyle = 1
       .WorkingDirectory = FSO.GetParentFolderName(TRG)
       .Save
     End With
   End If
Loop

ListFile.Close : Set ListFile = Nothing : Set WSH = Nothing : Set FSO = Nothing : WScript.Quit

Function GetPath(pPath) : GetPath = WSH.ExpandEnvironmentStrings(pPath) : End Function

Function RegExpReplace(ppText, pFindStr, pNewStr)
   With New RegExp
     .Pattern = pFindStr : .IgnoreCase = True : .Global = True : RegExpReplace = .Replace(ppText, pNewStr)
   End With
End Function

' CreateHtaForDisplayPicture.vbs
'========================   Описание   ===========================
' Открывает на 10 секунд изображение под курсором (jpeg;jpg;gif;bmp)
' можно открывать несколько по очереди
' параметры %P%N

' Основан на коде Steve Yandl

' Автор:             Аверин Андрей
' Версия:          1.2 (26.08.2011 - 14.11.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'====================   Изменяемые пути   ===================================
FuncPlus = "%COMMANDER_PATH%\Scripts\Include\FunctionsPlus.vbs"
'========================================================================
If WScript.Arguments.Count = 0 Then
   MsgBox "Не хватает параметров! Должен прописан Один параметр  %P%N",_
   vbOKOnly & vbInformation, "Кратковременый просмотр изображений"
   WScript.Quit
End If

FuncPlus = CreateObject("WScript.Shell").ExpandEnvironmentStrings(FuncPlus)
strPictFile = WScript.Arguments(0)
Set FSO = CreateObject("Scripting.FileSystemObject")
strArgExt = LCase(FSO.GetExtensionName(strPictFile))
If InStr(";jpeg;jpg;gif;bmp;png;", ";" & strArgExt & ";") = 0 Then WsEnd
If Not FSO.FileExists(strPictFile) Then WsEnd
Execute FSO.OpenTextFile(FuncPlus).ReadAll

Set objShell = CreateObject("Shell.Application")
strArgParent = FSO.GetParentFolderName(strPictFile)
strArgFileName = FSO.GetFileName(strPictFile)
Set objFolder = objShell.NameSpace(strArgParent)
Set objItem = objFolder.ParseName(strArgFileName)
strDimensions = objFolder.GetDetailsOf(objItem, 31) ' размер изображения

If InStr(strDimensions, " x ") > 0 Then
   strSize = Replace(strDimensions, " x ", ", ") : strSize = Mid(strSize,2,Len(strSize)-2)
   ii = InStr(strSize, ",") : w = Left(strSize, ii - 1) + 20 : h = Mid(strSize, ii + 1) + 20
   strSize = w & ", " & h
End If

Text = "<HTML>" & vbNewLine &_
              "<HTA:Application" & vbNewLine &_
              "Caption=" & Chr(34) & "no" & Chr(34) & vbNewLine &_
              "Borderstyle="&Chr(34)&"complex"&Chr(34) & vbNewLine &_
              "Scroll=" & Chr(34) & "no" & Chr(34) & ">" & vbNewLine &_
              "<SCRIPT Language=" & Chr(34) & "VBScript" & Chr(34) & ">" & vbNewLine &_
              "Sub Window_OnLoad" & vbNewLine &_
              "Window.resizeTo " & strSize & vbNewLine &_
              "idTimer = window.setTimeout(" & Chr(34) & "CloseShop" & Chr(34) &_
              ", " & CStr(10 * 1000) & ", " & Chr(34) & "VBScript" & Chr(34) & ")" & vbNewLine &_
              "End Sub" & vbNewLine &_
              "Sub CloseShop" & vbNewLine &_
              "window.clearTimeout(idTimer)" & vbNewLine &_
              "self.close()" & vbNewLine &_
              "End Sub" & vbNewLine &_
              "</SCRIPT>" & vbNewLine &_
              "<BODY background=" & Chr(34) & strPictFile & Chr(34) & ">" & vbNewLine &_
              "</BODY>" & vbNewLine &_
              "</HTML>"
strHTAname = FFNoExistCount(FSO.GetSpecialFolder(2) & "\Temp0.hta")
FSO.CreateTextFile strHTAname, True
FSO.GetFile(strHTAname).OpenAsTextStream(2, 0).Write Text

CreateObject("WScript.Shell").Run "mshta.exe " & Chr(34) & strHTAname & Chr(34), 0, True
FSO.DeleteFile strHTAname

Set objFolder = Nothing : Set objItem = Nothing : Set objShell = Nothing : WsEnd
Sub WsEnd : Set FSO = Nothing : WScript.Quit : End Sub

' RenameSearchReplace.vbs
'========================   Описание   =====================================
' Переименование имён выделенных файлов\папок с поиском и заменой
'=======================   Параметры  =====================================
' 1-й параметр: список файлов
' 2-й параметр: что найти в имени
' 3-й параметр: на что заменить
'========================   Примеры   =====================================
' %L " " "_"     Заменяет в имени файла\папки под курсором пробел на _
' %L "_" " "     Заменяет в имени файла\папки под курсором _ на пробел
'
' Автор:             Аверин Андрей
' Версия:          1.0 (2010 - 02.11.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'=======================================================================
With WScript
   If .Arguments.Count < 3 Then
     MsgBox "Не хватает параметров! Должно быть прописано 3 параметра"  & vbNewLine &_
     "Пример: %L ''Что найти в имени'' ''Чем заменить''" , vbOKOnly & vbInformation, _
     "Переименование имён выделенных файлов\папок" : .Quit
   End If
   Seach = .Arguments(1) : Replce = .Arguments(2)
End With

With CreateObject("Scripting.FileSystemObject")
   Set ListFile = .OpenTextFile(WScript.Arguments(0), 1)
   Do While Not ListFile.AtEndOfStream
     SelFile = ListFile.ReadLine
    Path = .GetParentFolderName(SelFile) & "\"
    Ext = .GetExtensionName(SelFile)
    Name = Replace(.GetBaseName(SelFile) ,Seach, Replce)
     On Error Resume Next
     If .FileExists(SelFile) Then .MoveFile SelFile, Path & Name & "." & Ext
     If .FolderExists(SelFile) Then .MoveFolder  Left(SelFile, Len(SelFile) - 1), Path & Name
   Loop
End With
ListFile.Close : Set ListFile = Nothing : Wscript.Quit

' RenameRandom.vbs
'========================   Описание   =====================================
' Переименование имён выделенных файлов\папок в случайными символами и цифрами
' !!! Использовать разумно!!!
' 1-й параметр: список файлов
' 2-й параметр: длина имени
' 3-й параметр:
'    0 - переименование латинскими буквами
'    1 - переименование цифрами
'    2 - переименование латинскими буквами и цифрами
' 4-й параметр: любой, означает, что будет сделан бэкап файлов\папок
'========================   Примеры   =====================================
' %L 10 0 - переименование латинскими буквами
' %L 10 1 1 - переименование цифрами + бэкап

' Автор:             Аверин Андрей
' Версия:          1.1 (2010 - 02.11.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'=======================================================================
Dim Name
Bak = 0 : LN = 0
With WScript
   Cnt = .Arguments.Count
   If Cnt < 2 Then
     MsgBox "Неправильно указано количество параметров!" & vbNewLine &_
     "Должно быть минимум ТРИ параметра! Пример: %L 10 0", vbOKOnly &_
     vbInformation, "Случайное переименование"
     .Quit
   End If
   N = .Arguments(1)
   If Cnt > 2 Then LN = .Arguments(2)
   If Cnt > 3 Then Bak = 1
End With

With CreateObject("Scripting.FileSystemObject")
   List = Split(.OpenTextFile(GetPath(WScript.Arguments(0))).ReadAll, vbNewLine)
   R = Second(Time) : NS = Ubound(List)
   If 20^N < NS Then
     MsgBox "Увеличьте параметр длины имени" & vbNewLine &_
     "Файлов больше, чем возможно переименовать с такой длиной имени файла!" ,_
     vbOKOnly &  vbCritical , "Случайное переименование"
     Wscript.Quit
   End If

   For m = 0 To NS - 1
     SelFile = List(m)

     If Mid(SelFile, Len(SelFile), 1) = "\" Then
       Ext = ""
     Else
       Ext = .GetExtensionName(SelFile)
     End If
     Path = .GetParentFolderName(SelFile) & "\"

     Select Case LN
       Case 0 Latinica
       Case 1 Numers
       Case 2 LatNum
     End Select
     Name = Right(Name, N) : FPath =  Path & Name & "." & Ext
     Do While (.FileExists(FPath) Or .FolderExists(FPath))
       i = i + 1
       Select Case LN
         Case 0, 2 FPath = Path & Mid(Name, 1, N - 1) & Chr(64 + i) & "." & Ext
         Case 1 FPath = Path & Mid(Name, 1, N - 2) & i + 9 & "." & Ext
       End Select
     Loop

     On Error Resume Next
     If Len(Ext) > 0 Then
       If Bak = 1 Then .CopyFile SelFile, SelFile & ".bak"
       .MoveFile SelFile, FPath
     Else
       sPath = Left(SelFile, Len(SelFile) - 1)
       If Bak = 1 Then .CopyFolder sPath, sPath & ".bak"
       .MoveFolder sPath, Path & Name
     End if
    Name = ""
   Next
End With
Wscript.Quit

Sub Latinica
   For i = 1 To N
     R = Second(Time)
     If R > 0 Then
       S = Int(Rnd()*(R*R)) + 65
       If (S > 64 And S < 90) Or (S > 96 And S < 121) Then
         Name = Name & Chr(S)
       Else
         i = i - 1
       End If
     End If
  Next
End Sub

Sub Numers
   For i = 1 To N
     R = Second(Time) : Name = Name & Int(Rnd()*(R+1))
   Next
End Sub

Sub LatNum
   For i = 1 To N
     R = Second(Time)
     If R > 0 Then
       S = Int(Rnd()*(R*R))
       If (S > 64 And S < 90) Or (S > 96 And S < 121) Or (S > 47 And S < 58) Then
         Name = Name & Chr(S)
       Else
         i = i - 1
       End if
     End If
   Next
End Sub

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

' Unpack_b64_mime_uue.vbs
'========================   Описание   =====================================
' Распаковывает mime, uue, b64 текст из буфера
'=======================   Параметры  =====================================
' 1-й параметр: куда распаковывать
' 2-й параметр: расширение  (xxe, uue, b64)
'========================   Примеры   =====================================
' %p "uue" - распаковывает  uue текст в текущую папку
' основан на коде (c) 2010, lev
' Автор:             Аверин Андрей
' Версия:          1.0 (04.11.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'====================   Изменяемые пути   ==================================
TCMSW = "%COMMANDER_PATH%\Utilities\TotalCom\TCMC\TCMCWindow.exe"
'========================================================================
With WScript
   If .Arguments.Count < 2 Then
     MsgBox "Не хватает параметров! Должно быть ДВА параметра %p ''uue''", _
     vbOKOnly & vbInformation,"Распаковывает mime, uue, b64 текст из буфера обмена"
     .Quit
   End If
   Set FSO = CreateObject("Scripting.FileSystemObject")
   Ext = LCase(.Arguments(1)) : Name = FSO.GetTempName() & "." & Ext
   TempFile = .Arguments(0) & Name
End With
Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
lClip = LCase(Clip)
If Len(Clip) < 10 Then WsEnd

If (InStr(lClip, "base64") = 0 Or InStr(lClip, "content-transfer-encoding") = 0) And _
(InStr(lClip, "end") = 0 Or InStr(lClip, "sum") = 0 Or InStr(lClip, "-r/size") = 0) Then WsEnd

Clip = RegExpReplace(Clip, "( *)(" & vbNewLine & ")", "$2") ' удаление концевых пробелов

FSO.CreateTextFile(TempFile, True).Write Clip

With CreateObject("WScript.Shell")
   .Exec(TCMSW & Chr(32) &_
                       Chr(34) & "ttcmc=150 CM540" & Chr(34) & Chr(32) &_
                       Chr(34) & "pause=50" & Chr(34) & Chr(32) &_
                       Chr(34) & "clpup=" & Name & Chr(34) & Chr(32) &_
                       Chr(34) & "ttcmc=50 CM540 CM2033" & Chr(34)  & Chr(32) &_
                       Chr(34) & "pause=50" & Chr(34) & Chr(32) &_
                       Chr(34) & "{DOWN}" & Chr(34) & Chr(32) &_
                       Chr(34) & "ttcmc=50 CM509" & Chr(34) & Chr(32) &_
                       Chr(34) & "{BS}" & Chr(34) & Chr(32) &_
                       Chr(34) & "{ENTER}" & Chr(34) & Chr(32))
   WScript.Sleep 2000 : FSO.DeleteFile TempFile
   .Exec(TCMSW & Chr(32) & Chr(34) & "ttcmc=50 CM540" & Chr(34))
End With
WsEnd

Function RegExpReplace(pText, pFindStr, pNewStr)
   With New RegExp
     .Pattern = pFindStr : .IgnoreCase = True : .Global = True
     RegExpReplace = .Replace(pText, pNewStr)
   End With
End Function

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

' ArhiveEXE.vbs
'========================   Описание   =====================================
' Создание самораспаковывающих архивов выделенных файлов и папок с помощью WCX плагинов ТС
'=======================   Параметры  =====================================
' 1-й параметр: путь\куда\архивировать
' 2-й параметр: имя архива
' 3-й параметр: расширение архива
'========================   Примеры   =====================================
' %t "%O" "rar"

' Автор:             Аверин Андрей
' Версия:          1.4 (20.01.2010 - 02.11.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'====================   Изменяемые пути   ==================================
TCMSW = "%COMMANDER_PATH%\Utilities\TotalCom\TCMC\TCMCWindow.exe"
'========================================================================
With WScript
   If .Arguments.Count < 3 Then
     MsgBox "Не хватает параметров! Должно быть ТРИ параметра" &_
     vbNewLine & "Пример: %t ''%O'' ''rar''", _
     vbOKOnly & vbInformation,"Создание самораспаковывающих архивов выделенного"
     .Quit
   End If
   Path = .Arguments(0) : Name = .Arguments(1) : Arhive = .Arguments(2)
End With

P = LineSym(Path) : N = LineSym(Name)
Lines = "{DEL}" & Arhive & ":" & Chr(34) & P & N & "." & Arhive & Chr(34)
If Arhive = "z" Then Lines = Lines & "{HOME}" & "_"
CreateObject("WScript.Shell").Exec(TCMSW & Chr(32) & Chr(34) & "ttcmc=CM508" &_
                           Chr(34) & Chr(32) & Chr(34) & "pause=100" & Chr(34) & Chr(32) & Lines &_
                           Chr(32) & Chr(34) & "{TAB 5}" & Chr(34)  &_
                           Chr(32) & Chr(34) & "{SPACE}" & Chr(34)  &_
                           Chr(32) & Chr(34) &  "{ENTER}" & Chr(34))
Function LineSym(Line)
   Stroka = "+^%~(){}[]"
   For i = 1 To Len(Line)
     s = Mid(Line, i, 1)
     If InStr(Stroka, s) > 0 Then
       If s = "%" Then
         s="{" & s & "}" & "{" & s & "}"
       Else
         s="{" & s & "}"
       End If
     End If
     Ls = Ls & s
   Next
   LineSym = Ls
End Function

' ArhiveTarPlus.vbs
'========================   Описание   =====================================
' Архивирование выделенных файлов и папок в формат tar.xxx  с помощью WCX плагинов ТС
'=======================   Параметры  =====================================
' 1-й параметр: путь\куда\архивировать
' 2-й параметр: имя архива
' 3-й параметр: 1-е расширение архива
' 4-й параметр: 2-е расширение архива
'========================   Примеры   =====================================
' %t "%O" "tar" "bzip2"

' Автор:             Аверин Андрей
' Версия:          1.4 (20.01.2010 - 02.11.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'====================   Изменяемые пути   ==================================
TCMSW = "%COMMANDER_PATH%\Utilities\TotalCom\TCMC\TCMCWindow.exe"
'========================================================================
With WScript
   If .Arguments.Count < 4 Then
     MsgBox "Не хватает параметров! Должно быть ЧЕТЫРЕ параметра" &_
     vbNewLine & "Пример: %t ''%O'' ''tar'' ''bzip2''", _
     vbOKOnly & vbInformation,"Архивирование выделенных файлов и папок"
     .Quit
   End If
   Path =  .Arguments(0) : Name = .Arguments(1) : Arhive1 = .Arguments(2) : Arhive2 = .Arguments(3)
End With

P = LineSym(Path) : N = LineSym(Name)
Lines = "t" & Arhive2 & ":" & Chr(34) & P & N & "." & Arhive1 & "." & Arhive2 & Chr(34)
CreateObject("WScript.Shell").Exec(TCMSW & Chr(32) & Chr(34) & "ttcmc=CM508" &_
        Chr(34) & Chr(32) & Chr(34) & "pause=100" & Chr(34) & Chr(32) & Lines & "{ENTER}")
WScript.Quit
Function LineSym(Line)
   Stroka = "+^%~(){}[]"
   For i = 1 To Len(Line)
     s = Mid(Line, i, 1)
     If InStr(Stroka, s) > 0 Then
       If s = "%" Then
         s="{" & s & "}" & "{" & s & "}"
       Else
         s="{" & s & "}"
       End If
     End If
     Ls = Ls & s
   Next
   LineSym = Ls
End Function

' Arhive.vbs
'========================   Описание   =====================================
' Архивирование выделенных файлов и папок с помощью WCX плагинов ТС
'=======================   Параметры  =====================================
' 1-й параметр: путь\куда\архивировать
' 2-й параметр: имя архива
' 3-й параметр: расширение архива
'========================   Примеры   =====================================
' %t "%O" "rar"

' Автор:             Аверин Андрей
' Версия:          1.4 (20.01.2010 - 02.11.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'====================   Изменяемые пути   ==================================
TCMSW = "%COMMANDER_PATH%\Utilities\TotalCom\TCMC\TCMCWindow.exe"
'========================================================================
With WScript
   If .Arguments.Count < 3 Then
     MsgBox "Не хватает параметров! Должно быть ТРИ параметра" &_
     vbNewLine & "Пример: %t ''%O'' ''rar''", _
     vbOKOnly & vbInformation,"Архивирование выделенных файлов и папок"
     .Quit
   End If
   Path = .Arguments(0) : Name = .Arguments(1) : Arhive = .Arguments(2)
End With

P = LineSym(Path) : N = LineSym(Name)
Lines = "{DEL}" & Arhive & ":" & Chr(34) & P & N & "." & Arhive & Chr(34)
If Arhive = "z" Then Lines = Lines & "{HOME}" & "_"
CreateObject("WScript.Shell").Exec(TCMSW & Chr(32) & Chr(34) & "ttcmc=CM508" &_
        Chr(34) & Chr(32) & Chr(34) & "pause=100" & Chr(34) & Chr(32) & Lines & "{ENTER}")
WScript.Quit

Function LineSym(Line)
   Stroka = "+^%~(){}[]"
   For i = 1 To Len(Line)
     s = Mid(Line, i, 1)
     If InStr(Stroka, s) > 0 Then
       If s = "%" Then
         s="{" & s & "}" & "{" & s & "}"
       Else
         s="{" & s & "}"
       End If
     End If
     Ls = Ls & s
   Next
   LineSym = Ls
End Function

' ArhiveCrypt.vbs
'========================   Описание   =====================================
' Создание зашифрованных архивов выделенных файлов и папок с помощью WCX плагиновТС
'=======================   Параметры  =====================================
' 1-й параметр: путь\куда\архивировать
' 2-й параметр: имя архива
' 3-й параметр: расширение архива
'========================   Примеры   =====================================
' %t "%O" "rar"

' Автор:             Аверин Андрей
' Версия:          1.4 (20.01.2010 - 02.11.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'====================   Изменяемые пути   ==================================
TCMSW = "%COMMANDER_PATH%\Utilities\TotalCom\TCMC\TCMCWindow.exe"
'========================================================================
With WScript
   If .Arguments.Count < 3 Then
     MsgBox "Не хватает параметров! Должно быть ТРИ параметра" &_
     vbNewLine & "Пример: %t ''%O'' ''rar''", _
     vbOKOnly & vbInformation,"Создание самораспаковывающих архивов выделенного"
     .Quit
   End If
   Path = .Arguments(0) : Name = .Arguments(1) : Arhive = .Arguments(2)
End With

P = LineSym(Path) : N = LineSym(Name)
Lines = "{DEL}" & Arhive & ":" & Chr(34) & P & N & "." & Arhive & Chr(34)
If Arhive = "z" Then Lines = Lines & "{HOME}" & "_"
CreateObject("WScript.Shell").Exec(TCMSW & Chr(32) & Chr(34) & "ttcmc=CM508" &_
                           Chr(34) & Chr(32) & Chr(34) & "pause=100" & Chr(34) & Chr(32) & Lines &_
                           Chr(32) & Chr(34) & "{TAB 7}" & Chr(34)  &_
                           Chr(32) & Chr(34) & "{SPACE}" & Chr(34)  &_
                           Chr(32) & Chr(34) &  "{ENTER}" & Chr(34))
WScript.Quit

Function LineSym(Line)
   Stroka = "+^%~(){}[]"
   For i = 1 To Len(Line)
     s = Mid(Line, i, 1)
     If InStr(Stroka, s) > 0 Then
       If s = "%" Then
         s="{" & s & "}" & "{" & s & "}"
       Else
         s="{" & s & "}"
       End If
     End If
     Ls = Ls & s
   Next
   LineSym = Ls
End Function

' ReplaceInFiles.vbs
'================   Описание   ======================
' Поиск и замена текста в выделенных текстовых файлах
'===============   Параметры   ======================
' 1-й параметр: список тестовых файлов (обязательный)
' 2-й параметр: что найти
' 3-й параметр: чем заменить
' 2 и 3 параметры можно ввести в диалоговых окнах
'================   Примеры   =======================
' %L "найти" "заменить"
' %L "найти"
' %L

' Автор:             Аверин Андрей
' Версия:          1.1 (2009 - 28.04.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'==================================================
Titles = "Поиск и замена"
With WScript
   Cnt = .Arguments.Count
   If Cnt > 0 Then
     tFile = .Arguments(0)
     If Cnt > 1 Then
       Find = .Arguments(1)
       If Cnt > 2 Then Replac = .Arguments(2)
     End If
   Else
     MsgBox "Не хватает параметров!!!", vbOKOnly & vbInformation, Titles
     WScript.Quit
   End If
End With

Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
If Len(Find) = 0 Then Find = InputBox("Введите искомую строку", Titles, Clip)
If Len(Find) = 0 Then WScript.Quit
Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
Replac = InputBox("Введите строку для замены", Titles, Clip)

Set FSO = CreateObject("Scripting.FileSystemObject")
Set ListFile = FSO.OpenTextFile(tFile, 1)

Do While Not ListFile.AtEndOfStream
    Call ReplThisFile(ListFile.ReadLine)
Loop

'MsgBox "Замена завершена!", vbInformation , Titles
ListFile.Close : Set ListFile = Nothing : Set FSO = Nothing : WScript.Quit

Sub ReplThisFile(FilePath)
   On Error Resume Next
   Text = FSO.OpenTextFile(FilePath, 1, False, -2).ReadAll
   Text = Replace(CStr(Text), Find, Replac, 1, -1, 1)
   FSO.CopyFile FilePath, FilePath & ".bak"
   FSO.OpenTextFile(FilePath, 2, False, -2).Write Text
End Sub

' SplitByLineTextFile.vbs
'===================   Описание   ============================
' Разрезка текстового файла на строки и запись их в файлы
'===================   Примеры   ============================
' Параметр: путь\к\файлу
' %P%N

' Автор:             ? & Аверин Андрей
' Версия:          1.0 (28.04.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'==========================================================
With WScript
   If .Arguments.Count = 0 Then
     MsgBox "Не хватает параметров!" & vbNewLine & "Должен быть Один параметр %P%N",_
     vbOKOnly & vbInformation, "Разрезание текстового файла" : .Quit
   End If
   InFile = .Arguments(0)
End With

With CreateObject("Scripting.FileSystemObject")
   Set ts = .OpenTextFile(InFile,1) : Cnt = 0
   Do Until ts.AtEndOfStream
     .CreateTextFile(InFile & "." & CStr(Cnt), True).WriteLine(ts.ReadLine) : Cnt = Cnt + 1
   Loop
End With
CreateObject("WScript.Shell").Exec("%COMMANDER_PATH%\Utilities\TotalCom\TCMC\TCMC.exe 100 CM540")
ts.Close : Set ts = Nothing : WScript.Quit

' ReplaceInTextFilesFromFileList.vbs
'========================   Описание   =====================================
' Поиск и замена в выделенных текстовых файлах из файл списка поиска и замен
' Синтаксис файл списка поиска и замен:
' ПОИСК=ЗАМЕНА
' 555=888
' 333=777
' и.т.д.
' т.е. во всех текстах файлов будет найдено 555 и заменено на 888, 333 на 777
'========================  Параметры =====================================
' [файл список файлов] [файл список замен]
' %L "%%COMMANDER_PATH%%\ReplaceList.txt"
'
' Автор:             Аверин Андрей
' Версия:          1.3 (2010 - 06.11.2011)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru
'=======================================================================
With WScript
Cnt = .Arguments.Count
   If Cnt = 0 Then
     MsgBox "Не хватает параметров!" & vbNewLine &_
     "Должен быть минимум ОДИН параметр %L",_
      vbOKOnly & vbInformation, "Поиск и замена в текстах из файл списка "
     .Quit
   End If
   Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")

   If Cnt = 1 Then
     ListReplac = InputBox("Введите ПОЛНЫЙ\ПУТЬ\до\файл_списка.txt" & vbNewLine &_
     " - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - " & vbNewLine & "Синтаксис файл списка поиска и замен:" &_
     vbNewLine & "ПОИСК=ЗАМЕНА " & vbNewLine & "333=777" & vbNewLine & "Маня=Даня" &_
     vbNewLine & "и.т.д.", "Поиск и замена в текстах из файл списка  ", Clip)
     if Len(ListReplac) = 0 Then .Quit
   Else
     ListReplac = .Arguments(1)
   End if
End With

With CreateObject("Scripting.FileSystemObject")
   Set ListFile = .OpenTextFile(WScript.Arguments(0), 1)
   ListReplac = CreateObject("WScript.Shell").ExpandEnvironmentStrings(ListReplac)
   If Not .FileExists(ListReplac) Then WScript.Quit
   Set ListR = .OpenTextFile(ListReplac, 1)

   Do While Not ListFile.AtEndOfStream
      SelFile = ListFile.ReadLine
      On Error Resume Next
      Text = .OpenTextFile(SelFile, 1).ReadAll
      Do While Not ListR.AtEndOfStream
         SetR = ListR.ReadLine
         Text = Replace(CStr(Text), Left(SetR, InStr(SetR, "=") - 1), Right(SetR, Len(SetR) - InStr(SetR, "=")), 1, -1, 1)
      Loop
      .CopyFile SelFile, SelFile & ".bak" ' Закомментируйте если не нужна копия файлов
      .CreateTextFile(SelFile, True).Write(Text)
   Loop
End With
ListFile.Close : ListR.Close : Set ListFile = Nothing : Set ListR = Nothing : WScript.Quit

' SpellChecker_Clipboard.vbs
'========================   Описание   =====================================
' Spell-Checker для содержимого буфера обмена. Требует MS Word
' Author: Steve Yandl
' Date: October 23, 2000
' /////////////////////////////////////////////////////////////////
' Орфографическая проверка текста в буфере обмена
'========================================================================
Dim oWD, RangeOriginal, RangeCorrected, Cnt, Status
Set oWD = WScript.CreateObject("Word.Application")
oWD.Visible =false
oWD.Documents.Add
On Error Resume Next
oWD.Selection.Paste
If err.number<>0 then
  MsgBox "Буфер обмена пуст!"
  oWD.ActiveDocument.Close wdDoNotSaveChanges
  oWD.Quit
  Set oWD=Nothing
  Set oWD=Nothing
  WScript.Quit
End If

Set RangeOriginal=oWD.ActiveDocument.Range(0,oWD.Selection.End)
If oWD.CheckSpelling(RangeOriginal)=False Then
  oWD.ActiveDocument.CheckSpelling
  Set RangeCorrected = oWD.ActiveDocument.Range(0,oWD.Selection.End)
  RangeCorrected.copy

  If RangeCorrected.Words.Count>7 Then
   Cnt=RangeCorrected.Words.Count
   Status= "Текст, начинающийся с: "&_
   RangeCorrected.Words.Item(1)&" "&RangeCorrected.Words.Item(2)&" "&_
   RangeCorrected.Words.Item(3)&"....."&vbCRLF&"и заканчивающийся: ....."&_
   RangeCorrected.Words.Item(Cnt-2)&" "&RangeCorrected.Words.Item(Cnt-1)&_
   " "&RangeCorrected.Words.Item(Cnt)&vbCRLF&"проверен. "&_
   "Исправленный текст скопирован в буфер обмена."
  Else
   Status= "<< "&RangeCorrected&" >>"&vbCRLF&"был проверен."&_
   " Исправленный текст скопирован в буфер обмена."
  End If

Else
  Status= "Проверка завершена. Текст не содержит ошибок."
End If

oWD.ActiveDocument.Close wdDoNotSaveChanges
oWD.Quit
Set oWD=Nothing
MsgBox Status

' SpellChecker_PN.vbs
'========================   Описание   =====================================
' Spell-Checker для файла под курсором. Требует MS Word
' Author: Steve Yandl & Аверин Андрей http://tc-image.3dn.ru
' Date: October 23, 2000 - 06.11.2011
' /////////////////////////////////////////////////////////////////
' Орфографическая проверка текста файла под курсором
' Параметры %P%N
'========================================================================
Dim oWD, RangeOriginal, RangeCorrected, Cnt, Status
Set oWD = WScript.CreateObject("Word.Application")
oWD.Visible = False
If WScript.Arguments.Count = 0 Then
   MsgBox "Не хватает параметров! Должен быть Один параметр %P%N",_
    vbOKOnly & vbInformation, "Орфографическая проверка текста файла под курсором"
   WScript.Quit
End If
oWD.Documents.Open WScript.Arguments(0), False, True
On Error Resume Next
oWD.Selection.WholeStory
If err.number<>0 then
  MsgBox "Буфер обмена пуст!"
  oWD.ActiveDocument.Close wdDoNotSaveChanges
  oWD.Quit
  Set oWD=Nothing :    Set oWD=Nothing :  WScript.Quit
End If

Set RangeOriginal=oWD.ActiveDocument.Range(0,oWD.Selection.End)
If oWD.CheckSpelling(RangeOriginal)=False Then
  oWD.ActiveDocument.CheckSpelling
  Set RangeCorrected = oWD.ActiveDocument.Range(0,oWD.Selection.End)
  RangeCorrected.copy
  If RangeCorrected.Words.Count>7 Then
   Cnt = RangeCorrected.Words.Count
   Status= "Текст, начинающийся с: "&_
   RangeCorrected.Words.Item(1) & " "& RangeCorrected.Words.Item(2) &" "&_
   RangeCorrected.Words.Item(3) &"....."& vbCRLF & "и заканчивающийся: ....."&_
   RangeCorrected.Words.Item(Cnt-2) &" "& RangeCorrected.Words.Item(Cnt-1)&_
   " "&RangeCorrected.Words.Item(Cnt)& vbCRLF & "проверен. "&_
   "Исправленный текст скопирован в буфер обмена."
  Else
   Status= "<< "&RangeCorrected&" >>"&vbCRLF&"был проверен."&_
   " Исправленный текст скопирован в буфер обмена."
  End If
Else
  Status= "Проверка завершена. Текст не содержит ошибок."
End If

oWD.ActiveDocument.Close wdDoNotSaveChanges
oWD.Quit : Set oWD=Nothing : MsgBox Status