Victor_Dobrov
Advanced Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
' MarkСongener.vbs. © Victor Dobrov
' Поиск дубликатов по содержимому без учёта имён файлов, и выделение в результатах поиска файлов с одинаковыми именами.
'(!) Для правильной работы скрипта при английском и русских языках ввода необходимо сменить горячую клавишу кнопки 'Файлы на панель' с буквы 'Л' на цифру '0'. Замените в файле 'Wcmd_rus.lng' строку '5664="Фай&лы на панель"' на '5664="&0ткрыть файлы в панели"'
Option Explicit
Dim WshShell, FSO, TCS, File1, File2, OldSel, Alikes, Buf, Cnt, i
Set WshShell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TCS = CreateObject("TCSCRIPT.Helper")
TCS.Wait = True
TCS.ClearClip
CopyFullNamesToClip(True)
If Len(TCS.GetTextFromClip) = 0 Then WScript.Quit 'нет выбранных объектов
OldSel = Crc(TCS.GetTextFromClip)
TCS.SendCommand "cm_SearchFor"
TCS.SendKeystroke "+{DEL}{DEL}" 'очистка строки поиска и (если скрипт запущен горячей клавишей) блокировка ещё нажатых клавиш
TCS.SendKeystroke "^{TAB}{TAB}{UP}бмд%+" 'горячие клавиши, заданные в файле Wcmd_rus.lng
TCS.SendKeystroke "бмд%+" 'повторное нажатие на случай, если язык ввода не был русским
TCS.SendKeystroke "{ENTER}" 'и запуск Поиска дубликатов
Do While WshShell.AppActivate("Поиск файлов") 'если поиск завершён или прерван
TCS.SendKeystroke "%0" 'попытка открыть результаты в текущей панели
If not WshShell.AppActivate("Поиск файлов") Then Exit Do Else WScript.Sleep 1500 'период опроса окна TC
Loop
CopyFullNamesToClip(True)
If OldSel = Crc(TCS.GetTextFromClip) Then WScript.Quit
Cnt = 0
Alikes = Split(TCS.GetTextFromClip, VbCrLf)
For i = 0 To Ubound(Alikes)
File2 = FSO.GetFileName(Alikes(i))
If StrComp(File1, File2, 1) = 0 Then
Buf = Buf & Alikes(i) & vbNewLine
Cnt = Cnt + 1
End If
File1 = File2
Next
TCS.SetTextToClip CStr(Buf)
TCS.SendCommand "cm_LoadSelectionFromClip", True
CreateObject("Internet.HHCtrl").TextPopup "Найдено дубликатов файлов:" & vbTab & i & VbCr & "Выбрано совпадающих имён:" & vbTab & Cnt & VbCr & VbCr & "Помечены дубликаты, имеющие одинаковые имена," & VbCr & "начиная со второго в группе (разделены пунктиром)" & VbCr & VbCr & "Внимание: при выделении не учитывались группы" & VbCr & "файлов, идентичных по содержанию, но имеющих" & VbCr & "разные имена. В списке такие файлы не отмечены.", "Arial,10",8,3,1,1
WshShell.AppActivate("Total Commander")
WScript.Sleep 25000
Function Crc(Text) 'чтобы различать два разных текста равной длины
For i = 1 To Len(Text)
Crc = Crc + Asc(Mid(Text, i, 1))
Next
End Function
Sub CopyFullNamesToClip(Clear)
TCS.LockTC True
TCS.SendCommand "cm_SelectAll"
TCS.SendCommand "cm_CopyFullNamesToClip", True
If Clear Then TCS.SendCommand "cm_ClearAll"
TCS.LockTC False
End Sub
|
