Логово
Home

Скрипты для Total Commander

  1. Offline

    Andrey_A

    Пользователь

    Posts: 275

    Скрипты - уникальный инструмент для достижения различных целей в работе с файлами и не только, особенно в файловом менеджере, даже если вы раньше об этом ничего не слышали и не знали, то путём простых движений вы можете оптимизировать свои действия
    Тема тестирования скриптов создана для увеличения функциональности Total Commander
    Всё это делается для тех, кто хочет экономить время и автоматизировать работу
    Огромное спасибо участникам, авторам и всем повлиявшим на тему
    #/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#
    В этой теме Каждый может выложить свой скрипт, написанный на любом языке: vbs, js, hta, au3,ahk, bat,cmd... - главное, чтобы он относился как-то к Total Commander, можно было им воспользоваться и к нему было должное описание к применению.
    #/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#
    В теме "Тестирование и заказ скриптов" Каждый может протестировать, дать свой комментарий (все комментарии из этой темы будут удаляться)...если есть интересная идея, вы так же можете поделиться ей в соседней теме и заказать скрипт, а вдруг она покажется интересной для авторов...
    #/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#/#
     Важная информация:

     Параметры командной строки TC:

     Как использовать скрипты:

     Дополнительные инструменты скриптинга:
    Сообщение отредактировал LonerD 25 апреля 2017 - 04:38

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    22 ноября 2011 - 13:03 / #1
  2. Offline

    Andrey_A

    Пользователь

    Posts: 275

    GoParallelDirectory.vbs
    Переход в параллельный каталог не заходя в родительский
    Используется TCMC.exe - файл можете скачать в шапке темы

    ' GoParallelDirectory.vbs
    '========================   Описание   =====================================
    ' Переход в параллельный каталог не заходя в родительский

    ' Автор:             Аверин Андрей
    ' Версия:          1.1 (14.11.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '====================   Изменяемые пути   ===================================
    TCMC = "%COMMANDER_PATH%\Utilities\TotalCom\TCMC\TCMC.exe"
    '=========================================================================
    Dim WSH
    Set WSH = CreateObject("WScript.Shell")
    Titles = "Переход в параллельный каталог "
    RunTCMC("CM2002  CM2018") : WScript.Sleep 22 : Path1 = GetClip
    WSH.SendKeys "{DOWN}" : WScript.Sleep 22
    RunTCMC("CM2018") : WScript.Sleep 22 : Path2 = GetClip

    If CreateObject("Scripting.FileSystemObject").FolderExists(Path2) Then
        If (StrComp(Path1, Path2 ,vbTextCompare) <> 0) Then
          RunTCMC("CM2003")
        Else
            intButtonclicked = MsgBox ("В этой панели папок больше нет!" & vbNewLine &_
            "Хотите начать cначала?" , 33, Titles)
            If intButtonclicked = 1 Then
              WSH.SendKeys "{HOME}" & "{DOWN}" : WScript.Sleep 200 : RunTCMC("CM2003")
            Else
              WsEnd
            End If
        End If
    Else
      intButtonclicked = MsgBox ("Папки закончились, остались только файлы!" & vbNewLine &_
        "Хотите начать cначала?" , 33, Titles)
        If intButtonclicked = 1 Then
          WSH.SendKeys "{HOME}" & "{DOWN}" : WScript.Sleep 200 : RunTCMC("CM2003")
        Else
          WsEnd
        End If
    End If

    WsEnd

    Sub WsEnd : Set WSH = Nothing : WScript.Quit : End Sub
    Sub RunTCMC(Comm) : WSH.Exec(TCMC & " 50 " & Comm) : End Sub

    Function GetClip
      On Error Resume Next
      GetClip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
    End Function
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:32

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 17:23 / #41
  3. Offline

    Andrey_A

    Пользователь

    Posts: 275

    PathFolderLevelN.vbs
    Сканирование путей папок до N уровня из файл списка и запись результата в файл

    ' PathFolderLevelN.vbs
    '======================================================================
    ' Сканирование путей папок до N уровня из файл списка и запись результата в файл
    '========================  Параметры ===================================
    ' В параметрах вызова из TC должно быть прописанo 3 параметра:
    ' {путь\к\списку папок.txt} {путь\сохранения\файла.txt}
    '=======================  Дополнение =====================================
    ' Ситаксис списка папок
    ' "путь\к\папке" N ( N - число уровеней, в которых требуется найти все папки)
    ' "%COMMANDER_PATH%\Plugins" 2
    ' "%COMMANDER_PATH%\Programs" 2
    ' "%COMMANDER_PATH%\Scripts" 1
    '========================    Примеры    ===================================
    ' "%%COMMANDER_PATH%%\Files\Lists\PathList.txt" "c:\12345.txt"
    '
    ' Автор:             Аверин Андрей
    ' Версия:          1.2 (24.12.2010 - 28.08.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '======================================================================
    Option Explicit
    If WScript.Arguments.Count < 2 Then
      MsgBox "Не хватает параметров!!!", vbOKOnly & vbCritical, "Создание списков папок"
      WScript.Quit
    End If

    Dim FSO, MyFile, List, Folder, PathLines, PathList, Level, Text, SubFolder, FF, i
    Set FSO = CreateObject("Scripting.FileSystemObject")

    PathList = FSO.OpenTextFile(GetPath(WScript.Arguments(0)), 1).ReadAll
    PathLines = Split(PathList, vbNewLine)

    For i = 0 To Ubound(PathLines)
      Level = CInt(Right(PathLines(i), Len(PathLines(i)) - InStrRev(PathLines(i), " ")))
      Folder = GetPath(Replace(Left(PathLines(i), InStrRev(PathLines(i), " ") - 1), """", ""))
      Text = Text & Folder & vbNewLine
      If Level > 0 Then ScanFolders(0)
      Set FF = Nothing
    Next

    FSO.CreateTextFile(WScript.Arguments(1), True).Write(Text)
    Set FSO = Nothing : Wscript.Quit

    Sub ScanFolders(n)
      Set FF = FSO.GetFolder(Folder)
        For Each SubFolder In FF.SubFolders
          Text = Text & SubFolder.Path & vbNewLine : Folder = SubFolder.Path
          if Level > n Then ScanFolders(n + 1)
        Next
    End Sub

    Function GetPath(pPath)
      GetPath = CreateObject("WScript.Shell").ExpandEnvironmentStrings(pPath)
    End Function
    Сообщение отредактировал Andrey_A 11 марта 2012 - 20:19

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 17:25 / #42
  4. Offline

    Andrey_A

    Пользователь

    Posts: 275

    StructuraNul.vbs
    Создание в соседней панели пустой структуры выделенных папок и файлов

    ' StructuraNul.vbs
    '========================   Описание   ============================
    ' Создание в соседней панели пустой структуры выделенных папок и файлов
    '=======================   Параметры  ============================
    ' 1-й параметр: список файлов\папок
    ' 2-й параметр: куда\сохранять\пустую\структуру
    ' 3-й параметр: любой, означает, что создаваться будет только структура папок
    '========================   Примеры   ============================
    ' %L %t    - пустая структура папок и файлов
    ' %L %t 1 - пустая структура папок

    ' Автор:             Batya & Аверин Андрей
    ' Версия:          1.2 (4.11.2009 - 30.10.2011)
    ' Site:                  http://tc-image.3dn.ru
    '===============================================================
    Option Explicit
    Dim FSO, OTF, Target, NewTar, Name, Ext, Selected, Cnt

    Set FSO = CreateObject("Scripting.FileSystemObject")
    With WScript
      Cnt = .Arguments.Count
      If Cnt < 2 Then
        MsgBox "Не хватает параметров!" & vbNewLine &_
        "Должно быть прописано минимум 2 параметра %L %t",_
        vbOKOnly & vbInformation, "Создание пустой структуры файлов"
        .Quit
      End If
      Set OTF = FSO.OpenTextFile(.Arguments(0), 1)
      Target  = CreateObject("Shell.Application").NameSpace(.Arguments(1)).Self.Path & "\"
    End With
    Do While Not OTF.AtEndOfStream
      Selected = OTF.ReadLine
      If FSO.FileExists(Selected) Then FSO.CreateTextFile(Target & FSO.GetFileName(Selected))
      If FSO.FolderExists(Selected) Then
        NewTar = Target & FSO.GetFolder(Selected).Name
        If Not FSO.FolderExists(NewTar) Then FSO.CreateFolder(NewTar)
        FolderProcess FSO.GetFolder(Selected), NewTar & "\"
      End If
    Loop

    Set OTF = Nothing : Set FSO = Nothing : WScript.Quit

    Function FolderProcess(Fold, Tar)
      Dim sf, f, NewF
      For Each sf in Fold.SubFolders
        NewF = Tar & sf.Name
        If Not FSO.FolderExists(NewF) Then FSO.CreateFolder(NewF)
        FolderProcess sf, NewF & "\"
      Next
      If Cnt < 3 Then
        For Each f in Fold.Files
          FSO.CreateTextFile(Tar & FSO.GetFile(f).Name)
        Next
      End If
    End Function
    Сообщение отредактировал Andrey_A 11 марта 2012 - 20:20

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 17:27 / #43
  5. Offline

    Andrey_A

    Пользователь

    Posts: 275

    StrukturaFolders.vbs
    Создание структуры каталогов вглубь и в ширину
    Используется TCMC.exe - файл можете скачать в шапке темы

    ' StrukturaFolders.vbs
    '========================   Описание   =======================================
    ' Создание структуры каталогов вглубь и в ширину
    '========================  Параметры =======================================
    ' 1-й параметр: путь\создания\каталогов
    ' 2-й параметр: имя создаваемых каталогов
    ' 3-й параметр: глубина создаваемых каталогов (1-10)
    ' 4-й параметр: количество создаваемых каталогов в каждом подкаталоге
    ' Два параметра обязательны!!! 3 и 4 можно ввести во всплывающих диалогах
    '========================    Примеры    =======================================
    ' %p "%O"               - создать в текущей панели структуру именем файла\папки
    ' %t "Каталог" 3 5
    '
    ' Автор:             Аверин Андрей
    ' Версия:          1.4 (2010 - 30.10.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '============================================================================
    With WScript
      Cnt = .Arguments.Count
      If Cnt < 2 Then
          MsgBox "Неправильно указано количество параметров!" & vbNewLine &_
           "Должно быть минимум ДВА параметра!" & vbNewLine &_
            "  ""%p"" ""%O""  A у Вас прописано " & Cnt &_
             " !!! " , vbOKOnly & vbInformation, "Создание структуры каталогов"
          .Quit
      Else
          If Cnt > 2 Then
              D = .Arguments(2)
          Else
              If D = 0 or D = "" Then D = InputBox ("Введите ГЛУБИНУ создания каталогов" & vbNewLine &_
               "( Цифру от 1 до 10 )" , "Создание структуры каталогов",1)
              If D = 0 or D = "" Then .Quit
          End If
          If Cnt > 3 Then
              N = .Arguments(3)
          Else
              If N = 0 or N = "" Then N = InputBox ("Введите КОЛИЧЕСТВО каталогов, создаваемых в каждом подкаталоге" ,_
               "Создание структуры каталогов",1)
              If N = 0 or N = "" Then .Quit
          End If
      End If

      Path = .Arguments(0) : FileName = .Arguments(1)
    End With

    With CreateObject("Scripting.FileSystemObject")
      If Mid(Path,Len(Path),1) = "\" Then
          Path = Path
      Else
          Path = FSO.GetParentFolderName(Path) & "\"
      End If
      If Len(FileName) = 0 Then FileName = "Каталог"

      If D > 0 Then
        For i = 1 To N
          NewFold1 = Path & Numer(1, i) : .CreateFolder(NewFold1)
          If D => 1 Then
            For m = 1 To N
              NewFold2 = NewFold1 &Numer(2, m) : .CreateFolder(NewFold2)
                If D => 2 Then
                For k = 1 To N
                  NewFold3 = NewFold2 & Numer(3, k) : .CreateFolder(NewFold3)
                      If D => 3 Then
                    For o = 1 To N
                      NewFold4 = NewFold3 & Numer(4, o) : .CreateFolder(NewFold4)
                          If D => 4 Then
                        For p = 1 To N
                          NewFold5 = NewFold4 & Numer(5, p) : .CreateFolder(NewFold5)
                          If D => 5 Then
                            For l = 1 To N
                              NewFold6 = NewFold5 & Numer(6, l) : .CreateFolder(NewFold6)
                              If D => 6 Then
                                For r = 1 To N
                                  NewFold7 = NewFold6 & Numer(7, r) : .CreateFolder(NewFold7)
                                  If D => 7 Then
                                    For s = 1 To N
                                      NewFold8 = NewFold7 & Numer(8, s) : .CreateFolder(NewFold8)
                                      If D => 8 Then
                                        For t = 1 To N
                                          NewFold9 = NewFold8 & Numer(9, t) : .CreateFolder(NewFold9)
                                          If D => 9 Then
                                            For u = 1 To N
                                              NewFold10 = NewFold9 & Numer(10, u) : .CreateFolder(NewFold10)
                                            Next
                                          End If
                                        Next
                                      End If
                                    Next
                                  End If
                                Next
                              End If
                            Next
                          End If
                        Next
                      End If
                    Next
                  End If
                Next
              End If
            Next
          End If
        Next
      End If
    End With
    CreateObject("WScript.Shell").Exec("%COMMANDER_PATH%\Utilities\TotalCom\TCMC\TCMC.exe 100 CM540")
    Wscript.Quit

    Function Numer(nnn,iii)
      Numer = "\" & FileName & "_" & nnn & "_" & iii\ 100 & (iii Mod 100)\10 & (iii Mod 10)
    End Function
    Сообщение отредактировал Andrey_A 11 марта 2012 - 20:20

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 17:30 / #44
  6. Offline

    Andrey_A

    Пользователь

    Posts: 275

    SummaFoldersInFolder.vbs
    Подсчет количества вложенных папок (без рекурсии)

    ' SummaFoldersInFolder.vbs
    '==================================================
    ' Подсчет количества вложенных папок (без рекурсии)
    ' В параметрах вызова из TC должно быть прописано:
    ' %L
    ' Автор:             Batya
    ' Версия:          1.0 (19.07.2005)
    '==================================================
    Dim FSO, StrInFile, SF, M1, TempFile
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set TempFile = FSO.OpenTextFile(WScript.Arguments(0), 1)

    SF = 0
    Do While Not TempFile.AtEndOfStream
        StrInFile = TempFile.ReadLine
        If FSO.FolderExists(StrInFile) Then
            SF = SF + FSO.GetFolder(StrInFile).SubFolders.Count
        End If
    Loop

    If SF > 0 Then
        MsgBox "В выделенных каталогах находится" & Chr(13) & SF & Chr(13) &_
        "вложенных папок в Первом уровне", vbOKOnly + vbInformation, "Результат"
    Else
        MsgBox "В выделенных каталогах нет вложенных папок",_
        vbOKOnly + vbExclamation, "Внимание!"
    End If
    Set TempFile = Nothing : Set FSO = Nothing : Wscript.Quit
    Сообщение отредактировал Andrey_A 11 марта 2012 - 20:20

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 17:31 / #45
  7. Offline

    Andrey_A

    Пользователь

    Posts: 275

    StructuraMenuTC.vbs
    Структурирование файла Wcmd_*.MNU главного меню Total Commanderа
    ' StructuraMenuTC.vbs
    '===============================================================
    ' Структурирование файла Wcmd_*.MNU главного меню Total Commanderа
    ' В параметрах вызова из TC должен быть прописано путь к файлу:
    ' "%%COMMANDER_PATH%%\Language\Wcmd_Rus.mnu"
    ' или открывать его под курсором %P%N
    '
    ' Автор:             Аверин Андрей
    ' Версия:          1.1 (19.09.2010 - 14.11.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '===============================================================
    Option Explicit
    Dim FSO, ListFile, SetList, Text, i, k, sym, FF, F, P, L, ContrStr, Stroka, Probel, Space
    Set FSO = CreateObject("Scripting.FileSystemObject")

    FF = WScript.Arguments(0)
    F = CreateObject("WScript.Shell").ExpandEnvironmentStrings(FF)
    Set ListFile = FSO.OpenTextFile(F, 1)

    Space = 7    'изменить если нужен отступ больше или меньше
    Text =  "" : ContrStr = 0 : P = 0

    Do While Not ListFile.AtEndOfStream
      SetList = ListFile.ReadLine : Stroka = "" : Probel = ""

      For i = 1 To Len(SetList)
        sym = Mid(SetList, i, 1)
        If sym = "P" Or sym = "M" Or sym = "E" Or sym = "S" Or sym = "H" Or sym = ";" Then
          If   sym = ";" Then L = 0
          k = i : i = Len(SetList)
        End If
      Next

      If  SetList <> "" Then
       For i = k To Len(SetList)
         sym = Mid(SetList, i, 1) : Stroka = Stroka & sym
       Next
      End If

      If P < 0 Then P = 0

      If  Mid(Stroka, 1, 1) = "P" Then
        If  ContrStr = 1 Then P = P + Space
        L = P : ContrStr = 1
      End If

      If  Mid(Stroka, 1, 1) = "M" Then
        If ContrStr = 2 Then
          P = P - Space : ContrStr = 1
        End If
        L = P + Space
      End If

      If  Stroka = "MENUITEM SEPARATOR" Then
        If  ContrStr = 2 Then
          P = P - Space : ContrStr = 1
        End If
        L = P + Space*2
      End If

      If  Mid(Stroka, 1, 1) = "E" Then
        If  ContrStr = 2 Then P = P - Space
        L = P : ContrStr = 2
      End If

      For i = 1 To L
        Probel = Probel & " "
      Next
      Text = Text & Probel & Stroka & vbNewLine : L = 0
    Loop

    For i = 1 To Len(Text)
      If Right(Text, Len(vbNewLine)) = vbNewLine Then
        Text = Left(Text, Len(Text) - Len(vbNewLine))
      Else
        Exit For
      End If
    Next
    FSO.CopyFile F, F & ".bak" ' Раскомментируйте если нужна копия файла
    FSO.CreateTextFile(F, True).Write(Text)

    ListFile.Close : Set ListFile = Nothing : Set FSO = Nothing : WScript.Quit
    Сообщение отредактировал Andrey_A 11 марта 2012 - 20:21

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 17:48 / #46
  8. Offline

    Andrey_A

    Пользователь

    Posts: 275

    SumWincmd.vbs
    Соединение вынесенных секций из Wincmd.ini в один файл Wincmd.full.ini
    Используется FunctionsINIRWS.vbs - файл можете скачать в шапке темы

    ' SumWincmd.vbs
    '========================   Описание   ======================================
    ' Соединение вынесенных секций из Wincmd.ini в один файл Wincmd.full.ini
    ' Автор:             Аверин Андрей
    ' Версия:          1.1 (10.05.2011 - 27.10.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '========================================================================
    Option Explicit
    Dim FSO, TC, WC, WCF, WArr, i, sKey, sFile, FS, INI
    Set FSO = CreateObject("Scripting.FileSystemObject")
    TC =CreateObject("WScript.Shell").ExpandEnvironmentStrings("%COMMANDER_PATH%")
    INI = TC & "\Scripts\Include\FunctionsINIRWS.vbs"
    Execute FSO.OpenTextFile(INI).ReadAll

    WC = TC & "\Wincmd.ini" : WCF = TC & "\Wincmd.full.ini"

    Call FSO.CopyFile(WC, WCF, True)

    WArr = Array("Buttonbar", "Colors", "Searches", "Associations", "DirMenu", "CustomFields", _
                             "HintsCustomField", "Rename", "MkDirHistory", "SearchIn", "RenameTemplates", _
                             "Selection", "RenameSearchFind", "SearchName", "RenameSearchReplace", _
                             "RightHistory", "LeftHistory", "Command line history", "LeftTabs", "RightTabs", _
                             "SearchText", "OverWriteCustomField", "Left", "Right", "Extensions")
    For i = 0 To Ubound(WArr)
      WinCmd(WArr(i))
    Next

    Set FSO = Nothing : WScript.Quit

    Sub WinCmd(Section)
      sKey = ReadINI(WCF, Section, "RedirectSection")
        If sKey <> "" Then
          If InStr(sKey, "/") > 0 Then
            sFile = sKey
            If Mid(sFile, 1, 1) = Chr(34) Then sFile = Mid(sFile, 2)
            If Mid(sFile, 1, Len(sFile)) = Chr(34) Then sFile = Left(sFile, Len(sFile) - 1)
          Else
            sFile = TC & "\" & sKey
          End If
          FS = ReadINISection(sFile, Section)
          If Len(FS) > 0 Then
            On Error Resume Next
            Call WriteINISection(WCF, Section, FS)
          Else
            Call WriteINI(WCF, Section, "RedirectSection", "<DELETE_VALUE>")
          End If
        End If
    End Sub
    Сообщение отредактировал Andrey_A 11 марта 2012 - 20:22

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 17:50 / #47
  9. Offline

    Andrey_A

    Пользователь

    Posts: 275

    CreateLink.vbs
    Создание ярлыка файла\папки под курсором

    ' CreateLink.vbs
    '========================   Описание   =====================================
    ' Создание ярлыка файла\папки под курсором
    '========================  Параметры =====================================
    ' 1-й параметр: Путь\к\Файлу\папке для которой создаётся ярлык
    ' 2-й параметр: Путь\где\создавать\ярлык (по умолчанию Рабочий стол)
    ' (можно использовать относительные пути)
    '========================    Примеры    ====================================
    ' %P%N - создание ярлыка для файла\папки под курсором на рабочем столе
    ' %P%N "%%APPDATA%%\Microsoft\Internet Explorer\Quick Launch" - создание ярлыка для файла\папки под курсором в панели ''Быстрого запуска''
    ' %P%N "%%APPDATA%%\Microsoft\Windows\SendTo" - создание ярлыка для папки под курсором в панели ''Отправить в...''
    ' %P%N "%%USERPROFILE%%\Links"  - создание ярлыка для папки под курсором в панели ''Ссылки на папки''

    ' Автор:             Аверин Андрей
    ' Версия:          1.1 (18.07.2011 - 26.07.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '========================================================================
    With WScript
      Cnt = .Arguments.Count
      If Cnt > 0 Then
        File = .Arguments(0)
        If Len(File) = 0 Then WScript.Quit
        If Cnt > 1 Then Path = .Arguments(1)
      End If
    End With

    Dim FSO, WSH
    Set WSH = CreateObject("WScript.Shell")
    Set FSO = CreateObject("Scripting.FileSystemObject")

    If Len(Path) = 0 Then
      Path= WSH.SpecialFolders("Desktop")
    Else
      Path= GetPath(Path)
    End If
    File= GetPath(File)

    Name = FSO.GetBaseName(File)

    With WSH.CreateShortcut(Path & "\" & Name & ".lnk") ' Создаём ярлык
      .Arguments = ""
      .Description = ""
      .IconLocation = ",0"
      .TargetPath = File
      .WindowStyle = 1
      .WorkingDirectory = FSO.GetParentFolderName(File)
      .Save
    End With

    Set WSH = Nothing : Set FSO = Nothing : WScript.Quit
    Function GetPath(aPath) : GetPath = WSH.ExpandEnvironmentStrings(aPath) : End Function
    Сообщение отредактировал Andrey_A 11 марта 2012 - 20:25

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 17:57 / #48
  10. Offline

    Andrey_A

    Пользователь

    Posts: 275

    GroupChangeLNK.vbs
    Групповая замена свойств ярлыков

    ' GroupChangeLNK.vbs
    '================   Описание   =================
    ' Групповая замена свойств ярлыков.
    '================  Параметры =================
    ' {файл-список ярлыков}|{папка с ярлыками}
    '
    ' Примеры параметров при вызове из TC:
    ' %L
    ' "%P"
    '
    ' Автор:             Batya
    ' Версия:          1.0 (22.10.2009)
    '==========================================
    Option Explicit
    Dim Mess, FSO, WSH, FF, IsFolder, F, FindStr, ReplStr, Res, Msg, K

    On Error Resume Next
    Main:CheckErr
    On Error GoTo 0
    If Res.Count > 0 Then
      For Each K In Res.Keys
        Msg = Msg & vbNewLine & vbNewLine & K & "  -  " & Res(K)
      Next
    Else
      Msg = vbNewLine & vbNewLine & Mess(10)
    End If
    WSH.Popup Mess(9) & Msg, 0, Mess(0)
    Quit 0

    'Основная процедура
    Sub Main
      SetMess
      Set FSO = CreateObject("Scripting.FileSystemObject")
      Set WSH = CreateObject("WScript.Shell")
      Set Res = CreateObject("Scripting.Dictionary")
      F = ""

      CheckParam

      FindStr = InputBox(Mess(3), Mess(0)):If FindStr = "" Then Quit 0
      ReplStr = InputBox(Mess(4), Mess(0)):If ReplStr = "" Then Quit 0

      If IsFolder Then
        FolderProc FF
      Else
        For Each F In Split(FSO.OpenTextFile(FF).ReadAll, vbNewLine)
          If F <> "" Then
            F = GetPath(F)
            If FSO.FileExists(F)   Then
              FileProc   F
            ElseIf FSO.FolderExists(F) Then
              FolderProc F
            End If
          End If
        Next
      End If
    End Sub

    'Массив сообщений
    Sub SetMess
      Set Mess = CreateObject("Scripting.Dictionary")
      With Mess
        .Add 0,  "Групповая замена свойств ярлыков"
        .Add 1,  "Не указаны параметры!"
        .Add 2,  "Первый параметр не является файлом-списком или папкой!"
        .Add 3,  "Введите искомый текст:"
        .Add 4,  "Введите текст на замену:"
        .Add 5,  "Выполнена замена:"
        .Add 6,  "Возникла ошибка:" & vbNewLine
        .Add 7,  "Возникла ошибка № "
        .Add 8,  "Файл\папка:"
        .Add 9,  "Результат операции:"
        .Add 10, "Замен не произошло."
      End With
    End Sub

    'Проверка входных параметров
    Sub CheckParam
      If WScript.Arguments.Count = 0 Then Err.Raise vbObjectError + 1, "", Mess(1)
      FF = GetPath(WScript.Arguments(0))
      If Not FSO.FileExists(FF) Then
        If Not FSO.FolderExists(FF) Then
          Err.Raise vbObjectError + 2, "", Mess(2)
        Else
          IsFolder = True
        End If
      Else
        IsFolder = False
      End If
    End Sub

    'Обработка файла-ярлыка
    Sub FileProc(pPath)
      Dim lExt, LNK
      On Error Resume Next
      lExt = FSO.GetExtensionName(pPath)
      If LCase(lExt) = "lnk" Then
        Msg = ""
        With WSH.CreateShortcut(pPath)
          .TargetPath = ReplaceIn("TargetPath", .TargetPath)
          .IconLocation = ReplaceIn("IconLocation", .IconLocation)
          .WorkingDirectory = ReplaceIn("WorkingDirectory", .WorkingDirectory)
          .Description = ReplaceIn("Description", .Description)
          .Save
        End With
        If Msg <> "" Then Res.Add pPath, Mess(5) & Msg
        If Err.Number <> 0 Then Res.Add pPath, Mess(6) & "     " & Err.Description
        Msg = ""
      End If
      On Error GoTo 0
    End Sub

    'Замена в строке
    Function ReplaceIn(pType, pStr)
      If InStr(1, pStr, FindStr, 1) > 0 Then
        Msg = Msg & vbNewLine & "    " & pType & ": " & pStr & "  ->  "
        ReplaceIn = Replace(pStr, FindStr, ReplStr, 1, 1, 1)
        Msg = Msg & ReplaceIn
      Else
        ReplaceIn = pStr
      End If
    End Function

    'Обработка папки
    Sub FolderProc(pPath)
      Dim loF
      Set loF = FSO.GetFolder(pPath)
      For Each F In loF.SubFolders
        F = F.Path
        FolderProc F
      Next
      For Each F In loF.Files
        F = F.Path
        FileProc F
      Next
      Set loF = Nothing
    End Sub

    'Разложить путь при наличии переменных окружения
    Function GetPath(pPath)
      GetPath = FSO.GetAbsolutePathName(WSH.ExpandEnvironmentStrings(pPath))
    End Function

    'Проверка, нет ли ошибок
    Sub CheckErr
      Dim lMess
      lMess = Mess(7) & Err.Number & ":" & vbNewLine & Err.Description
      If F <> "" Then lMess = lMess & vbNewLine & vbNewLine & Mess(8) & vbNewLine & F
      If Err.Number <> 0 Then
        MessBox lMess, 1
        Quit Err.Number
      End If
    End Sub

    'Сообщение
    Function MessBox(pMess, pMode)
      Dim lIcon
      Select Case pMode
        Case 1 lIcon = vbCritical + vbOKOnly
        Case 2 lIcon = vbExclamation + vbOKOnly
        Case 3 lIcon = vbInformation + vbOKOnly
      End Select
      MessBox = MsgBox(pMess, lIcon, Mess(0))
    End Function

    'Выход
    Sub Quit(pExitCode)
      Set Mess = Nothing : Set Res  = Nothing : Set WSH  = Nothing
      Set FSO  = Nothing : WScript.Quit pExitCode
    End Sub
    Сообщение отредактировал Andrey_A 11 марта 2012 - 20:26

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 18:01 / #49
  11. Offline

    Andrey_A

    Пользователь

    Posts: 275

    LinkFromBufferButtonTC.vbs
    Создание ярлыка из кнопки Total Commander'a на панели инструментов. Предварительно необходимо скопировать кнопку в буфер обмена

    ' LinkFromBufferButtonTC.vbs
    '========================   Описание   ===============================
    ' Создание ярлыка из кнопки Total Commander'a на панели инструментов
    ' Предварительно необходимо скопировать кнопку в буфер обмена
    '========================  Параметры ===============================
    ' Параметры {"Путь\сохранения\ярлыка\"}
    ' %p
    ' "%%USERPROFILE%%\Desktop\" - Сохранить на рабочий стол
    ' "%%APPDATA%%\Microsoft\Internet Explorer\Quick Launch\" - Сохранить в быстрый запуск

    ' Автор:             Аверин Андрей
    ' Версия:          2.1 (08.08.10 - 03.11.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '==================================================================
    Titles = "Создание ярлыка из кнопки Total Commander'a"
    If WScript.Arguments.Count > 0 Then
      tPath= GetPath(WScript.Arguments(0))
    Else
      MsgBox "Не хватает параметров! Должен быть один параметр %p", vbOKOnly & vbInformation,Titles : WScript.Quit
    End If
    Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text") : Desc = ""
    If Len(Clip) = 0 Or InStr(Clip, vbNewLine) = 0 Then WsEnd

    On Error Resume Next
    Button = Split(Clip, vbNewLine)
    If Button(0) <> "TOTALCMD#BAR#DATA" Then WsEnd
    Trg = Trim(GetPath(Button(1))) : Arg = Trim(GetPath(Button(2))) : Icon = Trim(GetPath(Button(3))) : fName = Button(4)
    If Len(Trg) < 3 Then WsEnd
    pr = LCase(Mid(Trg, 1, 3))
    If pr = "cm_" Or pr = "em_" Then WsEnd
    If Left(Trg, 1) = Chr(34) Then Trg = Mid(Trg, 2)
    If Right(Trg, 1) = Chr(34) Then Trg = Mid(Trg, 1, Len(Trg) - 1)

    If Len(fName) > 0 Then
      Delim = InStr(fName, Chr(32) & "-" & Chr(32))
      If Delim > 0 Then
        Desc = Mid(fName, Delim + 3) : fName = Left(fName, Delim - 1)
      End If
    End If

    ' Проверка содержит ли путь вначале CD
    If UCase(Mid(Trg,1,3)) = "CD " Then
      Trg = Right(Trg, Len(Trg) - 3) : Icon = ",0"
    End If

    If fName <> "" Then
      NoSym = "\/?:*><|" & Chr(34)
      For i = 1 To Len(NoSym)
        sym = Mid(NoSym,i,1)
        If InStr(1,fName, sym) > 0 Then fName = Replace(fName, sym ,"_")
      Next
    End If

    If InStrRev(Trg,"\") = Len(Trg) Then Trg = Left(Trg,Len(Trg) - 1)
    If fName = "" Then fName = Right(Trg, Len(Trg) - InStrRev(Trg, "\"))

    With CreateObject("WScript.Shell").CreateShortcut(tPath & "\" & fName & ".lnk")
      .Arguments = Arg
      .Description = Desc
      '.HotKey = "CTRL+ALT+SHIFT+X" ' Присвоение горячей клавиши, если надо - убрать ' в начале строки
      .IconLocation = Icon
      .TargetPath = Trg
      .WindowStyle = 1
      .WorkingDirectory = CreateObject("Scripting.FileSystemObject").GetParentFolderName(Trg)
      .Save
    End With
    WScript.Quit

    Sub WsEnd
    MsgBox "В буфере обмена находятся некоректные данные" & vbNewLine &_
    "Выделите кнопку на панели TC и повторите заново", vbOKOnly & vbInformation, Titles : WScript.Quit
    End Sub

    Function GetPath(pPath) : GetPath = CreateObject("WScript.Shell").ExpandEnvironmentStrings(pPath) : End Function
    Сообщение отредактировал Andrey_A 11 марта 2012 - 20:27

    Читайте: Справочные материалы по работе c TC + Онлайн справка TC

    23 ноября 2011 - 18:11 / #50

Статистика форума, пользователей онлайн: 0 (за последние 30 минут)

---
Создано тем
107
Всего сообщений
4048
Пользователей
99000
Новый участник
termojader
Powered by Bullet Energy Forum