| View previous topic :: View next topic |
| Author |
Message |
Volniy
Joined: 15 Dec 2004
Posts: 585
Location: Местный
|
 (Separately) Posted: Wed Jun 10, 2009 21:30 Post subject: |
 |
|
| Параметр кнопки %L нужно написать в кавычках, "%L", именно так, как в шапке скрипта. |
|
| Back to top |
|
 |
Neo233
Joined: 09 Jun 2009
Posts: 29
|
| (Separately) Posted: Wed Jun 10, 2009 21:37 Post subject: |
|
|
| Volniy wrote: | | Параметр кнопки %L нужно написать в кавычках, "%L", именно так, как в шапке скрипта. |
Применил. Всё равно выскакивает вышеупомянутое окно с сообщением об ошибке. Текст сообщения тот же что и раньше..
Last edited by Neo233 on Thu Jun 11, 2009 17:48; edited 1 time in total |
|
| Back to top |
|
|
Volniy
Joined: 15 Dec 2004
Posts: 585
Location: Местный
|
| (Separately) Posted: Thu Jun 11, 2009 00:16 Post subject: |
|
|
Странные дела... А что именно у тебя находится в 15-ой строке vbs-файла?
Кроме того, может стоит попробовать установить последнюю версию WSH? |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия
|
| (Separately) 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 |
|
| Back to top |
|
|
Neo233
Joined: 09 Jun 2009
Posts: 29
|
| (Separately) Posted: Thu Jun 11, 2009 17:38 Post subject: |
|
|
| Volniy wrote: | | А что именно у тебя находится в 15-ой строке vbs-файла? |
Текст скрипта взял, который вы мне и посоветовали на первой странице дискуссии: | Volniy wrote: | | Вахмурка, ты немного не туда указал. Надо бы вот сюда. |
Можете глянуть на 15-ю строку.. Я не знаю, как ведётся нумерация строк и с какой позиции..
Не ставится.. 
"Эта копия системы 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 wrote: | | Кроме того, хотелось бы узнать следующее - Уникальность crc32 для файлов |
Если ТС находил одинаковые файлы, то они ВСЕГДА были одинаковыми. Я раньше всегда просматривал их вручную перед удалением, затем перестал.
| Batya wrote: | | Для работы скрипта необходим DynamicWrapperX. |
Скачал, поместил в С:\Windows\ Пробовал и с предыдущим скриптом, и с тем, что вы написали в сообщении в 14:21.
С последним скриптом выскакивает ошибка:
Windows Script Host
Сценарий: H:\TC_WS_Help\111.vbs
Строка: 13
Символ: 1
Ошибка: Невозможно создание объекта контейнером ActiveX: `DynamicWrapperX`
Код: 800A01AD
Источник: Ошибка выполнения Microsoft VBScript
[ OK ]
Что ещё может быть? |
|
| Back to top |
|
|
Volniy
Joined: 15 Dec 2004
Posts: 585
Location: Местный
|
|
| Back to top |
|
|
Neo233
Joined: 09 Jun 2009
Posts: 29
|
| (Separately) Posted: Thu Jun 11, 2009 20:43 Post subject: |
|
|
Ура!  Заработала кнопка , наконец! Скачал, установил WindowsXP-Windows2000-Script56-KB917344-x86-rus.exe Перерегистрировал DynamicWrapperX (теперь без ошибок). И сделал новую кнопку. Вписал в параметр путь к папке. Выходит, из-за WSH не работало...
Batya, Volniy, Вахмурка, Tol!k большущее спасибо за скрипт и за разъяснения! 
| Volniy wrote: | | В vbs скриптах нумерация ведется с начала (а как еще?). Просто я точно не знаю что именно ты скопировал в этот файл, а что нет. Неужто трудно было посчитать до 15-ти? |
Я имел в виду: может нумерация ведётся начиная с исполняемой части кода, а не со строк комментариев. И к тому же слышал что иногда нумеровка начинается с 0, а не с 1.. Поэтому пальцем в небо не стал тыкать, а честно написал что не знаю
Batya, к вам просьба..
Можете изменить скрипт, чтобы оставался ПЕРВЫЙ из одинаковых в группе файлов? Я это с самого начала ветки написал. Web-камера иногда зависает (по независящим от меня причинам) и выдаёт в Сеть одну и ту же картинку, не обновляясь. При этом из группы одинаковых имеет смысл оставлять только первую картинку. С самой РАННЕЙ датой и временем создания. (нужна информация о том, что происходило в поле зрения Web-камеры). А выходит , что остаётся только последняя. ( Удаляются файлы с первого по предпоследний). Так же выделяет и DupSelector. Только не удаляет.
Попробовал переписать 57-ю строку скрипта
| Code: | FSO.DeleteFile pPath |
на другие варианты, но тогда ничего вообще не работает 
где бы почитать про команды скриптов? |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия
|
| (Separately) Posted: Thu Jun 11, 2009 23:31 Post subject: |
|
|
| Neo233 wrote: | Batya, к вам просьба..
... оставлять только первую картинку. С самой РАННЕЙ датой и временем создания. |
Исправил скрипт. Конкретно нужно поменять в строке | Code: | If F.DateLastModified > FC.DateLastModified Then |
символ "больше" на "меньше": | Code: | If F.DateLastModified < FC.DateLastModified Then |
| Neo233 wrote: | | Если ТС находил одинаковые файлы, то они ВСЕГДА были одинаковыми. |
Вопрос не в том, одинаковы ли crc32 для идентичных файлов, а могут ли совпадать crc32 для разных файлов.
После выходных переделаю скрипт на сравнение не по crc32, а по md5.
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
Neo233
Joined: 09 Jun 2009
Posts: 29
|
| (Separately) Posted: Fri Jun 12, 2009 11:55 Post subject: |
|
|
Batya спасиибооо!!!!  Цены вам нет! Эх, как жить-то хорошо стало!!! И всем, откликнувшимся ещё раз огромный РЕСПЕКТ!!
| Batya wrote: | Вопрос не в том, одинаковы ли crc32 для идентичных файлов, а могут ли совпадать crc32 для разных файлов.
После выходных переделаю скрипт на сравнение не по crc32, а по md5. |
Я понял. Это и имел в виду. Пока что не встречалось, чтобы при одинаковых CRC32 было разное внутреннее содержимое.
А что, MD5 алгоритм надёжнее? Кстати, в P2P-клиенте Strong DC++ контрольные суммы вычисляются по алгоритму TTH, а не по CRC-32. Это тоже потому, что он вернее? |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия
|
| (Separately) 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 Кб.
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
Neo233
Joined: 09 Jun 2009
Posts: 29
|
| (Separately) Posted: Wed Jun 24, 2009 08:42 Post subject: |
|
|
| Batya Спасибо и за md5. А имеет смысл проверять обеими алгоритмами? (crc32 и md5) Или лучше по md5 ? |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия
|
| (Separately) Posted: Wed Jun 24, 2009 09:30 Post subject: |
|
|
| Neo233 wrote: | | А имеет смысл проверять обеими алгоритмами? |
Пользуйся, чем тебе удобней и быстрее. Главное - чтобы ложных удалений не было.
А с CRC32 неувязочка вышла - первый скрипт считает, вроде, вовсе не CRC32, а некую недокументированную контрольную сумму.
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
Neo233
Joined: 09 Jun 2009
Posts: 29
|
| (Separately) Posted: Wed Jun 24, 2009 09:34 Post subject: |
|
|
| хм.. так что, тот скрипт выходит применять нельзя? |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия
|
| (Separately) Posted: Wed Jun 24, 2009 09:36 Post subject: |
|
|
| Neo233 wrote: | | хм.. так что, тот скрипт выходит применять нельзя? |
Применяй, если он у тебя нормально работает (без ложных удалений). Хотя, для верности лучше поменять на md5.
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
Mite
Joined: 26 Oct 2009
Posts: 10
|
| (Separately) Posted: Wed Oct 28, 2009 11:01 Post subject: |
|
|
| Batya, а почему вы использовали XStandard.Buffer, а не MD5 Checksum Component с того же сайта? Второй как бы более конкретно заточен на подсчет MD5? |
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
