Total Commander

SVM
Пож-та. В шапке же написан список на выбор.
С подпапками позже, там какой-то косяк в Shell закрался.

Flasher
Total Commander 8.51a, WinXP x86 sp2 wscript.exe 5.6.0.8825
Пошагово,
1. Посчитал crc-суммы md5.
2. Переименовал файлы.
3. В активной панели, в папке с файлами нажал кнопку, переименование не произошло.
Пробовал в параметрах кнопки md5|sha1|sha256|sha512 и отдельно md5 - ничего не происходит.

SVM писал(а):WinXP

Вот блин, на удачу сделал, в расчёте, что окажется Win 7/8/10. Тогда придётся по-другому, с регистрацией компонента. Либо предлагаю установить Tool Pack. Тогда всё заработает.

SVM писал(а):Пробовал в параметрах кнопки md5|sha1|sha256|sha51

Зачем? Я же пишу, что список.

SVM
В общем, так. Качаем файл. Распаковываем в удобное место, пишем путь в шапке.

Код: Выделить всё

'==============================================================
' Переименовать файлы в структуре активного каталога,
' сопоставляя данные с вложенным в каждую директорию хэш-файлом

' Условие:  путь запуска - пустой
' Параметр: <md5|sha1|sha256>   - хэш-алгоритм на выбор

' Автор: Flasher ©
'============ Путь к папке с HashCryptStreams.dll =============
HPath = "%COMMANDER_PATH%\Scripts\Components\"
'==============================================================
Alg = UCase(WScript.Arguments(0))
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim WSH : Set WSH = CreateObject("WScript.Shell")
HPath = WSH.ExpandEnvironmentStrings(HPath)
If FSO.GetParentFolderName(WScript.FullName) & "\" <> HPath Then
  InPath = HPath & FSO.GetFileName(WScript.FullName)
  If Not FSO.FileExists(InPath) Then FSO.CopyFile WScript.FullName, HPath
  WSH.Run """" & InPath & """ """ & WScript.ScriptFullName & """ " & Alg
  WScript.Quit
End If : Ext = Alg : If Ext = "SHA1" Then Ext = "sha"
Set Hash = CreateObject("newObjects.crypt.HashObject")
Set Dict = CreateObject("Scripting.Dictionary")
Set ShA  = CreateObject("Shell.Application")
Hash.InitHash Alg : 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 Not Dict.Exists(Sum) Then Dict.Add Sum, Str(1)
      Loop Until .EOS : .Close
    End With
    For Each F in FSO.GetFolder(Path).Files
      If UCase(FSO.GetExtensionName(F)) <> Alg And F.Size > 0 Then
        With CreateObject("ADODB.Stream")
          .Open : .Type = 1 : .LoadFromFile F
          Do : Hash.HashUpdate .Read(1024)
          Loop Until .EOS : Hash.HashFinalize : .Close
        End With : Sum = LCase(Hash.Value) : Hash.Reset
        If Dict.Exists(Sum) Then
          N = Dict.Item(Sum) : If Not FSO.FileExists(Path & "\" & N) Then F.Name = N
        End If
      End If
    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

Flasher
Второй скрипт работает отлично! А можно похожий скрипт, но переименование по размеру в байтах? Одним скриптом создаётся в каждой папке/подпапках или выделенных папках Info.txt файл описаний, на каждой строчке имя файла;размер в байтах. Другим скриптом переименовываются файлы, если размер совпадает с размером в файле описания, в новые имена, которые есть в файле описания.

SVM
С созданием Info.txt сюда или сюда.

С переименованием достаточно пары-тройки несущественных правок в скрипте. Но я бы сразу сопоставлял по размеру и хэшу. Пойдём пока в те темы, решим как лучше.
Также можно допилить скрипт, чтобы он выполнял обе задачи (на выбор). И тогда можно будет продолжить решать это здесь.

Flasher
1-ый скрипт
В параметрах %WL "%P" 1 0 0 0 0 3 mp4,wmv - кнопка не срабатывает.
В параметрах %WL "%P" 1 1 1 0 0 3 mp4,wmv - кнопка срабатывает, но сохраняет в файл дату и время.
2-ой скрипт сохраняет в килобайтах. И оба скрипта не работают с подпапками. Если в папке находятся 5 - 10 файлов размером до 4 гигабайт, вероятность что у них совпадёт размер в байтах минимальна, поэтому быстрей переименовать по размеру.

SVM
Мы тут будет обсуждать функционал других скриптов, у которых есть свои ветки? Под "сюда" должно пониматься обсуждение в должном месте, ибо тут оффтоп.
И см. последние предложения.

SVM писал(а):поэтому быстрей переименовать по размеру

А может, тогда лимит на размер установить, где проверять хэш?

Flasher
Понял, задал вопрос в теме скрипта. Меня устроят оба варианта, так что лучше тот вариант какой для вас проще.

Flasher писал(а):А может, тогда лимит на размер установить, где проверять хэш?

Иногда нужно проверить и большие файлы по md5

SVM писал(а):Меня устроят оба варианта, так что лучше тот вариант какой для вас проще.

Мне без разницы. Польза объединения в том, что каркас кода с процедурой рекурсии уже есть, нужно будет только разделить действия по условию.
Собственно, так и сделал:

Код: Выделить всё

'============================================================
' В структуре активного каталога:
' 1) создать -
' 2) переименовать файлы, сопоставляя данные с находящимся -
'  - в каждой директории Info.txt, где на каждой строке
'    <имя файла>;<размер в байтах>

' Условие: путь запуска - пустой
' Параметр для второго задания: 1

' Автор: Flasher ©
'============================================================
Set Dict = CreateObject("Scripting.Dictionary")
Dim WSH : Set WSH = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
If WScript.Arguments.Count Then T = WScript.Arguments(0)
ForFolder WSH.CurrentDirectory : WSH.Popup " Готово!",1.5,,64

Sub ForFolder(Path)
  Set Folder = FSO.GetFolder(Path)
  If FSO.FileExists(Path & "\Info.txt") Then Ex = T + 1
  If Ex = 2 Then
    Set List = FSO.OpenTextFile(Path & "\Info.txt",,,-1)
    Do : F = Trim(List.ReadLine)
      If Len(F) > 2 Then
        Str = Split(F, ";") : Size = Str(1)
        If Not Dict.Exists(Size) Then Dict.Add Size, Str(0)
      End If
    Loop Until List.AtEndOfStream
  End if
  For Each F in Folder.Files
    If F.Name <> "Info.txt" Then
      Size = CStr(F.Size)
      If Ex = 2 Then
        If Dict.Exists(Size) Then
          N = Dict.Item(Size)
          If Not FSO.FileExists(Path & "" & N) Then F.Name = N
        End If
      Else S = S & vbNewLine & F.Name & ";" & Size
      End If
    End If
  Next : If S <> "" Then FSO.OpenTextFile(Path &_
  "\Info.txt",2,True,-1).Write Mid(S, 3) Else Dict.RemoveAll
  For Each Fold in Folder.SubFolders : ForFolder Fold : Next
End Sub

P.S.: И нужно, конечно, понимать, что если в какой-то папке есть дубликаты, то жертвой может оказаться отнюдь не тот из них, что подлежит переименованию.

К слову о дубликатах, позволю себе замечание с места: md5 коллизии.
sha1 будет побезопаснее.

Skif_off
Этот скрипт не про md5. А этот не только. И я бы вообще брал по максимуму - sha512, Sapphire (его, правда, rhash не понимает) или Whirlpool/1, если что.

Flasher
А нельзя ли добавить в скрипт фильтр-список расширений файлов?

[cut="Можно:"]

Код: Выделить всё

'====================================================================================
' В структуре активного каталога:
' 1) создать -
' 2) переименовать файлы, сопоставляя данные с находящимся -
'  - в каждой директории Info.txt, где на каждой строке <имя файла>:<размер в байтах>

' Условие: путь запуска - пустой
' Параметры (необязательные): <фильтр-список расширений> <флаг для второго задания:1>
' Примеры: *.avi;*.mpg;*.mkv | "" 1

' Автор: Flasher ©
'====================================================================================
Set ShA = CreateObject("Shell.Application")
Set Dict = CreateObject("Scripting.Dictionary")
Dim WSH : Set WSH = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
With WScript.Arguments
  If .Count Then Filt = .Item(0) Else Filt = "*.*"
  If .Count = 2 Then T = .Item(1)
End With : ForFolder WSH.CurrentDirectory
If T = 1 Then Title = " Восстановление имён файлов по" : N = 14 Else Title = " Создание"
WSH.Popup Space(N) & "Выполнено!", 2, Title & " Info.txt", 64

Sub ForFolder(Path)
  If Len(Path) < 251 Then
  Set Items = ShA.NameSpace(Path).Items
  If FSO.FileExists(Path & "\Info.txt") Then Ex = T + 1
  If Ex = 2 Then
    Set List = FSO.OpenTextFile(Path & "\Info.txt",,,-2)
    Do : F = Trim(List.ReadLine)
      If Len(F) > 2 Then
        Str = Split(F, ":") : Size = Str(1)
        If Not Dict.Exists(Size) Then Dict.Add Size, Str(0)
      End If
    Loop Until List.AtEndOfStream
  End If : Items.Filter 192, Filt
  For Each F in Items
    If F <> "Info.txt" And Len(Path & F) < 259 Then
      Size = CStr(FSO.GetFile(F.Path).Size)
      If Ex = 2 Then
        If Dict.Exists(Size) Then
          N = Dict.Item(Size) : If Not FSO.FileExists(Path & "\" & N) Then F.Name = N
        End If
      Else S = S & vbNewLine & F.Name & ":" & Size
      End If
    End If
  Next : If S <> "" Then FSO.OpenTextFile(Path & "\Info.txt", 2, True, -1).Write Mid(S, 3) Else Dict.RemoveAll
  Items.Filter 160, "*" : For Each Fold in Items : ForFolder Fold.Path : Next
  End If
End Sub

[/cut]Только лучше бы сразу писать об этом...

Flasher
Ни в какой скрипт пальцем не тыкал

Упомянул о вероятности недоразумении и только.
Про максимумы: как-то интересовался, говорят, самый быстрый BLAKE2, а вот sha512 оптимизирован под х64. Сам обычно пользуюсь sha1 - ходовой вариант, с остальными пока не разбирался.

Total Commander

Групповое переименование