Single Post - Групповое переименование

Вот новый:

Code:

'======================================================================
' Восстановить имена файлов в структуре активного каталога, сопоставляя
' данные с вложенным в каждую директорию хэш-файлом (по умолчанию md5)
' Ссылка на утилиту: http://www.fastpictureviewer.com/bin/hashfile.zip

' Условие: путь запуска - пустой
' Параметры: <фильтр-список расширений> <-sha1|-sha256>
' Примеры: *.* | *.txt;*.lst -sha1

' Автор: Flasher ©
'======================= Путь к утилите hashfile ======================
HPath = """%COMMANDER_PATH%\Utils\hashfile\hashfile.exe"""
'======================================================================
With WScript.Arguments
Filt = .Item(0) : If .Count = 2 Then Alg = " " & .Item(1)
End With : Dim WSH : Set WSH = CreateObject("WScript.Shell")
If InStrRev(WScript.FullName, "WScript.exe") Then
WSH.Run "CScript.exe """ & WScript.ScriptFullName & """ " & Filt & Alg, 0
WScript.Quit
End If : Set ShA = CreateObject("Shell.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Dict = CreateObject("Scripting.Dictionary")
Ext = Mid(Alg, 3) : If Ext = "sha1" Then Ext = "sha"
T = 1 : If Alg = "" Then Ext = "md5"
ForFolder WSH.CurrentDirectory
WSH.Popup Space(10) & "Готово!", 1.5, " Восстановление имён по " & Alg, 64

Sub ForFolder(Path)
Set Items = ShA.NameSpace(Path).Items
Items.Filter 192, "*." & Ext
If Items.Count = 1 Then
FP = Items.Item(0).Path
With CreateObject("ADODB.Stream")
.Open : .LoadFromFile FP : .Type = 1
For i = 2 To 4
.Position = 0 : .Read(i) : Str = Str & Hex(AscB(.Read(2)))
Next : Enc = "windows-1251" : If Str = "EFBBBF" Then Enc = "UTF-8"
.Close : .Type = 2 : .Open : .CharSet = Enc : .LoadFromFile FP
Do : F = .ReadText(-2) : Str = Split(F, " *")
Sum = Str(0) : If Filt <> "*.*" Then T = 0
If T = 0 And InStr(LCase(Filt), LCase(FSO.GetExtensionName(Str(1)))) Then T = 1
If T And Not Dict.Exists(Sum) Then Dict.Add Sum, Str(1) : c = c + 1
Loop Until .EOS : .Close
End With : Items.Filter 192, Filt
For Each F in Items
If LCase(FSO.GetExtensionName(F)) <> Ext And Abs(F.Size) > 0 Then
Sum = Split(WSH.Exec(HPath & Alg & " """ & F.Path & """").StdOut.ReadLine, ": ")(1)
Sum = Left(Sum, Len(Sum) - 1)
If Dict.Exists(Sum) Then
s = s + 1 : N = Dict.Item(Sum) : If Not FSO.FileExists(Path & "\" & N) Then F.Name = N
End If
End If : If s = c Then Exit For
Next : Dict.RemoveAll
End If : Items.Filter 160, "*"
If Items.Count Then
For Each Fold in Items : ForFolder Fold.Path : Next
End If
End Sub