Batya
|
 Posted: Thu Jun 11, 2009 15:21 Post subject: |
 |
|
Neo233
vbs-скрипт:
| Code: | '=======================================================================================
' Удаление из указанной папки файлов-дубликатов, кроме самого раннего по времени.
' Дубликатами считаются файлы, у которых совпадает CRC32.
' Параметр скрипта - обрабатываемая папка
' Для работы скрипта необходимо зарегистрировать в системе компонент DynamicWrapperX
'=======================================================================================
Option Explicit
Dim WRP, FSO, WSH, Mess, Folder, FCrc
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
Set WRP = CreateObject("DynamicWrapperX")
WRP.Register "ImageHlp.DLL", "MapFileAndCheckSum", "i=sUU", "r=u"
MessDefine
CheckParams
Set FCrc = CreateObject("Scripting.Dictionary")
Main Folder
MsgBox Mess(3), vbInformation + vbOKOnly, Mess(0)
Quit
'===== Процедуры и функции ===============================================================
Sub Main(pFolder)
Dim FF, F, FC, Crc
Set FF = FSO.GetFolder(pFolder)
For Each F In FF.SubFolders
Main(F)
Next
For Each F In FF.Files
Crc = GetCrc(F.Path)
If FCrc.Exists(Crc) Then
Set FC = FSO.GetFile(FCrc(Crc))
If F.DateLastModified < FC.DateLastModified Then
FCrc(Crc) = F.Path
DoProc FC.Path
Else
DoProc F.Path
End If
Else
FCrc.Add Crc, F
End If
Next
End Sub
'Проверка входных параметров
Sub CheckParams
With WScript
If .Arguments.Count = 0 Then
MsgBox Mess(1), vbCritical + vbOKOnly, Mess(0)
Quit
End If
Folder = GetPath(.Arguments(0))
If Not FSO.FolderExists(Folder) Then
MsgBox Mess(2), vbCritical + vbOKOnly, Mess(0)
Quit
End If
End With
End Sub
'Основное действие над файлами
Sub DoProc(pPath)
FSO.DeleteFile pPath
End Sub
'Подсчет контрольной суммы файла
Function GetCrc(pPath)
Dim lRess, lsHeader, lsCalcd
lsHeader = 0: lsCalcd = 0
lRess = WRP.MapFileAndCheckSum(pPath, lsHeader, lsCalcd)
GetCrc = lsCalcd
End Function
'Путь
Function GetPath(pPath)
GetPath = FSO.GetAbsolutePathName(WSH.ExpandEnvironmentStrings(pPath))
End Function
'Описание сообщений
Sub MessDefine
Set Mess = CreateObject("Scripting.Dictionary")
With Mess
.Add 0, "Удаление старых файлов-дубликатов"
.Add 1, "Не указаны параметры!"
.Add 2, "Указанная папка не существует!"
.Add 3, "Операция завершена."
End With
End Sub
'Выход
Sub Quit
Set Mess = Nothing
Set FCrc = Nothing
Set WRP = Nothing
Set WSH = Nothing
Set FSO = Nothing
WScript.Quit
End Sub |
Для работы скрипта необходим DynamicWrapperX.
Кроме того, хотелось бы узнать следующее - Уникальность crc32 для файлов.
_________________
Нет, я не сплю. Я просто медленно моргаю.
Last edited by Batya on Tue Jun 23, 2009 10:54; edited 2 times in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
