Total Commander

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

' 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

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

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

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

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

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

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

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

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

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

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