Batya
|
 Posted: Tue Jun 23, 2009 11:04 Post subject: |
 |
|
Реализована проверка идентичности по md5:
| Code: | '=====================================================================================
' Удаление из указанной папки файлов-дубликатов, кроме самого раннего по времени.
' Дубликатами считаются файлы, у которых совпадает MD5.
' Параметр скрипта - обрабатываемая папка
' Для работы скрипта необходимо зарегистрировать в системе компонент XStandard.Buffer
'=====================================================================================
Option Explicit
Dim XSB, FSO, WSH, Mess, Folder, FCrc
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
Set XSB = CreateObject("XStandard.Buffer")
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)
XSB.Load pPath
GetCrc = XSB.MD5
XSB.Reset
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 XSB = Nothing
Set WSH = Nothing
Set FSO = Nothing
WScript.Quit
End Sub |
Для работы скрипта необходим XStandard.Buffer. Скачать компонент можно здесь (ссылка для скачивания высылается на e-mail). Дистрибутив (архив) имеет размер чуть более 35 Кб.
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
