'••••••••••••••••••••••••••••••••• VBS •••••••••••••••••••••••••••••••••
' Переименовать файлы активной панели по текстовому списку соответствий,
' где между старым и новым именем стоит один запрещённый в именах символ
'
' Условия: путь запуска пользоват. команды/кнопки должен быть пустым;
' список соответствий должен быть сохранён в кодировке UTF-8
'
' Параметры: "<Путь к файлу-списку>" <обработка структуры (нет/да): 0/1>
'•••••••••••••••••••••••••••••••••••••••••••••••••• Автор: Flasher © •••
Option Explicit : Dim A, Key, FSO, Con, RcS, _
WSS, FL, DB, Delim, Val, Var, Exs, Ext, T, C, i
Const Title = " Переименование файлов по базе соответствий "
Set A = WSH.Arguments : If A.Count < 2 Then _
MsgBox Space(15) & "Укажите 2 параметра!", 48, Title : WSH.Quit
Key = "HKLM\SOFTWARE\Microsoft\Jet\4.0\Engines\Text\Format"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set RcS = CreateObject("ADODB.Recordset")
Set WSS = CreateObject("WScript.Shell")
DB = WSS.ExpandEnvironmentStrings(A(0))
If Not FSO.FileExists(DB) Then MsgBox "Файл-список отсутствует" &_
" по заданному пути:" & vbCr & A(0), 4144, Title : WScript.Quit
FL = FSO.OpenTextFile(DB).ReadLine
With New Regexp
.Pattern = "[""/*\\\t:|<>?]"
If .Test(FL) Then
Delim = .Execute(FL).Item(0).Value : If Delim = vbTab Then _
Delim = "TabDelimited" Else Delim = "Delimited(" & Delim & ")"
Else MsgBox "На первой строке списка отсутствует" &_
" запрещённый символ!", 4144, Title: WSH.Quit: End If
End With : Val = WSS.RegRead(Key)
If Val <> Delim Then T = 1 : WSS.RegWrite Key, Delim, "REG_SZ"
Exs = FSO.GetParentFolderName(Key) & "\DisabledExtensions"
Ext = FSO.GetExtensionName(DB) : Var = WSS.RegRead(Exs)
If InStrRev(Var & ",", Ext & ",") = 0 Then _
C = 1 : WSS.RegWrite Exs, Var & "," & Ext, "REG_SZ"
RcS.Open "SELECT * FROM " & FSO.GetFileName(DB), "Provider=Microsoft.Jet." &_
"OLEDB.4.0;Data Source='" & FSO.GetParentFolderName(DB) &_
"';Extended Properties='text;CharacterSet=65001;HDR=No'"
FFolder FSO.GetFolder(FSO.GetAbsolutePathName(""))
RcS.Close : If i <> "" Then _
WSS.Popup Space(17) & "Файлы переименованы!", 2, Title, 4160 Else _
WSS.Popup " Файлы не соответствуют списку!", 2, Title, 4144
If T Then WSS.RegWrite Key, Val, "REG_SZ"
If C Then WSS.RegWrite Exs, Var, "REG_SZ"
Sub FFolder(Folder)
Dim F, N, BN, P
For Each F in Folder.Files
RcS.Filter = "[" & RcS.Fields(0).Name & "] = '" & F.Name & "'"
If Not RcS.BOF Then
N = Trim(RcS.Fields(1).Value)
If N <> "" Then
BN = FSO.GetBaseName(N) : Ext = FSO.GetExtensionName(N)
i = 0 : P = Folder & "\" : If Ext <> "" Then Ext = "." & Ext
While FSO.FileExists(P & N) Or FSO.FolderExists(P & N)
i = i + 1 : N = BN & " (" & i & ")" & Ext
Wend : F.Name = N
End If
End If
Next : If A(1) = 1 Then _
For Each F in Folder.SubFolders : FFolder F : Next
End Sub |
