Выделение дубликатов

[Ник]

Может народ какой напишет плагин файловый - только для выявления, просмотра и удаления дубликатов - раз Гислер так упёрся?
Глядишь - тогда и он задумается?

[Victor_Dobrov]

Автозапуск поиска дубликатов по содержимому без учёта имён, и выделение одинаковых имён в группах по завершении поиска.

Подключение: перетащите скрипт на панель инструментов или добавьте в меню запуск команду: cmd=%COMMANDER_PATH%\Scripts\MarkСongener.vbs. Параметры не требуются.

Плюсы этого скрипта: запуск/закрытие окна поиска, показ и выделение дубликатов происходит без участия пользователя, достаточно только запустить скрипт. За основу был взят скрипт от Volniy

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

' MarkСongener.vbs. © Victor Dobrov
' Поиск дубликатов по содержимому без учёта имён файлов, и выделение в результатах поиска файлов с одинаковыми именами.

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

(!) Для правильной работы скрипта при английском и русских языках ввода необходимо сменить горячую клавишу кнопки 'Файлы на панель' с буквы 'Л' на цифру '0'. Замените в файле 'Wcmd_rus.lng' строку '5664="Фай&лы на панель"' на '5664="&0ткрыть файлы в панели"'.
Ещё желательно дополнить 38-ю строку файла Wcmd_rus.lng. Новый текст: 38="Ничего не найдено,\r\rЧтобы закрыть поиск,\t\rдважды нажмите 'Esc'"

P.S. скрипт делал для своей сборки Total Commander 7.04 ExpertPack

[hawk777]

Ну ладно, тогда можно переписать вот так:

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

'=====================[ Start of file ]========================= 

'  File:         SelNotFirst.vbs 
'  Description:  Удаляет все парные файлы кроме первого
'                из списка, созданного поиском дубликатов в ТС 
'  Installation: Создайте кнопку на панели TC 
'                Команда: "диск:\путь\к\файлу\SelNotFirst.vbs" 
'                Параметры: "%L"
'  Copyright:    (c) 2006, Volniy 

Option Explicit
Dim FSO, ListFile, SelFile,TCS
Dim File1, File2, Cnt, Buf
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TCS = CreateObject("TCScript.Helper")
Set ListFile = FSO.OpenTextFile(WScript.Arguments(0), 1)
Do While Not ListFile.AtEndOfStream
  SelFile = ListFile.ReadLine
  File2 = FSO.GetFileName(SelFile)
  If StrComp(File1, File2, 1) = 0 Then
     Buf = Buf & SelFile & vbNewLine
     Cnt = Cnt + 1
  End If
  File1 = File2
Loop
ListFile.Close
'TCS.ClearClip
TCS.SetTextToClip CStr(Buf)
TCS.SendCommand "cm_LoadSelectionFromClip", True
Set ListFile = Nothing
Set FSO = Nothing
Set TCS = Nothing
MsgBox "Выделено дубликатов: " & Cnt, vbInformation, "Завершено!"
WScript.Quit

'=====================[  End of file  ]=========================

пишет ошибку. помогите пожалуйста

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

---------------------------
Windows Script Host
---------------------------
Сценарий:	C:\Program Files\Total Commander\Utils\WHS\SelNotFirst.vbs
Строка:	15
Символ:	1
Ошибка:	Невозможно создание объекта контейнером ActiveX: 'TCScript.Helper'
Код:	800A01AD
Источник: 	Ошибка выполнения Microsoft VBScript

---------------------------
ОК   
---------------------------

[mod="CaptainFlint"]Оверквотинг удалён.[/mod]

[sa]

пишет ошибку

Похоже, что надо (пере)установить TCWSHelp.

[hawk777]

sa
Установил, теперь пишет

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

---------------------------
Windows Script Host
---------------------------
Сценарий:	C:\Program Files\Total Commander\Utils\WHS\SelNotFirst.vbs
Строка:	15
Символ:	1
Ошибка:	Системе не удается найти указанный путь. 
Код:	80070003
Источник: 	(null)

---------------------------
ОК   
---------------------------

[Batya]

hawk777

Параметры: "%L"

[sa]

Установил, теперь пишет

Складывается впечатление, что каталог, где устанавливался TCScript.Helper, потом был переименован, ну или что-то в этом роде...
Можно попробовать дерегистрировать его

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

Для дерегистрации и удаления:
 запустите TCWSHelp.exe со следующей командной строкой
 TCWSHelp.exe  /UNREGSERVER

и установить заново.
Кстати, лучше взять самую свежую версию.

[hawk777]

Batya
параметры прописал с самого начала.
sa
скачал и запустил обновленную версию TCScript.Helper по Вашей ссылке.
теперь пишет

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

---------------------------
Завершено!
---------------------------
Выделено дубликатов: 
---------------------------
ОК   
---------------------------

и ничего не выделяется

[sa]

и ничего не выделяется

Файлы на панели с результатами поиска дубликатов должны быть выделены перед запуском скрипта.

[hawk777]

sa
Вот спасибо. работает

[hawk777]

Volniy а по каким критериям выделяются дубликаты? Сделал поиск по размеру и содержимому файлов. Нашел около 2600 дубликатов (названия разные), но Ваш скрипт выделяет только 19. В чем может быть причина?

[Volniy]

А о каком скрипте речь-то? Если о SelNotFirst.vbs, который тут в теме, то он не для твоего поиска предназначен. Этот был для поиска дубликатов по именам. Где-то тут еще есть SelNotFirstFileSize.vbs, так вот он уже для дубликатов по размеру. Если при поиске включена была еще и опция по содержимому, то возможны, в принципе, ситуации, когда будут идти подряд группы файлов с одним размером, но с разным содержимым. Тогда тоже не все дубликаты будут выделены. Писать скрипт, проверяющий содержимое файлов (например их CRC32) - не разумно, тем более что такие накладочки на практике скорее всего будут весьма редки.

А вообще на форуме есть и другие, не мои, скрипты для этих дел.

ЗЫ Нашел-таки я тот скрипт: http://forum.wincmd.ru/viewpost.php?p=27231 Там оказывается уже был мой комментарий по поводу поиска дубликатов по содержимому.

[HEXFIX]

А можно сделать выделение с шагом без использования PowerPro?

[Вахмурка]

А это разве не то?

[HEXFIX]

Может я чё-то не так понял... Этот скрипт выделяет дубликаты, так? А я бы хотел, чтобы производилось выделение с заданным шагом (необязательно дубликаты).