TC Image and Group

CreateFilesWithInfoDevices.vbs - Информация обустройствах

Andrey_A — Mon, 25 Nov 2024 18:46:56 GMT

Создание файлов с именами существующих устройств и информацией о них
Доступно только для пользователей

Code

' CreateFilesWithInfoDevices.vbs
'========================   Описание   =================================
' Создание файлов с именами существующих устройств и информацией о них
'=======================   Параметры  =====================================
' "<Путь назначения>" Пример: %t
' Автор:             Flasher ©
' Версия:          1.0 (05.03.2012)
' Site:                 http://tc-image.3dn.ru/forum/3-318-1017-16-1333361886
' Site:                 http://cjgrey.ru/forum/27-118-5021-16-1330948617
'====================================================================
If WScript.Arguments.Count = 0 Then : MsgBox "Не указан параметр! Пример: %t", 48 : WScript.Quit : End If
Path = WScript.Arguments(0) : If Right(Path, 1) <> "\" Then Path = Path & "\"
Set WMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set DRV = WMI.ExecQuery("Select * from Win32_PnPSignedDriver")
Set FSO = CreateObject("Scripting.FileSystemObject") : B = vbTab : Const M = 1
For Each I In DRV
    For Each V In WMI.ExecQuery("Select Name, Description, ClassGUID, Service, Status from " & _
      "Win32_PnPEntity WHERE DeviceID = '" & Replace(I.DeviceID, "\", "\\") & "'")
      F1 = V.Description : F2 = V.Name
      If F1 <> F2 Then I1 = F1 & " (" & F2 & ")" & L Else I1 = F1 & vbnewline
      I1 =                    "Название:"             &B&B& I1
      F V.ClassGuid,          "GUID:"               &B&B&B, I2
      F V.Service,            "Служба:"             &B&B&B, I7
      F V.Status,             "Состояние:"            &B&B, I19
    Next
    F I.DeviceID,           "ID устройства:"        &B&B, I3
    F I.CompatID,           "Совместимый ID:"       &B&B, I4
    F I.HardWareID,         "ID аппаратуры:"        &B&B, I5
    F I.DeviceClass,        "Класс устройства:"     &B&B, I6
    F I.DriverName,         "Имя драйвера:"         &B&B, I8
    F I.DriverProviderName, "Поставщик драйвера:"     &B, I9
    F I.DriverVersion,      "Версия драйвера:"      &B&B, I10
    F I.FriendlyName,       "Понятное имя:"         &B&B, I12
    F I.InfName,            "Имя INF-файла:"        &B&B, I13
    F I.InstallDate,        "Дата установки:"       &B&B, I14
    F I.Signer,             "Сертифицирован:"       &B&B, I15
    F I.PDO,                "Объекты данных PHP:"     &B, I16
    F I.Location,           "Аппаратная локализация:" &B, I17
    F I.Manufacturer,       "Производитель:"        &B&B, I18
    InD = I.DriverDate : If Trim(Ind) <> "" Then _
    I11 =                   "Драйвер зарегистрирован:"&B&_
    Mid(InD, 7, 2) & "." & Mid(InD, 5, 2) & "." & Left(InD, 4) & vbnewline
    Info = I1&I2&I3&I4&I5&I6&I7&I8&I9&I10&I11&I12&I13&I14&I15&I16&I17&I18&I19
    Fl = Replace(F2, "/", "-") : Name = Fl & ".txt" : l = 0
    Do While FSO.FileExists(Path & Name)
      l = l + 1
      If l < 10^M Then PostFix = Right(String(M, "0") & l, M) Else PostFix = l
      Name = Fl & " (" & PostFix & ").txt"
    Loop : Set File = FSO.OpenTextFile(Path & Name, 2, True)
    File.Write Left(Info, Len(Info) - 2) : File.Close
Next : CreateObject("WScript.Shell").Popup "Файлы созданы!", 1.5, Space(15) & "Результат", 64
Set WMI = Nothing : Set DRV = Nothing : Set FSO = Nothing : WScript.Quit
Sub F(D, Tx, T)
    N = Trim(D) : If N <> "" Then T = Tx & N & vbNewLine
End Sub

InfoPluginsTC.vbs - Информация о плагинах ТС

Andrey_A — Sun, 23 Jun 2024 15:02:38 GMT

Полная информация о встроенных плагинах Total Commander

Доступно только для пользователей

Код

' InfoPluginsTC.vbs
'========================   Описание   =====================================
' Полная информация о встроенных плагинах Total Commander
'
' Автор:             Аверин Андрей
' Версия:          1.2 (15.08.2011 - 08.03.2024)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru/forum/3-27-270-16-1330524627
'========================================================================
Dim FSO, WSH
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
Insert = ""
Plug = Array("WCX", "WCX64", "WDX", "WDX64", "WFX", "WFX64", "WLX", "WLX64")
'====================   Изменяемые пути   ===================================
FilePlug = GetPath("%COMMANDER_PATH%\Files\Help\TCInfo\AllPlugins.tcinfo") ' файл для записи информации о плагинах
Program = GetPath("%COMMANDER_PATH%\AkelPad.exe") ' текстовый редактор
'=========================================================================
For i = 0 To Ubound(Plug)
   cn = 0 : Wxx = Plug(i)
   Text = Text & Insert & String(46, "=") & Chr(32) & Wxx & " Плагины " & String(46, "=") & vbNewLine &_
               "Имя                      Версия                     Путь                    Комментарии" & vbNewLine &_
                String(105, "=") & vbNewLine
   Selected = GetPath("%COMMANDER_PATH%\Plugins\" & Replace(Wxx, "64", ""))
   desPaht = Selected & "\descript.ion"
   If FSO.FileExists(desPaht) Then
     On Error Resume Next
     dText = FSO.OpenTextFile(desPaht).ReadAll
     If Len(dText) > 0 Then cn = 1
   End If
   If FSO.FolderExists(Selected) Then
     Set CurrFolder = FSO.GetFolder(Selected)
     FolderProcess(CurrFolder)
   End If
   Insert = vbNewLine
Next

Call FSO.OpenTextFile(FilePlug, 2, True).Write(Text)
WSH.Run Chr(34) & Program & Chr(34) & Chr(32) & Chr(34) & FilePlug & Chr(34)

Set CurrFolder = Nothing : Set FSO = Nothing : Set WSH = Nothing : WScript.Quit

' сканирует все файлы в папках и подпапках, извлекается необходимая информация
Sub FolderProcess(CurrFolder)
   For Each sf in CurrFolder.SubFolders
     FolderProcess(sf)
   Next
   For Each f in CurrFolder.Files
     File = f.Path
     If Wxx = UCase(FSO.GetExtensionName(File)) Then
       plFile = Replace(File, GetPath("%COMMANDER_PATH%\"), "")
       'plFile = Replace(File, GetPath("%COMMANDER_PATH%"), "%COMMANDER_PATH%")
       On Error Resume Next
       NameExt = FSO.GetFileName(File) : Version = FSO.GetFileVersion(File)
       pName = Replace(FSO.GetParentFolderName(File), FSO.GetParentFolderName(FSO.GetParentFolderName(File)), "")
       pName = Mid(pName, 2) : InfDes = DescriptInfo(pName)
       Text = Text & NameExt & Space(25 - Len(NameExt)) &_
                    Version & Space(10 - Len(Version)) &_
                    plFile & Space(50 - Len(plFile)) &_
                    InfDes & vbNewLine
     End If
   Next
End Sub

' возвращает комментарий для имени
Function DescriptInfo(dName)
   DescriptInfo = "---"
   ind = InStr(LCase(dText), LCase(dName))
   If ind > 0 Then
     dsText = Mid(dText, ind + Len(dName) + 1)
     vbn = InStr(dsText, vbNewLine)
     If vbn > 0 Then dsText = Left(dsText, vbn - 1)
       dsText = Replace(dsText, "\nВ", "")
       dsText = Replace(dsText, "В", "")
       dsText = Trim(Replace(dsText, "\n", Chr(32)))
       If Left(dsText, 1) = "'" Then dsText = Trim(Mid(dsText, 2))
       dsText = Replace(dsText, "' ", "")
   End If
   DescriptInfo = dsText
End Function

' Возвращает полный путь для заданного относительного пути
Function GetPath(pPath) : GetPath = WSH.ExpandEnvironmentStrings(pPath) : End Function

КОЛЛЕКЦИЯ СКРИПТОВ

Andrey_A — Tue, 12 Mar 2024 15:56:01 GMT

КОЛЛЕКЦИЯ СКРИПТОВ

Скрипты - уникальный инструмент для достижения различных целей в работе с файлами и не только, особенно в файловом менеджере, даже если вы ничего раньше об этом ничего не слышали и не знали, то путём простых движений вы можете оптимизировать свои действия

1. Каждый может выложить свой скрипт ЗДЕСЬ, СОЗДАВ НОВУЮ ТЕМУ
...a) скрипт может быть написан на любом языке: vbs, js, hta, au3,ahk, bat,cmd...
...b) скрипт должен относится как-то к Total Commander или к системе
...c) к скрипту должно быть описание к применению и примеры
...d) в скрипте должна быть ссылка на сообщение, где он выкладывается - это нужно для создания списка всех скриптов и для быстрого поиска на сайте

2. Каждый может протестировать, дать свой комментарий в теме самого скрипта

3. Каждый может заказать скрипт ЗДЕСЬ. Если есть интересная идея, вы можете поделиться, а вдруг она покажется интересной для авторов...

4. Узнать об изменении и обновлении скриптов Вы можете ЗДЕСЬ

5. Узнать как использовать скрипты, параметры и дополнительные утилиты Вы можете ниже под спойлерами

Всё это делается для тех, кто хочет экономить время и автоматизировать работу
Огромное спасибо участникам, авторам и всем повлиявшим на тему

Доступно только для пользователейПеред использованием скриптов, проэкспериментируйте сначала на "ненужных" файлах
(у меня на разных дисках есть несколько папок с разными файлами для экспериментов)
Как только вы убедитесь, что скрипт работает как надо, пользуйтесь на реальных файлах

- ряд скриптов могут не сработать:
1. Из-за раскладки клавиатуры (переключите раскладку, повторите заново)
2. Из-за неправильно указанных параметров (внимательно читайте комментарии внутри скриптов)
3. Из-за параметров %p и %P в командной строке и тому подобных (на практике иногда надо их брать кавычки "%P")
4. Из-за 2-х запущенных копий Total Commander (редко, но бывает)
5. Из-за неверно указанных путей использованных файлов (внимательно проверьте пути)
6. Из-за недостающих дополнительных утилит, использующих скриптом (проверьте есть ли они у вас)
7. Из-за очень большого количества файлов, посланных для обработки скрипту
- Может показаться, что скрипт не сработал, возможно он ещё работает. Чтобы в этом убедится откройте Диспетчер задач и посмотрите процесс
- Скрипты, связанные с посланием команд Total Commander'y при очень большом количестве файлов работают неадекватно.
(попробуйте в Тотале просто выделить 100.000 файлов - это займёт несколько секунд, сколько точно, никто сказать не может - это зависит от многих факторов. Так же и скрипты, связанные с фильтрацией, выделением... может показаться, что глючат - на самом деле сам Тотал не справляется с посланной ему командой, если речь идёт об обработке большого количества файлов)
-----------------------------------------------------------------------------------------------------------------------
8. Из-за ошибки автора - Сообщайте об ошибках

Дополнительно: Конфигурация – Панель инструментов

Cкачать видеокурс по скриптописанию на vbs для новичков

[info]
Большинство скриптов для Total Commander вошли в функционал в утилиты TCIMG

[/info]

Ниже приведены ссылки на темы всех скриптов связанных с Total Commander и системой, находящиеся на этом форуме

.

ОБСУЖДЕНИЕ СКРИПТИНГА

Andrey_A — Mon, 11 Apr 2022 06:40:02 GMT

ОБСУЖДЕНИЕ СКРИПТИНГА

В этой теме обсуждаются различные вопросы, связанные со скриптингом

MoveGroupFileInFolders.vbs - Перемещение по количеству

Andrey_A — Thu, 31 Mar 2022 10:46:16 GMT

Перемещение выделенных файлов\папок по заданному количеству в отдельные (создаваемые) папки

Доступно только для пользователей

Code

' MoveGroupFileInFolders.vbs
'========================   Описание   =====================================
' Перемещение выделенных файлов\папок по заданному количеству в отдельные (создаваемые) папки
'=======================   Параметры  =====================================
' 1-й параметр: файл-список
' 2-й параметр: папка\куда\перемещаются\файлы
' 3-й параметр: количество перемещаемых файлов в каждую папку
'   если параметр отсутствует или параметр = 0 , то выводится диалог ввода
'========================   Примеры   =====================================
' %L %t 50
' %L %p 50
' %L %t

' Автор:             Batya & Аверин Андрей
' Версия:          1.1 (07.09.2010 - 29.10.2011)
' Site:                  http://tc-image.3dn.ru/forum/3-93-339-16-1330569204
'========================================================================
Option Explicit
'================= Изменяемые параметры =================================
Const Rank = 3  'Минимальное количество цифр в создаваемых папках
'========================================================================
Dim FileList, List, F, Folder, Count, i, n, Path, Cnt, Mess
Mess = "Перемещение выделенных файлов по заданному к-ву"
With WScript
   Cnt = .Arguments.Count
   If Cnt < 2 Then
     MsgBox "Не хватает параметров! Должно быть минимум Два параметра" & vbNewLine &_
     "пример: %L %p", vbOKOnly & vbInformation, Mess : .Quit
   End If
   FileList = .Arguments(0) : Folder = .Arguments(1)
   If Cnt > 2 Then : Count = CInt(.Arguments(2)) : Else : InputNumer : End If
   If Count <= 0 Then InputNumer
End With

With CreateObject("Scripting.FileSystemObject")
   List = Split(.OpenTextFile(FileList).ReadAll, vbNewLine)
   If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
   n = 1 : i = Count

   For Each F In List
     If F <> "" Then
       If i >= Count Then
         If Len(CStr(n)) < Rank Then
           Path = Folder & Right(String(Rank, "0") & CStr(n), Rank) & "\"
         Else
           Path = Folder & CStr(n) & "\"
         End If
         If Not .FolderExists(Path) Then .CreateFolder(Path)
         i = 1 : n = n + 1
       Else
         i = i + 1
       End If
       If .FileExists(F) Then .MoveFile F, Path
       If .FolderExists(F) Then
         If Right(F, 1) = "\" Then F = Left(F, Len(F) - 1)
         .MoveFolder F, Path
       End If
     End If
   Next
End With
Wscript.Quit

Sub InputNumer
   Count = InputBox("Введите ЧИСЛО по СКОЛЬКО" & vbNewLine &_
   "файлов перемещать в отдельные папки", Mess, 3)
   If Len(Count) = 0  Or IsEmpty(Count) Then WScript.Quit
   Count = CInt(Count)
   If Count = 0 Then Count = 3
End Sub

CopySelectN.vbs - Копирование со счётчиком

Andrey_A — Mon, 20 Apr 2020 17:10:43 GMT

Копирование выделенных файлов/папок с добавлением счётчика

Доступно только для пользователей

Code

' CopySelectN.vbs
'========================   Описание   =====================================
' Копирование выделенных файлов/папок с добавлением счётчика
'=======================   Параметры  =====================================
' 1-й параметр: файл-список
' 2-й параметр: минимальное количество цифр номера добавляемое к имени, если таковое уже есть
'     - без параметра будет добавляться: имя_1, имя_2, _3, _4
'     - при 2 - имя_01, имя_02, _03, _04
'     - при 3 - имя_001, имя_002 .....
' 3-й параметр: куда копировать (по умолчанию в ту же панель)
'========================   Примеры   =====================================
' %L            Копирование в ту же панель c_1
' %L 2         Копирование в ту же панель c_01
' %L 1 %t   Копирование в соседнюю панель c_1
' %L 3 %t   Копирование в соседнюю панель c_001

' Автор:             Аверин Андрей
' Версия:          1.3 (2010 - 05.06.2012)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru/forum/3-84-330-16-1330566098
'======================================================================
Option Explicit
Dim FSO, ListFile, SelFile, Name, Ext, Path, FPath, MPath, Rank, Delim, n, Num, Cnt, k
Cnt = WScript.Arguments.Count
If Cnt = 0 Then
    MsgBox "Не заданы параметры!", vbOKOnly + vbCritical, "Копирование" : WScript.Quit
End If

If Cnt > 1 Then : Rank = WScript.Arguments(1) : Else : Rank = 1 : End If
If Len(Rank) = 0 Then Rank = 1
Delim = "_" ' если не нужен замените на Delim = ""

Set FSO = CreateObject("Scripting.FileSystemObject")
Set ListFile = FSO.OpenTextFile(WScript.Arguments(0), 1)
Do While Not ListFile.AtEndOfStream
   SelFile = ListFile.ReadLine : Path = FSO.GetParentFolderName(SelFile) & "\"
   Name = FSO.GetBaseName(SelFile) : Ext = FSO.GetExtensionName(SelFile)
   k = 0 : n = 0
   If Cnt > 2 Then
      FPath = CreateObject("WScript.Shell").ExpandEnvironmentStrings(WScript.Arguments(2))
      MPath = FPath & Name & "." & Ext
      If (Not FSO.FileExists(MPath) And Not FSO.FolderExists(MPath)) Then CopyAll
   Else
      FPath = Path
   End If
   MPath = FPath
   If k = 0 Then
     Do
       n = n + 1
       If n < 10^Rank Then
         Num = Right(String(Rank, "0") & n, Rank)
       Else
         Num = n
       End If
       FPath = MPath & Name & Delim & Num & "." & Ext
     Loop While (FSO.FileExists(FPath) Or FSO.FolderExists(FPath))
     CopyAll
   End If
Loop
CreateObject("WScript.Shell").Popup "Задача завершена!", 1, "Копирование", 64 ' если не нужно можете закометировать
ListFile.Close : Set ListFile = Nothing : Set FSO = Nothing : WScript.Quit

Sub CopyAll()
   On Error Resume Next
   If FSO.FileExists(SelFile) Then FSO.CopyFile SelFile, FPath : k = 1 End If
   If FSO.FolderExists(SelFile) Then FSO.CopyFolder Left(SelFile, Len(SelFile) - 1), FPath : k = 1 End If
End Sub

RenameSearchReplace.vbs - Переименование с поиском и заменой

Andrey_A — Thu, 28 Nov 2019 12:55:39 GMT

Переименование имён выделенных файлов\папок с поиском и заменой

Доступно только для пользователей

Код

' RenameSearchReplace.vbs
'========================   Описание   =====================================
' Переименование имён выделенных файлов\папок с поиском и заменой
'=======================   Параметры  =====================================
' 1-й параметр: список файлов
' 2-й параметр: что найти в имени
' 3-й параметр: на что заменить
'========================   Примеры   =====================================
' %L " " "_"     Заменяет в имени выделенных файлах\папках пробел на _
' %L "_" " "     Заменяет в имени выделенных файлах\папках _ на пробел
'
' Автор:             Аверин Андрей
' Версия:          1.1 (2010 - 28.11.2019)
' Mail:                 Averin-And@yandex.ru
' Site:                  http://tc-image.3dn.ru/forum/3-67-313-16-1330561110
'=======================================================================
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) & "\"
     On Error Resume Next
     If .FileExists(SelFile) Then .MoveFile SelFile, Path & Replace(.GetBaseName(SelFile) ,Seach, Replce) & "." & .GetExtensionName(SelFile)
     If .FolderExists(SelFile) Then .MoveFolder  Left(SelFile, Len(SelFile) - 1), Path & Replace(.GetFileName(SelFile) ,Seach, Replce)
   Loop
End With
ListFile.Close : Set ListFile = Nothing : Wscript.Quit

Скрипт для обрезания имен файлов до заданной длины

sfdgsdfgsdfgsdf — Tue, 16 Jul 2019 09:17:47 GMT

Можно ли сделать скрипт для обрезки имен выделенных в Total Commander файлов до заданной в настройках длины? В основном надо для приведения длины файлов к максимально допустимому для большинства программ - 259 символов.

И если можно, то вопрос 2. Скрипт будет работать на временной панели Total Commander? Я хотел бы найти поиском (средствами самого Total Commander или скриптом) все файлы с избыточной длиной, согнать их во временную панель Total Commander и разом обрезать им имена.

Вывод списка свежих файлов лежащих на FTP

Stas78 — Tue, 19 Jun 2018 04:11:07 GMT

Здравствуйте,

есть 53шт. папки на фтп. В каждую папку каждый день падает файл типа pos1_171003_0851.rep или не падает.
хотелось бы написать скрипт или воспользоваться готовым, чтобы на экран выводился список вчера выложенных в папки файлов.
В итоге должно появиться окно в котором я увижу 53 строчки данных: папка фтп, имя файла (последнего закачанного в папку), дата файла, размер файла

примерно так:
/FTP/papka1/ pos1_171003_0851.rep 19.06.18 512Kb
/FTP/papka2/ pos1_180618_2251.rep 19.06.18 675Kb
/FTP/papka3/ pos1_170618_1851.rep 18.06.18 35Kb
/FTP/papka4/ pos1_171003_0851.rep 19.06.18 215Kb

т.е. должна быть возможность указать конкретную папку, точнее список папок на фтп для опроса.

Гугл пока даже близко не помог... Помогите чем сумеете, направьте в нужном направлении, и т.п.

ReplaceInFiles.vbs - Поиск и замена в файлах

Andrey_A — Sat, 03 Feb 2018 07:49:29 GMT

Поиск и замена текста в выделенных текстовых файлах

Доступно только для пользователей

Код

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

' Автор:           Аверин Андрей
' Версия:          1.4 (2009 - 29.08.2012)
' Mail:            Averin-And@yandex.ru
' Site:            http://tc-image.3dn.ru/forum/3-73-319-16-1330562492
'==================================================
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

Dim WSH : Set WSH = CreateObject("WScript.Shell")
On Error Resume Next
P = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407"
A = WSH.RegRead(P) : If A > 0 Then WSH.RegWrite P, 0, "REG_DWORD"
Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
If Len(Find) = 0 Then Find = InputBox("Введите искомую строку", Titles, Clip)
If Len(Find) = 0 Then Quit
Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
Replac = InputBox("Введите строку для замены", Titles, Clip)
If Len(Replac) = 0 Or IsEmpty(Replac) Then Quit
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 : 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

Sub Quit
    If A > 0 Then WSH.RegWrite P, A, "REG_DWORD"
    Set WSH = Nothing : WScript.Quit
End Sub

MoveOnLevelUp.vbs - Перемещение на уровень вверх

Andrey_A — Wed, 29 Nov 2017 13:09:39 GMT

Перемещение выделенных файлов/папок на уровень вверх

Доступно только для пользователей

Code

' MoveOnLevelUp.vbs
'========================   Описание   =====================================
' Перемещение выделенных файлов/папок на уровень вверх
'=======================   Параметры  ======================================
' %L   - перемещает выделенные объекты (если объект есть вверху, то он не перемещается)
' %L 1 - перемещает выделенные объекты (если объект есть вверху, то он перемещается с добавлением счётчика)

' Автор:           Аверин Андрей
' Версия:          1.5 (11.05.2010 - 20.10.2012)
' Mail:            Averin-And@yandex.ru
' Site:            http://tc-image.3dn.ru/forum/3-92-338-16-1330568964
'===========================================================================
  R = "_" ' добавление к имени, кроме счётчика - можно изменить (работает при 2-м параметре)
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ListFile = FSO.OpenTextFile(WScript.Arguments(0), 1)
Do While Not ListFile.AtEndOfStream
    SelFile = ListFile.ReadLine : rPath = FName(FName(SelFile)) & "\"
    If WScript.Arguments.Count > 1 Then rPath = FFNoExistCount(rPath & FSO.GetFileName(SelFile))
    On Error Resume Next
    If FSO.FileExists(SelFile) Then FSO.MoveFile SelFile, rPath
    If FSO.FolderExists(SelFile) Then FSO.MoveFolder Left(SelFile, Len(SelFile) - 1), rPath
Loop
CreateObject("WScript.Shell").Popup "Задача выполнена!", 1, "Перемещение вверх)", 64 ' можно закоментировать
ListFile.Close : Set ListFile = Nothing : Set FSO = Nothing : WScript.Quit
Function FName(pPath) : FName = FSO.GetParentFolderName(pPath) : End Function

' Функция проверки существует ли папка\файл
' если да, то возвращает новое полное имя с добавлением к имени счётчика
Function FFNoExistCount(FileOrFolder)
   With CreateObject("Scripting.FileSystemObject")
     ffPath = .GetParentFolderName(FileOrFolder) & "\"
     ffName = .GetBaseName(FileOrFolder)
     ffExt  = .GetExtensionName(FileOrFolder)
     exPath = FileOrFolder
     Do While (.FileExists(exPath) Or .FolderExists(exPath))
       ff = ff + 1
       exPath = ffPath & ffName & R & (ff Mod 100)\10 & (ff Mod 10) & "." & ffExt
     Loop
   End With
   FFNoExistCount = exPath
End Function

CreateNewTxtFileAdvanced.vbs - Создать текст файл и открыть

Metchnik — Fri, 05 May 2017 14:01:31 GMT

Создаёт пустой текстовый файл с именем выделенного файла/каталога и открывает его в AkelPad.

Доступно только для пользователей

Код

' CreateNewTxtFileAdvanced.vbs
'==============================================================================
' Создаёт пустой текстовый файл с именем выделенного файла/каталога и открывает его в AkelPad.
' Если такой файл существует - открывает его в AkelPad.
'
' По умолчанию файл создаётся в текущем каталоге.
' Параметры кнопки: "%P" %N 1
' Первые два параметра обязательны, необязательный третий задаёт режим:
'  1 - если выделен каталог, файл создаётся внутри него
'  2 - если выделен каталог, файл создаётся внутри него и имеет имя:
'      "родительский_каталог - выделенный_каталог"
'
'#######  Кнопка ########
'TOTALCMD#BAR#DATA
'%COMMANDER_PATH%\Utils\WSH\CreateNewTxtFileAdvanced.vbs
'"%P" %N 2
'%commander_path%\utils\akelpad\akelpad.exe
'Создание текстовых файлов
'
'
'-1
'
'########################
' Rodny (с)
' http://tc-image.3dn.ru/forum/3-810-5036-16-1360859396
' http://forum.ru-board.com/topic.cgi?forum=5&topic=33904&start=5900#8 [?]
'==============================================================================
Option Explicit

Dim WSH, FSO, Mode, Path, Name, FullPath, Filename, File, Editor
Dim MyArray, ParentDir

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

Mode = 0
' Путь к редактору
Editor = WSH.ExpandEnvironmentStrings("%COMMANDER_PATH%\Utils\AkelPad\AkelPad.exe")

If WScript.Arguments.Count = 0 Then
     MsgBox "Параметры кнопки не заданы!", vbOKOnly + vbExclamation, "Внимание!"
     WScript.Quit
ElseIf WScript.Arguments.Count = 3 Then
     Mode = WScript.Arguments(2)
End If

Path = WScript.Arguments(0)
Name = WScript.Arguments(1)
FullPath = Path & Name
MyArray = Split(FullPath, "\")
ParentDir = MyArray(UBound(MyArray) - 1)

If FSO.FileExists(FullPath) Then
     Filename = FSO.GetBaseName(FullPath)
     ElseIf (FSO.FolderExists(FullPath)) And (Mode = 2) Then
         Filename = ParentDir & " - " & Name
     ElseIf FSO.FolderExists(FullPath) Then
         Filename = Name
End If

' Раскомментируйте следующую строку, чтобы вручную вводить или менять имя файла
'Filename = InputBox("Введите имя нового файла без расширения", "Создание нового файла *.txt", Filename)
If Filename <> "" Then
     If Mode = 0 Then
         Filename = Filename & ".txt"
     Else
         Filename = Name & "\" & Filename & ".txt"
     End If
    If Not FSO.FileExists(Filename) Then
       Set File = FSO.OpenTextFile(Filename, 2, True)
       File.Close
   End If
   WSH.Run """" & Editor & """ " & Filename, 1, True
End If

Set FSO = Nothing
Set WSH = Nothing
Wscript.Quit

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

Andrey_A — Fri, 28 Apr 2017 08:00:48 GMT

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

Доступно только для пользователей

Code

' GroupChangeLNK.vbs
'================   Описание   =================
' Групповая замена свойств ярлыков.
'================  Параметры =================
' {файл-список ярлыков}|{папка с ярлыками}
'
' Примеры параметров при вызове из TC:
' %L
' "%P"
' модифицировал Аверин Андрей
' Автор:             Batya
' Версия:          1.1 (22.10.2009 - 19.07.2012)
' Site:                  http://tc-image.3dn.ru/forum/3-50-293-16-1330539285
'==========================================
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 = "" Or IsEmpty(FindStr) Then Quit 0
   ReplStr = InputBox(Mess(4), Mess(0))
   If ReplStr = "" Or IsEmpty(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 — Mon, 06 Feb 2017 05:25:36 GMT

ЗАКАЗ СКРИПТОВ

В этой теме Вы можете высказывать идеи о написании того или иного скрипта. Если Вы столкнулись с монотонной задачей, которую можно автоматизировать и не знаете как это сделать, Вы можете описать свою проблему здесь и возможно найдутся те, кто подскажет как её решить.
Большая просьба чётко описывать задачу, от этого будет зависеть качество её решений

Готовые решения будут открепляться в отдельные темы

[info]
Тема по большому счёту закрыта, т.к. я больше не пишу отдельных скриптов...
Большинство скриптов для Total Commander вошли в функционал в утилиты TCIMG

[/info]

Не работает скрипт-логон на администратора компьютера

sc0cs — Fri, 03 Feb 2017 14:07:11 GMT

Здравствуйте.
Сделал скрипт подключения дисков при входе в систему, он работает на обычных пользователей, но если пользователь является локальным администратором скрипт не срабатывает.
В чём может быть причина не пойму.
Кто сталкивался с такой проблемой подскажите куда копать.

Вызов внутренних команд программ с помощью скриптов.

Паразит — Fri, 02 Dec 2016 08:36:15 GMT

Привет. Возможно ли, с помощью AutoIt, VBScript, JScript вызывать функции и внутренние команды других программ?
В данном случае, меня интересует Total Commander.
Вот я хочу вызвать внутреннюю команду cm_SpreadSelection.
Как мне её возможно вызвать напрямую?
Без всяких кликов, SendKeys, вызовов меню и т.д.
Скажу сразу, что меня не интересует ActiveX компонент TCScript.Helper, так как он у меня не установлен, и я его не планирую устанавливать. Меня интересуют только AutoIt, VBScript, JScript, но в чистом виде.

По аналогии с TCIMG
tcimg=$cm521

Получение списка файлов в скрипте и изменение даты

Andrey_A — Thu, 01 Dec 2016 08:20:41 GMT

Форум: ТЕСТИРОВАНИЕ СКРИПТОВ для TC
Автор темы: Andrey_A
Автор последнего сообщения: Паразит
Количество ответов: 15

Работа с браузером Mozilla Firefox

turoc1 — Wed, 20 Jan 2016 15:56:56 GMT

Здарова . Люди возник такой вопрос как с помощью VBS скрипта сделать так чтоб окно браузера Mozilla Firefox открывалось определённого размера в определённом месте . У меня есть такой код но он работает с IE . Что здесь надо поменять ? ПОМОГИТЕ.
Вот код :

Код

Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Navigate("http://yandex.ru/") ' адрес видеорегистратора
   Do While objIE.Busy : Wscript.Sleep 700 : Loop

' расположение относительно экрана
  objIE.Top = 50
  objIE.Left = 50
  objIE.Height = 300
  objIE.Width  = 550
' убираем все лишнее с IE
objIE.AddressBar = False
  objIE.MenuBar = False
  objIE.ToolBar = False
objIE.StatusBar  = False
objIE.RegisterAsBrowser = True
  objIE.Visible = True

WScript.Quit 0

Присвоение переменной (VBS скрипт)

turoc1 — Tue, 19 Jan 2016 13:25:39 GMT

Здарова ВСЕМ.
Люди помогите незнающему . Есть скрипт который читает и выводит в окне последние 3 строки в TXT файле. Так как сделать так чтоб не выводить последние три строчки , а просто присвоить переменные отдельно например (в файле 5 строчек 1,2,3,4,5 нужно чтоб было так 1=a, 2=b, 3=c ну и так далее . Повторюсь знание VBS у меня =0. Поэтому если можно помогите.
Вот скрипт.

Код

Option Explicit

Dim strPath
Dim lngLines

Dim objFSO
Dim objTS

Dim i
Dim j

strPath = "d:\xdx\testreadfile.txt" ' Путь к текстовому файлу
lngLines = 3 ' Количество потребных последних строк

ReDim arrLines(lngLines - 1) ' Массив для организации очереди из считываемых строк

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set objTS = objFSO.OpenTextFile(strPath)

With objTS
i = 0

Do Until .AtEndOfStream
arrLines(i) = .ReadLine()

i = (i + 1) Mod lngLines
Loop

.Close
End With

Set objTS = Nothing
Set objFSO = Nothing

For j = 0 To lngLines - 1
WScript.Echo arrLines((i + j) Mod lngLines)
Next

WScript.Quit 0

AddOrDelButtonBars.vbs -добавление/удаление кнопки с панелей

Andrey_A — Fri, 25 Sep 2015 18:35:17 GMT

Добавление скопированной кнопки из буфера обмена в панели инструментов (.bar) в заданную позицию Total Commander
Используется TCIMG.exe - файл можете скачать в теме: утилита TCIMG
Используется скрипт FunctionsPlus.vbs - Скрипт-библитотека с различными Функциями, которые можно использовать в других скриптах

Доступно только для пользователей

Код

' AddOrDelButtonBars.vbs
'========================   Описание   =====================================
' Добавление скопированной кнопки из буфера обмена в панели инструментов (.bar) в заданную позицию Total Commander
' Удаление с панелей инструментов кнопку, находящуюся на определённой позиции
' (позиция, номер вводится в диалоге)
'=======================   Параметры  ======================================
' 0 - удалить кнопку
' 1 - добавить кнопку из буфера

' Автор:           Аверин Андрей
' Версия:          1.4 (08.03.2011 - 27.02.2013)
' Mail:            Averin-And@yandex.ru
' Site:            http://tc-image.3dn.ru/forum/9-812-5371-16-1361887507
'===========================================================================
Dim WSH : Set WSH = CreateObject("WScript.Shell")
If WScript.Arguments.Count > 0 Then : AU = WScript.Arguments(0) : vb = vbNewLine : Else : WSH.Popup "Не хватает параметров!", 1, "Ошибка", 64 : QuitW : End If : If AU <> 1 Then AU = -1
If AU = -1 Then
   Inf = "Введите номер (позицию) кнопки на главной панели, которую необходимо удалить из всех основных панелей"
   Title = "Удаление кнопки из основных панелей"
Else
   Inf = "- Введите номер (позицию) на главной панели, куда необходимо вставить кнопку из буфера обмена во все основные панели" & vb & "- Убедитесь, что необходимая для вставки кнопка скопирована в буфер обмена!"
   Title = "Вставка кнопки из буфера в основные панели"
End If
N = InputBox(Inf, Title, "10") : If Len(N) = 0 Or IsEmpty(N) Then QuitW
If AU = 1 Then
   P = "HKCU\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407"
   On Error Resume Next
   A = WSH.RegRead(P) : If A > 0 Then WSH.RegWrite P, 0, "REG_DWORD"
   Clip = CreateObject("htmlfile").ParentWindow.ClipboardData.GetData("text")
   If Len(Clip) = 0 Or InStr(Clip, vb) = 0 Then Quit
   aC = Split(ConvertBCA(Clip), vb)
End If
'=================   Изменяемые параметры   ================================
TCIMG = GetPath( "%COMMANDER_PATH%\TCIMG.exe") 'Утилита, вызывающая команды ТС
' файл с дополнительными функциями
FuncPlus = "%COMMANDER_PATH%\Scripts\Include\FunctionsPlus.vbs"
' путь к папке с барами
BarPath = GetPath("%COMMANDER_PATH%\Bar\")
' массив нужных имён баров
aB = Array("000_Osnovnaja.bar", "002_Multimedia.bar", "005_Record_Disks.bar","007_Creation_Video_TV.bar", "010_Grafica.bar", "012_Text.bar","029_Internet.bar", "015_Sistems.bar", "213_Sistems_Setting.bar", "035_Arhive_Passwords.bar", "173_Resources.bar", _
            "036_Utility_Tools.bar","212_Setting_TC.bar", "062_Registration.bar", "100_Additional_Tools.bar","041_Game.bar", "042_Others.bar", "039_User_Panel_01.bar", "040_User_Panel_02.bar", "037_Additional_Tools.bar")
'===========================================================================
' aB = Array("041_Game.bar")
N = CInt(N)
With CreateObject("Scripting.FileSystemObject")
   Execute .OpenTextFile(GetPath(FuncPlus)).ReadAll
   For k = 0 To Ubound(aB)
     T = "" : S = "" : G = "" : RZ = 0 : NM = "" : NBut = 0 : AU = CInt(AU)
     BP = BarPath & aB(k)
     On Error Resume Next
     If Not .FileExists(BP) Then : CreateObject("WScript.Shell").Popup "Не найден файл " & BP, 1, "Ошибка!", 64 : QuitW : End If
     T = .OpenTextFile(BP).ReadAll
     S = RegExpSearchInText(T, "(\[Buttonbar\]([\r\n]*.*)*)") : G = Replace(T, S, "") : BT = Split(S, vb) : NBut = CInt(RegExpReplace(BT(1), ".*=(\d+)", "$1", 1, 1, 1))
     If N > NBut Then N = NBut + 1
     U = Ubound(BT)
     If U > 4 Then
       For i = 2 To U
         If Len(BT(i)) > 0 Then
           Num = CInt(RegExpReplace(Left(BT(i), InStr(BT(i), "=") -1), "(\D+)([0-9]+)", "$2", 1, 1, 1))
           If AU = -1 And N = Num Then
             BT(i) = ""
           Else
             If AU = -1 And Num > N Then BT(i) = ExNum(BT(i), Num - 1)
             If AU = 1 And Num >= N Then : Num = Num + 1 : BT(i) = ExNum(BT(i), Num) : End If
             Num = String(5 - Len(Num), "0") & Num : BT(i) = Num & BT(i)
           End If
         End If
       Next
       If AU = 1 Then : For x = 0 To Ubound(aC) : Q = U + x + 1 : ReDim Preserve BT(Q) : BT(Q) = aC(x) : Next : End If
       BT(1) = "000001Buttoncount=" & NBut + AU : BT(0) = "000000" & BT(0)
       .CopyFile BP, BP & ".bak" ' закомментируйте если не нужен бэкап
       T = DelFirstEmptyLine(RegExpReplace(Join(SelectingArrUp(BT), vb), "([0-9_]+)(.*)", "$2", 1, 1, 1))
       .OpenTextFile(BP, 2).Write G & T
       WScript.Sleep 100
     End If
   Next
End With
WSH.Exec(TCIMG & " tcimg=$cm498 buttn=TBUTTONCHANGEDLG||TButton3")
Function GetPath(pPath) : GetPath = WSH.ExpandEnvironmentStrings(pPath) : End Function
Sub QuitW : If A > 0 Then WSH.RegWrite P, A, "REG_DWORD" End If : Set WSH = Nothing : WScript.Quit : End Sub
Sub Quit : MsgBox "В буфере обмена находятся некоректные данные" & vb & "Выделите кнопку на панели TC и повторите заново", 64, Titles : QuitW : End Sub
Function ConvertBCA(BN)
   If InStr(LCase(BN), "totalcmd#bar#data") <> 1 Then Quit
   B = Split(BN, vb) : M = String(5 - Len(N), "0") & N : ConvertBCA = M & "cmd" & N & "=" & B(1) & vb & M & "param" & N & "=" & B(2) & vb & M & "path" & N & "=" & B(5) & vb & M & "button" & N & "=" & B(3) & vb & M & "menu" & N & "=" & B(4) & vb & M & "iconic" & N & "=" & B(6) & vb & "8888888888"
End Function
Function ExNum(NM, RZ) : ExNum = RegExpReplace(NM, "(\D+)(\d+)(=.*)", "$1" & RZ & "$3", 1, 1, 1) : End Function