Логово
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

    Скрипты по темам

     Значки:

     Атрибуты:

     Буфер обмена:

     Выделение:

     Перемещение:

     Копирование:

     Переименование:

     Мультимедиа:

     Total Commander:

     Текстовые файлы:

     Создание списков:

     Комментарии:

     Каталоги:

     Создание ярлыков:

     Архивирование:

     Запуск программ и файлов:

     Система:

     Разное:
    Сообщение отредактировал Andrey_A 24 ноября 2011 - 03:54

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

    22 ноября 2011 - 14:43 / #2
  3. Offline

    Andrey_A

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

    Posts: 275

    NIconFolderInBuffer.vbs
    Послать в буфер информацию о значке, присвоенном папки под курсором
    Используется NirCmd.exe - файл можете скачать в шапке темы

    ' NIconFolderInBuffer.vbs
    '========================   Описание   =====================================
    ' Послать в буфер информацию о значке, присвоенном папки под курсором
    '========================  Параметры =====================================
    ' 1-й параметр: {путь\к\папке}
    ' 2-й параметр: 1 - путь значка
    '                            2 - путь+номер значка
    '                            3 - номер значка
    '                            4 - открытьDesktop.ini
    '========================   Примеры   =====================================
    ' %P%N 1
    ' используется FunctionsINIRWS.vbs
    ' Автор:       Аверин Андрей
    ' Версия:    1.2 (07.01.2011 - 14.11.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '========================================================================
    Option Explicit
    '====================   Изменяемые пути   ==================================
    Const INI = "%COMMANDER_PATH%\Scripts\Include\FunctionsINIRWS.vbs"
    Const NirCmd = "%COMMANDER_PATH%\NirCmd.exe"
    '========================================================================
    Const Titles = "Оправить информацию значка папки в буфер"
    If WScript.Arguments.Count < 2 Then
      WScript.Quit
      MsgBox "Не хватает параметров!" & vbNewLine &_
      "Должно быть минимум Два параметра!" & vbNewLine &_
      "%P%N 1", vbOKOnly & vbCritical, Titles
    End if

    Dim FSO, WSH, Des, Icon, Path, PathIc, Param, Str, Folder, Tmp
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set WSH = CreateObject("WScript.Shell")
    Execute FSO.OpenTextFile(GetPath(INI)).ReadAll

    Folder = WScript.Arguments(0)
    If Right(Folder, 1 ) <> "\" Then Folder = Folder & "\"
    Des = Folder & "Desktop.ini"

    Param = CInt(WScript.Arguments(1))
    If Param = 4 Then
      WSH.Run Chr(34) & Des & Chr(34) : WSFSEnd
    End If

    If FSO.FileExists(Des) Then
      Icon = ReadINI(Des, ".ShellClassInfo", "IconIndex")
      Path = ReadINI(Des, ".ShellClassInfo", "IconFile")
      PathIc = Path & "," & Icon
      If Icon = "" Or Path = "" Then
        Icon = ReadINI(Des, ".ShellClassInfo", "IconResource")
        If Icon <> "" Then
          If InStr(Icon, ",") > 0 Then
            PathIc = Icon
            Icon = Mid(Icon, InStrRev(Icon, ",") + 1)
            Path = Left(PathIc, InStrRev(PathIc, ",") - 1)
          End if
        Else
          MsgBox "Нет номера значка в стандартных местах Desktop.ini", vbOKOnly &_
          vbCritical, Titles :WSFSEnd
        End if
      End if
    Else
      MsgBox "В папке "  & Folder & " нет файла Desktop.ini", vbOKOnly &_
      vbCritical, Titles : WSFSEnd
    End if

    Select Case Param
      Case 1 Str = Path
      Case 2 Str = PathIc
      Case 3 Str = Icon
    End Select

    Tmp = FSO.GetSpecialFolder(2) & "\" & FSO.GetTempName()
    FSO.CreateTextFile(Tmp, True).Write Str
    WSH.Run Chr(34) & GetPath(NirCmd) & Chr(34) & " " & "clipboard readfile " & Tmp , 2,True
    WScript.Sleep 1000 : FSO.DeleteFile Tmp : WSFSEnd

    Sub WSFSEnd : Set WSH = Nothing : Set FSO = Nothing : Wscript.Quit : End Sub
    Function GetPath(pPath) : GetPath = WSH.ExpandEnvironmentStrings(pPath) : End Function
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:11

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

    22 ноября 2011 - 14:47 / #3
  4. Offline

    Andrey_A

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

    Posts: 275

    SetIconForFolders.vbs
    Назначить выделенным папкам иконки из файла, или из библиотеки

    ' SetIconForFolders.vbs
    '========================   Описание   =====================================
    ' Назначить выделенным папкам иконки из файла, или из библиотеки
    ' (создание файла Desktop.ini в этой папке)
    ' В диалоге есть возможность ввести номер иконки
    '========================  Примеры =======================================
    ' %L %T%M - Назначение папке\ам значка из файла соседней панели
    ' %L "%%COMMANDER_PATH%%\Wcmicons.dll" Назначение папке значка из файла Wcmicons.dll

    ' Автор:             Аверин Андрей
    ' Версия:          1.2 (22.08.2011 - 05.03.2012)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '========================================================================
    If WScript.Arguments.Count < 2 Then WScript.Quit
    Number = 0
    IconFile = WScript.Arguments(1)
    Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
    Number = InputBox("Введите номер значка в библиотеке," & vbNewLine &_
    "(по-умолчанию номер = 0)", "Назначение значка папке или Создание Desktop.ini ", Clip)
    If Len(Number) = 0 Then WScript.Quit

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set ListFile = FSO.OpenTextFile(WScript.Arguments(0), 1)
    Do While Not ListFile.AtEndOfStream
      Dir = ListFile.ReadLine
      If FSO.FolderExists(Dir)Then
        If Right(Dir, 1) <> "\" Then Dir = Dir & "\"
        CreateDesctop(Dir)
      End If
    Loop

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

    Sub CreateDesctop(Dir)
      FileName = Dir & "Desktop.ini"
      If FSO.FileExists(FileName) Then FSO.DeleteFile(FileName)
      With FSO.CreateTextFile(FileName, True)  'Создадим Desktop.ini
        .WriteLine "[.ShellClassInfo]"
        .WriteLine "IconFile=" & IconFile
        .WriteLine "IconIndex=" & Number
        .WriteLine "IconResource=" & IconFile & "," & Number
        .Close
      End With
      With FSO.GetFile(FileName) .Attributes = .Attributes Or 38 End With
      With FSO.GetFolder(Dir) .Attributes = .Attributes Or 1 End With
    End Sub
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:13

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

    23 ноября 2011 - 02:44 / #4
  5. Offline

    Andrey_A

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

    Posts: 275

    IconsOnAssFolders.vbs
    Присвоение значков выделенным Папкам по содержимому

    ' IconsOnAssFolders.vbs
    '======================================================================
    ' Присвоение значков выделенным Папкам по содержимому
    ' Ассоциированные значкам папки и расширения считываются из файла
    ' Синтаксис файла:
    ' Путь\к\значку{библиотека,номер}=;Папка1;Папка2;расширение1;расширение2;...
    ' d:\Картинки\Иконки\Архив.ico=;Архивы;Архив;7z;7zip;rar;
    ' %SystemRoot%\system32\shell32.dll,-236=;Музыка;mp3;wal;
    ' %COMMANDER_PATH%\Wcmicons.icl,1854=;Текст;Документы;doc;docx;txt;
    ' %WINDIR%\Wcmicons.dll,1457=;TC Image;Total Commander;
    '========================  Параметры ===================================
    ' В параметрах вызова из TC должно быть прописанo 2 параметра:
    ' {Cписок файлов} {путь\к\файлу_ассоциаций}
    ' {любой 3-й параметр означает, что если в папке уже есть desctop.ini - он будет заменён}
    '========================    Примеры    ===================================
    ' %L "%%COMMANDER_PATH%%\Scripts\AddIcons\IconsOnAssFolders.txt"
    ' %L "%%COMMANDER_PATH%%\Scripts\AddIcons\IconsOnAssFolders.txt" 1
    ' Автор:             Аверин Андрей
    ' Версия:          1.2 (30.12.2010 - 21.10.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '======================================================================
    Cnt = WScript.Arguments.Count
    If Cnt < 2 Then
      MsgBox "Не хватает параметров!" & vbNewLine &_
      "Должно быть минимум Два параметра!" & vbNewLine &_
      "%L ''Путь\к\IconsOnAssFolers.txt''", vbOKOnly &_
      vbCritical, "Присвоение значков Папкам по содержимому"
      Wscript.Quit
    End If

    Dim FSO, ExtLine
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set List = FSO.OpenTextFile(GetPath(WScript.Arguments(0)), 1)
    ExtLine = Split(FSO.OpenTextFile(GetPath(WScript.Arguments(1)), 1).ReadAll, vbNewLine)

    Do While Not List.AtEndOfStream
      fF = GetPath(List.ReadLine) : ll = 0
      If FSO.FolderExists(fF) Then
        Ext = Split(";" & FSO.GetBaseName(fF) & ";" & ExtStr(fF), ";")
        For i = 0 To Ubound(Ext)
          For k = 0 To Ubound(ExtLine)
            If InStr(1, UCase(Mid(ExtLine(k), Instr(ExtLine(k), "=") + 1, Len(ExtLine(k)))), ";" & UCase(Ext(i)) & ";") >  0 Then
              If Right(fF, 1) <> "\" Then fF = fF & "\"
              IC = GetPath(Mid(ExtLine(k), 1, Instr(ExtLine(k), "=") - 1))
              If Instr(IC, ",") > 0 Then
                IC = GetPath(Mid(ExtLine(k), 1, Instr(ExtLine(k), ",") - 1))
                NN = Mid(ExtLine(k), Instr(ExtLine(k), ",") + 1, Instr(ExtLine(k), "=") - Instr(ExtLine(k), ",") - 1)
              Else
                NN = "0"
              End If
                Desktop fF, IC, NN : ll = 1 : Exit For
            End If
          Next
          If ll = 1 Then Exit For
        Next
      End If
    Loop

    List.Close : Set List = Nothing : Set Folder = Nothing : Set FSO = Nothing : Wscript.Quit
    Function GetPath(pPath) : GetPath = CreateObject("WScript.Shell").ExpandEnvironmentStrings(pPath) : End Function

    Function ExtStr(fFolder)
      Dim Folder
      Set Folder = FSO.GetFolder(fFolder)
      For Each Files In Folder.Files
        If InStr(";descript.ion;desktop.ini;", LCase(FSO.GetFileName(Files))) = 0 Then
          Ext  = FSO.GetExtensionName(Files)
          If InStr(UCase(ExtStr), UCase(Ext)) < 1 Then ExtStr = ExtStr & Ext & ";"
        End If
      Next
    End Function

    Sub Desktop(TargetDir,IconFile, Number)
      FileName = TargetDir & "Desktop.ini"
      If Not FSO.FileExists(FileName) Or Cnt > 2 Then
        If FSO.FileExists(FileName) Then FSO.DeleteFile(FileName)
        With FSO.CreateTextFile(FileName)
          .WriteLine "[.ShellClassInfo]"
          .WriteLine "IconFile=" & IconFile
          .WriteLine "IconIndex=" & Number
          .WriteLine "IconResource=" & IconFile & "," & Number
          .Close
        End With
        With FSO.GetFile(FileName) .Attributes = .Attributes Or 38 End With
        With FSO.GetFolder(TargetDir) .Attributes = .Attributes Or 33 End With
      End If
    End Sub

    Пример файла IconsOnAssFolders.txt

     "IconsOnAssFolders.txt"
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:14

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

    23 ноября 2011 - 02:46 / #5
  6. Offline

    Andrey_A

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

    Posts: 275

    IconOnFolders.vbs
    Назначение папке иконки из файла, т.е. создание файла Desktop.ini в этой папке

    ' IconOnFolders.vbs
    '========================   Описание   =====================================
    ' Назначение папке иконки из файла, т.е. создание файла Desktop.ini в этой папке
    ' В диалоге вводится номер значка библиотеки
    '========================  Параметры =====================================
    ' 1-й параметр: Папка, которой будет назначен значок
    ' 2-й параметр: Библиотека, значок
    ' Любой третий параметр не вызовет диалог ввода номера значка
    '========================   Примеры   =====================================
    ' "%P\" %P%N  - Назначение папке значка из файла под курсором
    ' %P%N %T%M - Назначение папке значка из файла соседней панели
    ' %P%N "%%COMMANDER_PATH%%\Wcmicons.dll" Назначение папке значка из файла Wcmicons.dll
    ' "%P\" ""%N"" 1  - Назначение папке значка из файла под курсором без пути (без диалога)

    ' Автор:             Аверин Андрей
    ' Версия:          1.2 (2010 - 21.10.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '========================================================================
    Titles = "Назначение значка папке - Создание Desktop.ini "
    With WScript
      Cnt = .Arguments.Count
      If Cnt = 0 Then .Quit
      Number = 0 : TargetDir = .Arguments(0) : IconFile  = .Arguments(1)
      If Cnt < 3 Then
        Number = InputBox("Введите номер значка в библиотеке," & vbNewLine &_
        "(по-умолчанию номер = 0)",Titles , "0")
        If Len(Number) = 0 Then  .Quit
      End If
    End With

    Set FSO = CreateObject("Scripting.FileSystemObject")
    If FSO.FolderExists(TargetDir) Then
      If Right(TargetDir, 1) <> "\" Then TargetDir = TargetDir & "\"
    Else
      MsgBox "Не задано корректное имя папки!", vbOKOnly + vbExclamation, Titles : WsEnd
    End If

    TrFile = TargetDir & "Desktop.ini"
    If FSO.FileExists(TrFile) Then FSO.DeleteFile(TrFile)

    'Создадим Desktop.ini
    With FSO.CreateTextFile(TrFile, True)
      .WriteLine "[.ShellClassInfo]"
      .WriteLine "IconFile=" & IconFile
      .WriteLine "IconIndex=" & Number
      .WriteLine "IconResource=" & IconFile & "," & Number
      .Close
    End With

    With FSO.GetFile(TrFile) .Attributes = .Attributes Or 38 End With
    With FSO.GetFolder(TargetDir) .Attributes = .Attributes Or 1 End With
    WsEnd
    Sub WsEnd : Set FSO = Nothing : WScript.Quit : End Sub
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:14

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

    23 ноября 2011 - 02:54 / #6
  7. Offline

    Andrey_A

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

    Posts: 275

    FoldersGroupIcon.vbs
    Групповое назначение иконок у выделенных папок

    ' FoldersGroupIcon.vbs
    '=========================================================================
    ' Групповое назначение иконок у выделенных папок (создание файлов desktop.ini)
    ' Назначить выделенным папкам значков из exe, ico, icl файлов в папках
    '=======================   Параметры  =====================================
    ' 1-й параметр: папка|файл-список папок
    ' 2-й параметр: файл с иконкой
    ' 3-й параметр: режим поиска файла с иконкой, где режим поиска файла с иконкой может принимать значения:
    '   0 - обязательно должен быть задан файл с иконкой;
    '   1 - если не задан файл с иконкой, выполняется автоматический поиск;
    '   2 - если автоматически файл не найден, предлагается указать его вручную;
    '   3 - всегда предлагается указать файл вручную (по умолчанию).
    ' 4-й параметр: любой, означает, что если в папке уже есть desctop.ini - он будет заменён
    ' 5-й параметр: любой, означает, что в desctop.ini будет прописано только имя файла
    '========================   Примеры   =====================================
    ' "%P" "%N"
    ' %P%N %T%M
    ' %L "" 2
    ' %L "" 1 1 1
    ' Автор:       Batya & Аверин Андрей
    ' Версия:    1.1 (16.04.2009 - 20.10.2011)
    ' Site:                  http://tc-image.3dn.ru
    '=========================================================================
    Option Explicit
    '======== Изменяемые параметры ===========================================
    Const DefaultMode = 3    'Режим поиска файла с иконкой по умолчанию
    Const FoldAttr = 1             'Атрибуты папки - "Только чтение"
    Const FileAttr = 38            'Атрибуты файла - "Скрытый", "Системный", "Архивный"
    '=========================================================================
    Dim Mess, FSO, ListFlag, FF, IconFile, F, Errors, Mode, Cnt, Des

    Set Errors = CreateObject("Scripting.Dictionary")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    SetMess : CheckParam

    If ListFlag Then
      For Each F In Split(FSO.OpenTextFile(FF).ReadAll, vbNewLine)
        If FSO.FolderExists(F) Then Main F
      Next
    Else
      Main FF
    End If

    If Errors.Count > 0 Then MessBox JoinErr(Errors), 2
    Quit

    Sub SetMess
      Set Mess = CreateObject("Scripting.Dictionary")
      With Mess
        .Add 0,  " для папки"
        .Add 1,  "Не указаны параметры!"
        .Add 2,  "Первый параметр не является папкой или файлом-списком!"
        .Add 3,  "Указанный файл с иконкой не существует!"
        .Add 4,  "Не является папкой!"
        .Add 5,  "Файл с иконкой не найден!"
        .Add 6,  "Файл Desktop.ini уже существует!"
        .Add 7,  "Операция завершена."
        .Add 8,  "Операция завершена с ошибками." & vbNewLine
        .Add 9,  "Укажите файл иконок для папки "
        .Add 10, "Исполняемые файлы (*.exe)|*.exe|Файлы иконок (*.ico)|*.ico|Все файлы (*.*)|*.*"
        .Add 11, "Неправильно указан режим поиска файла иконок!"
        .Add 12, "В данном режиме файл с иконкой должен быть указан обязательно!"
      End With
    End Sub

    Sub Main(pF)
      Dim lF, lIF
      lF = GetPath(pF)
      If Not FSO.FolderExists(lF) Then Errors.Add lF, lF & " - " & Mess(4) : Exit Sub End If
      lIF = GetIconFile(lF, IconFile)
      If lIF = "" Then Errors.Add lF, lF & " - " & Mess(5) : Exit Sub End If
      With FSO.GetFolder(lF) .Attributes = .Attributes or FoldAttr End With   'Установим атрибуты папки
      Des = lF & "\Desktop.ini"
      If Not FSO.FileExists(Des) Or Cnt > 3 Then
        If FSO.FileExists(Des) Then FSO.DeleteFile Des
        CreateDesktopFile Des, lIF
      Else
        Errors.Add lF, lF & " - " & Mess(6) : Exit Sub
      End If
    End Sub

    Sub CheckParam
      Cnt = WScript.Arguments.Count
      If Cnt = 0 Then MessBox Mess(1), 1 : Call Quit End If
      FF = WScript.Arguments(0) : ListFlag = FSO.FileExists(FF)
      If (Not ListFlag) And (Not FSO.FolderExists(FF)) Then MessBox Mess(2), 1 : Call Quit End If
      If Cnt > 1 Then
        IconFile = WScript.Arguments(1)
        If IconFile <> "" Then IconFile = GetPath(IconFile)
      Else
        IconFile = ""
      End If
      If Cnt > 2 Then
        Mode = WScript.Arguments(2)
        If Mode = "" Then
          Mode = DefaultMode
        Else
          If IsNumeric(Mode) Then
            Mode = CInt(Mode)
          Else
            MessBox Mess(11), 1 : Call Quit
          End If
          If Not((Mode = 0) Or (Mode = 1) Or (Mode = 2) Or (Mode = 3)) Then MessBox Mess(11), 1 : Call Quit End If
        End If
      Else
        Mode = DefaultMode
      End If
      If (Mode = 0) And (IconFile = "") Then MessBox Mess(12), 1 : Call Quit End If
      If (IconFile <> "") And (Not FSO.FileExists(IconFile)) Then MessBox Mess(3), 1 : Call Quit End If
    End Sub

    Sub Quit : Set Errors = Nothing : Set FSO = Nothing : WScript.Quit : 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

    Function JoinErr(pDic)
      Dim lKey
      For Each lKey In pDic
        JoinErr = JoinErr & vbNewLine & vbNewLine & pDic(lKey)
      Next
      JoinErr = Mess(8) & JoinErr
    End Function

    Sub CreateDesktopFile(pFile, pIconFile)
      If Cnt > 4 Then pIconFile = FSO.GetFileName(pIconFile)
      With FSO.CreateTextFile(pFile)
        .WriteLine "[.ShellClassInfo]"
        .WriteLine "IconResource=" & pIconFile
        .WriteLine "IconFile=" & pIconFile
        .WriteLine "IconIndex=0"
        .Close
      End With
      With FSO.GetFile(pFile) .Attributes = .Attributes or FileAttr End With
    End Sub

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

    Function GetIconFile(pFolder, pFile)
      Dim lFile, Ext, i
      If Mode = 0 Then GetIconFile = pFile : Exit Function End If
      If Mode < 3 Then
        If pFile <> "" Then
          GetIconFile = pFile : Exit Function
        Else
          lFile = pFolder & "\" & FSO.GetBaseName(pFolder) & ".exe"
          If FSO.FileExists(lFile) Then
            GetIconFile = lFile : Exit Function
          End If
          For Each lFile In FSO.GetFolder(pFolder).Files
            If UCase(FSO.GetExtensionName(lFile)) = "EXE" Then
              If (UCase(Left(lFile, 5)) <> "UNINS") Or (UCase(FSO.GetBaseName(lFile)) <> "UNWISE") Then
                GetIconFile = lFile : Exit Function
              End If
            End If
          Next
          Ext = Array("ICO", "ICL") ' если .exe не найдено (можно вписать другие раксширения имеющие значки)
          For i = 0 To Ubound(Ext)
            For Each lFile In FSO.GetFolder(pFolder).Files
              If UCase(FSO.GetExtensionName(lFile)) = Ext(i) Then GetIconFile = lFile : Exit Function End If
            Next
          Next
          If Mode = 2 Then
            GetIconFile = OpenFile(pFolder)
          Else
            GetIconFile = ""
          End If
        End If
      Else
        GetIconFile = OpenFile(pFolder)
      End If
    End Function

    Function OpenFile(pFolder)
      Dim Dlg
      On Error Resume Next
      Set Dlg = CreateObject("MSComDlg.CommonDialog")
      If Err.Number = 0 Then
        On Error GoTo 0
        With Dlg
          .InitDir = pFolder
          .Filter = Mess(10)
          .Flags = &H4 + &H8 + &H400 + &H1000 + &H80000
          .FilterIndex = 1
          .MaxFileSize = 32000
          .CancelError = True
          .DialogTitle = Mess(9) & """" & pFolder & """"
          On Error Resume Next
          .ShowOpen
        End With
        If Err.Number = 0 Then
          OpenFile = Dlg.FileName
        Else
          OpenFile = ""
        End If
        On Error GoTo 0
        Set Dlg = Nothing
      Else
        On Error GoTo 0
        Dlg = InputBox(Mess(9) & """" & pFolder & """", Mess(0), pFolder & "\")
        If Dlg <> "" Then Dlg = GetPath(Dlg)
        If Not FSO.FileExists(Dlg) Then Dlg = ""
        OpenFile = Dlg
      End If
    End Function
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:15

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

    23 ноября 2011 - 02:58 / #7
  8. Offline

    Andrey_A

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

    Posts: 275

    DeleteDesktopInI.vbs
    Удаление в выделенных папках файла Desktop.ini и снятие атрибута с папки "Только чтение"

    ' DeleteDesktopInI.vbs
    '========================   Описание   =====================================
    ' Удаление в выделенных папках файла Desktop.ini и снятие атрибута с папки "Только чтение"
    '=======================   Параметры  =====================================
    ' 1-й параметр: Список файлов
    ' 2-й параметр: необязательный битовый флаг атрибута, который необходимо снять с папки
    ' (по умолчанию снимается с папки атрибут "Только чтение")
    '========================   Примеры   =====================================
    ' %L    - удалить Desktop.ini и снять атрибут "Только чтение"
    ' %L 0 - удалить Desktop.ini и снять все атрибуты
    '=======================   Дополнение   ====================================
    ' Иногда desktop.ini содержит иную информацию помимо пути и индекса иконки,
    ' поэтому  используйте этот скрипт разумно!!!

    ' Автор:             Аверин Андрей
    ' Версия:          1.1 (14.11.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '========================================================================
    If WScript.Arguments.Count > 0 Then
      With CreateObject("Scripting.FileSystemObject")
        Attr = 1
        If WScript.Arguments.Count > 1 Then Attr = WScript.Arguments(1)
        Set ListFile = .OpenTextFile(WScript.Arguments(0), 1)
        Do While Not ListFile.AtEndOfStream
          Dir = ListFile.ReadLine
          If .FolderExists(Dir)Then
            If Right(Dir, 1) <> "\" Then Dir = Dir & "\"
            Des = Dir & "Desktop.ini"
            If .FileExists(Des) Then
              .GetFolder(Dir).Attributes = Attr ' Снимаем у папки атрибут
              .DeleteFile Des
            End If
          End If
        Loop
      End With
    Else
      MsgBox "Не хватает параметров!", vbOKOnly & vbCritical, "Удаление Desktop.ini"
    End If
    WScript.Quit
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:16

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

    23 ноября 2011 - 03:00 / #8
  9. Offline

    Andrey_A

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

    Posts: 275

    Attributes.vbs
    Установка\Снятие атрибутов у выделенных файлов\папок без рекурсии
    ' Attributes.vbs
    '========================   Описание   =====================================
    ' Установка\Снятие атрибутов у выделенных файлов\папок без рекурсии
    ' (без подпапок и файлов в них)
    '=======================   Параметры  =====================================
    ' 1-й параметр: список файлов\папок
    ' 2-й параметр: 0 - снятие атрибута; 1 - установка атрибута
    ' 3-й параметр: битовый флаг атрибута
    '========================================================================
    'Normal          0     Normal file. No attributes are set.                          Нет атрибутов
    'ReadOnly     1     Read-only file. Attribute is read/write.                   Только чтение
    'Hidden          2     Hidden file. Attribute is read/write.                        Скрытый
    'System         4     System file. Attribute is read/write.                        Системный
    'Volume         8     Disk drive volume label. Attribute is read-only.  Метка диска
    'Directory     16    Folder or directory. Attribute is read-only.          Каталог
    'Archive        32    File has changed since last backup. Attribute is read/write.  Архивный
    'Alias             64    Link or shortcut. Attribute is read-only.               Ярлык
    'Compressed  128     Compressed file. Attribute is read-only.       Сжатый
    '========================================================================
    ' %L 1 38

    ' Автор:             Аверин Андрей
    ' Версия:          1.0 (28.04.2011)
    ' Mail:                 Averin-And@yandex.ru
    ' Site:                  http://tc-image.3dn.ru
    '========================================================================
    Dim FSO, FF, Line, sFile
    Set FSO = CreateObject("Scripting.FileSystemObject")

    If WScript.Arguments.Count > 1 Then
      Set sFile = FSO.OpenTextFile(WScript.Arguments(0), 1)
      m = WScript.Arguments(1) : Atrib = WScript.Arguments(2)
    Else
      MsgBox "Не хватает параметров!!!", vbOKOnly & vbCritical, "Установка\Снятие Атрибутов"
      WScript.Quit
    End If

    Do While Not sFile.AtEndOfStream
      Line = sFile.ReadLine
      if FSO.FileExists(Line) Then Set FF = FSO.GetFile(Line)
      if FSO.FolderExists(Line) Then Set FF = FSO.GetFolder(Line)
      If m = 0 Then
        FF.Attributes = FF.Attributes And Not Atrib
      Else
        FF.Attributes = FF.Attributes Or Atrib
      End If
    Loop

    Set sFile = Nothing : Set FF = Nothing : Set FSO = Nothing : WScript.Quit
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:16

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

    23 ноября 2011 - 03:17 / #9
  10. Offline

    Andrey_A

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

    Posts: 275

    ChangeAttributes.vbs
    Изменение атрибута у отмеченных файлов и папок (файлов в них)
    ' ChangeAttributes.vbs
    '=====================================================================
    ' http://forum.wincmd.ru/viewtopic.php?p=77300#77300
    ' http://tc-image.3dn.ru
    ' Изменение атрибута у отмеченных файлов и папок (файлов в них)
    ' Параметры:
    ' {файл-список} {битовый флаг атрибута} [{режим}]
    ' где {режим} может принимать значения:
    '     0 - смена атрибута (по умолчанию),
    '     1 - установка атрибута,
    '     2 - снятие атрибута.
    ' Наиболее часто используемые значения {битовый флаг атрибута}:
    '     1 - только чтение,
    '     2 - скрытый,
    '     4 - системный,
    '     32 - архивный.

    ' Пример параметров вызова из TC (установка атрибута "Скрытый"):
    ' %L 2 1

    ' Автор:             Batya
    ' Версия:          1.0 (26.04.2011)
    '=====================================================================
    Option Explicit
    Dim FSO, StreamFile, Selected, CurrFolder, Attr, Mode
    Set FSO = CreateObject("Scripting.FileSystemObject")
    With WScript
      Set StreamFile = FSO.OpenTextFile(.Arguments(0), 1)
      Attr = .Arguments(1)
      If .Arguments.Count < 3 Then
        Mode = 0
      Else
        Mode = CInt(.Arguments(2))
      End If
    End With
    Do While Not StreamFile.AtEndOfStream
      Selected = StreamFile.ReadLine
      If FSO.FileExists(Selected) Then
        ChangeAttr FSO.GetFile(Selected)
      End If
      If FSO.FolderExists(Selected) Then
        Set CurrFolder = FSO.GetFolder(Selected)
        ChangeAttr CurrFolder
        FolderProcess CurrFolder
      End If
    Loop
    'MsgBox("Выполнено!")
    Set FSO = Nothing : Set StreamFile = Nothing : Set CurrFolder = Nothing : Wscript.Quit

    Sub FolderProcess(CurrFolder)
      Dim f
      For Each f in CurrFolder.SubFolders
        ChangeAttr f
        FolderProcess f
      Next
      For Each f in CurrFolder.Files
        ChangeAttr f
      Next
    End Sub

    Sub ChangeAttr(pFObj)
      With pFObj
        Select Case Mode
          Case 0 .Attributes = .Attributes Xor Attr
          Case 1 .Attributes = .Attributes Or Attr
          Case 2 .Attributes = .Attributes And Not Attr
        End Select
      End With
    End Sub
    Сообщение отредактировал Andrey_A 9 марта 2012 - 01:16

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

    23 ноября 2011 - 03:22 / #10

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

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