автоматическое удаление файлов по датам создания

Volniy · Сообщение **Volniy** » Ср июн 10, 2009 21:30

Параметр кнопки %L нужно написать в кавычках, "%L", именно так, как в шапке скрипта.

Neo233 · Сообщение **Neo233** » Ср июн 10, 2009 21:37

Volniy писал(а):Параметр кнопки %L нужно написать в кавычках, "%L", именно так, как в шапке скрипта.

Применил. Всё равно выскакивает вышеупомянутое окно с сообщением об ошибке. Текст сообщения тот же что и раньше..

Volniy · Сообщение **Volniy** » Чт июн 11, 2009 00:16

Странные дела... А что именно у тебя находится в 15-ой строке vbs-файла?
Кроме того, может стоит попробовать установить последнюю версию WSH?

Batya · Сообщение **Batya** » Чт июн 11, 2009 15:21

Neo233
vbs-скрипт:

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

'=======================================================================================
' Удаление из указанной папки файлов-дубликатов, кроме самого раннего по времени.
'   Дубликатами считаются файлы, у которых совпадает 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 для файлов.

Neo233 · Сообщение **Neo233** » Чт июн 11, 2009 17:38

Volniy писал(а):А что именно у тебя находится в 15-ой строке vbs-файла?

Текст скрипта взял, который вы мне и посоветовали на первой странице дискуссии:

Volniy писал(а):Вахмурка, ты немного не туда указал. Надо бы вот сюда.

Можете глянуть на 15-ю строку.. Я не знаю, как ведётся нумерация строк и с какой позиции..

Volniy писал(а):может стоит попробовать установить последнюю версию WSH?

Не ставится..

"Эта копия системы Windows не прошла проверку подлинности.
Установленный на компьютере ключ многократной установки заблокирован."
Нашёл поиском и скачал отсюда http://www.freesoft.ru/?id=79897 файл Wsh.dll размером 15520 Байт с такими данными (F3 в ТС показало):

Version language : Английский (США)
CompanyName : Microsoft Corp
FileDescription : OC Setup for WSH
FileVersion : 5.0.1104
InternalName : WSHOC
LegalCopyright : Copyright © 1996-1997 by Microsoft Corp.
OriginalFilename: WSH.dll
ProductName : Component Setup for Microsoft Windows Scripting Host
ProductVersion : 5.0.1104
Creation Date : 11/06/2009 17:16:39
Last Modif. Date: 23/01/2004 03:58:14
Last Access Date: 11/06/2009 00:00:00
FileSize : 15520 bytes ( 15.156 KB, 0.015 MB )
FileVersionInfoSize : 1660 bytes
File type : Dynamic Link Library (0x2)
Target OS : Win32 API (Windows NT) (0x40004)
File/Product version : 5.0.1104.1 / 5.0.1104.1
Language : Английский (США) (0x409)
Character Set : 1200 (ANSI - Unicode (BMP of ISO 10646)) (0x4B0)

Это то, что нужно? Поместил WSH.DLL в C:\Windows\.. директорию. Снова попробовал.. Снова то же самое.. Те же ошибки выскакивают

Batya писал(а):Кроме того, хотелось бы узнать следующее - Уникальность crc32 для файлов

Если ТС находил одинаковые файлы, то они ВСЕГДА были одинаковыми. Я раньше всегда просматривал их вручную перед удалением, затем перестал.

Batya писал(а):Для работы скрипта необходим DynamicWrapperX.

Скачал, поместил в С:\Windows\ Пробовал и с предыдущим скриптом, и с тем, что вы написали в сообщении в 14:21.
С последним скриптом выскакивает ошибка:

Windows Script Host

Сценарий: H:\TC_WS_Help\111.vbs
Строка: 13
Символ: 1
Ошибка: Невозможно создание объекта контейнером ActiveX: `DynamicWrapperX`
Код: 800A01AD
Источник: Ошибка выполнения Microsoft VBScript
[ OK ]

Что ещё может быть?

Volniy · Сообщение **Volniy** » Чт июн 11, 2009 18:44

Neo233 писал(а):Не ставится..

http://download.microsoft.com/download/ ... 86-rus.exe

И оставь в покое WSH.dll

BTW В vbs скриптах нумерация ведется с начала (а как еще?). Просто я точно не знаю что именно ты скопировал в этот файл, а что нет. Неужто трудно было посчитать до 15-ти?

Neo233 · Сообщение **Neo233** » Чт июн 11, 2009 20:43

Ура!

Заработала кнопка , наконец! Скачал, установил WindowsXP-Windows2000-Script56-KB917344-x86-rus.exe Перерегистрировал DynamicWrapperX (теперь без ошибок). И сделал новую кнопку. Вписал в параметр путь к папке. Выходит, из-за WSH не работало...
Batya, Volniy, Вахмурка, Tol!k большущее спасибо за скрипт и за разъяснения!

Volniy писал(а):В vbs скриптах нумерация ведется с начала (а как еще?). Просто я точно не знаю что именно ты скопировал в этот файл, а что нет. Неужто трудно было посчитать до 15-ти?

Я имел в виду: может нумерация ведётся начиная с исполняемой части кода, а не со строк комментариев. И к тому же слышал что иногда нумеровка начинается с 0, а не с 1.. Поэтому пальцем в небо не стал тыкать, а честно написал что не знаю

Batya, к вам просьба..
Можете изменить скрипт, чтобы оставался ПЕРВЫЙ из одинаковых в группе файлов? Я это с самого начала ветки написал. Web-камера иногда зависает (по независящим от меня причинам) и выдаёт в Сеть одну и ту же картинку, не обновляясь. При этом из группы одинаковых имеет смысл оставлять только первую картинку. С самой РАННЕЙ датой и временем создания. (нужна информация о том, что происходило в поле зрения Web-камеры). А выходит , что остаётся только последняя. ( Удаляются файлы с первого по предпоследний). Так же выделяет и DupSelector. Только не удаляет.
Попробовал переписать 57-ю строку скрипта

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

  FSO.DeleteFile pPath

на другие варианты, но тогда ничего вообще не работает

где бы почитать про команды скриптов?

Batya · Сообщение **Batya** » Чт июн 11, 2009 23:31

Neo233 писал(а):Batya, к вам просьба..
... оставлять только первую картинку. С самой РАННЕЙ датой и временем создания.

Исправил скрипт. Конкретно нужно поменять в строке

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

If F.DateLastModified > FC.DateLastModified Then

символ "больше" на "меньше":

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

If F.DateLastModified < FC.DateLastModified Then

Neo233 писал(а):Если ТС находил одинаковые файлы, то они ВСЕГДА были одинаковыми.

Вопрос не в том, одинаковы ли crc32 для идентичных файлов, а могут ли совпадать crc32 для разных файлов.
После выходных переделаю скрипт на сравнение не по crc32, а по md5.

Neo233 · Сообщение **Neo233** » Пт июн 12, 2009 11:55

Batya спасиибооо!!!!

Цены вам нет! Эх, как жить-то хорошо стало!!!

И всем, откликнувшимся ещё раз огромный РЕСПЕКТ!!

Batya писал(а):Вопрос не в том, одинаковы ли crc32 для идентичных файлов, а могут ли совпадать crc32 для разных файлов.
После выходных переделаю скрипт на сравнение не по crc32, а по md5.

Я понял. Это и имел в виду. Пока что не встречалось, чтобы при одинаковых CRC32 было разное внутреннее содержимое.
А что, MD5 алгоритм надёжнее? Кстати, в P2P-клиенте Strong DC++ контрольные суммы вычисляются по алгоритму TTH, а не по CRC-32. Это тоже потому, что он вернее?

Batya · Сообщение **Batya** » Вт июн 23, 2009 11:04

Реализована проверка идентичности по md5:

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

'=====================================================================================
' Удаление из указанной папки файлов-дубликатов, кроме самого раннего по времени.
'   Дубликатами считаются файлы, у которых совпадает 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 Кб.

Neo233 · Сообщение **Neo233** » Ср июн 24, 2009 08:42

Batya Спасибо и за md5. А имеет смысл проверять обеими алгоритмами? (crc32 и md5) Или лучше по md5 ?

Batya · Сообщение **Batya** » Ср июн 24, 2009 09:30

Neo233 писал(а):А имеет смысл проверять обеими алгоритмами?

Пользуйся, чем тебе удобней и быстрее. Главное - чтобы ложных удалений не было.
А с CRC32 неувязочка вышла - первый скрипт считает, вроде, вовсе не CRC32, а некую недокументированную контрольную сумму.

Neo233 · Сообщение **Neo233** » Ср июн 24, 2009 09:34

хм.. так что, тот скрипт выходит применять нельзя?

Batya · Сообщение **Batya** » Ср июн 24, 2009 09:36

Neo233 писал(а):хм.. так что, тот скрипт выходит применять нельзя?

Применяй, если он у тебя нормально работает (без ложных удалений). Хотя, для верности лучше поменять на md5.

Mite · Сообщение **Mite** » Ср окт 28, 2009 10:01

Batya, а почему вы использовали XStandard.Buffer, а не MD5 Checksum Component с того же сайта? Второй как бы более конкретно заточен на подсчет MD5?