Total Commander

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

'====================================================================================
' Подсчет CRC32 у файлов из файла-списка. Сохранение CRC32 в excel-файле.

' Параметры скрипта:
'   {файл-список} {excel-файл}

' Для работы скрипта необходимо зарегистрировать в системе компонент DynamicWrapperX
'====================================================================================
Option Explicit
'=============== Изменяемые параметры ===============================================
Const StartCell = "A1" 'Первая ячейка таблицы
'====================================================================================

Dim WRP, FSO, WSH, Mess, FileList, XlsFile, FCrc, F, K, objXL, i, j
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")
For Each F In Split(FSO.OpenTextFile(FileList).ReadAll, vbNewLine)
  If F <> "" Then
    F = GetPath(F)
    If Not FCrc.Exists(F) Then FCrc.Add F, GetCrc(F)
  End If
Next

Set objXL = WScript.CreateObject("Excel.Application")
objXL.Workbooks.Open XlsFile
i = objXL.Range(StartCell).Row
j = objXL.Range(StartCell).Column

For Each K In FCrc.Keys
  objXL.Cells(i,j  ).Value = K
  objXL.Cells(i,j+1).Value = FCrc(K)
  i = i + 1
Next

'Сохранение результатов
objXL.Application.ActiveWorkbook.Save
objXL.Quit()

MsgBox Mess(5), vbInformation + vbOKOnly, Mess(0)
Quit

'===== Процедуры и функции ===============================================================
'Проверка входных параметров
Sub CheckParams
  With WScript
    If .Arguments.Count = 0 Then
      MsgBox Mess(1), vbCritical + vbOKOnly, Mess(0)
      Quit
    End If
    FileList = GetPath(.Arguments(0))
    If Not FSO.FileExists(FileList) Then
      MsgBox Mess(2), vbCritical + vbOKOnly, Mess(0)
      Quit
    End If
    If .Arguments.Count < 2 Then
      MsgBox Mess(3), vbCritical + vbOKOnly, Mess(0)
      Quit
    End If
    XlsFile = GetPath(.Arguments(1))
    If Not FSO.FileExists(XlsFile) Then
      MsgBox Mess(4), vbCritical + vbOKOnly, Mess(0)
      Quit
    End If
  End With
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,  "Подсчет CRC32"
    .Add 1,  "Не указаны параметры!"
    .Add 2,  "Файл-список не существует!"
    .Add 3,  "Указаны не все параметры!"
    .Add 4,  "Excel-файл не существует!"
    .Add 5,  "Операция завершена."
  End With
End Sub

'Выход
Sub Quit
  Set objXL = Nothing
  Set Mess  = Nothing
  Set FCrc  = Nothing
  Set WRP   = Nothing
  Set WSH   = Nothing
  Set FSO   = Nothing
  WScript.Quit
End Sub

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

%L "{полный путь к Excel-файлу}"

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

[Directory -> CSV (+CRC32)]
use="abcdeh"
Extension=".csv"
Divider=","
header="File,Size,Date,CRC32"
before="%N"
name="@Mod=size.kbytes@filesys.wdx; kB"
between="@Mod=writedate@filesys.wdx; ;@Mod=writetime.h:m@filesys.wdx;"
wdxinfo="@Mod=GetCrc32FromFile.NoBrackets@crc32tag.wdx;"
DoNotWriteEmpty=1
SaveErrorLog=1
MaxRight=12

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

<list>
<archive filename="file.exe" checksum="46FAA0C9" original="68C6D920" size="45056"/>
***
</list>

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

'===================================================================================
' Создание/перезапись хэш-файла в активном каталоге или в каждой ветви его структуры
' Ссылка на утилиту RHash: http://sourceforge.net/projects/rhash/files/rhash/

' Условия: путь запуска - пустой;
'          положить в каталог программы 64-битную версию с именем rhash64.exe

' Параметры: <хэш-формат> <маска расширения> <не/включать рекурсию: 0/1>
' Хэш-формат: crc32, md4, md5, sha1, sha-224, sha-256, sha-384, sha-512, sha3-224,
' sha3-256, sha3-384, sha3-512, tiger, tth, has160, aich, ed2k, gost-cryptopro,
' gost, btih, ripemd160, whirlpool, snefru128, snefru256, edon-r256, edon-r512

' Примеры:  md5 *.* 0  |  sha1 *.avi 1

' Автор: Flasher ©
'===================================================================================
Option Explicit
Dim RHash, Alg, Filt, Test, ShA, Ext, Ps, Flt, FN, Title, Path, F, Items, Sum, Fold
'========================== Путь к утилите RHash (32 bit) ==========================
RHash = """%COMMANDER_PATH%\Utils\RHash\rhash.exe"""
'===================================================================================
With WScript.Arguments Alg = .Item(0) : Filt = .Item(1) : Test = .Item(2) End With
Dim C(2), WSH : Set WSH = CreateObject("WScript.Shell")
Ext = Alg : Set ShA = CreateObject("Shell.Application")
Select Case Alg : Case "crc32" Ext = "sfv" : Case "sha1" Ext = "sha" End Select
If InStr(Alg, "sha-") Then Ext = "sha" & Mid(Alg, 5)
If Filt <> "*.*" Then Ps = UCase(Mid(Filt,3)) : Flt = "_for_" & Ps Else Ps = "(объекты)"
If WSH.Environment("System")("PROCESSOR_ARCHITECTURE") = "AMD64" Then _
RHash = Left(RHash, InStrRev(RHash, ".") - 1) & "64.exe"""
ForFolder WSH.CurrentDirectory, FN : Title = " Создание CRC-файлов " & Ucase(Ext)
If C(0) = "" Then
  MsgBox "Файлы " & Ps & " отсутствуют!", 48, Title
ElseIf C(0) = 1 And C(1) = "" Then WSH.Run """%COMMANDER_EXE%"" /O /S /L=""" & FN & """"
Else MsgBox Ucase(Ext) & "-файлов:" & String(2, vbTab) & C(0) & vbCr &_
"Контрольных сумм:" & vbTab & C(2), 64, Title & " (результат) :" End If

Sub ForFolder(Path, F)
  Set Items = ShA.NameSpace(Path).Items
  Items.Filter  64, "*." & Ext
  If Items.Count = 1 And Filt = "*.*" Then _
  F = Items.Item(0).Path Else F = Path & "\Checksum" & Flt & "." & Ext
  Items.Filter 192, Filt : Sum = Items.Count
  If Sum Then
    Items.Filter 64, Right(F, Len(F) - InStrRev(F,"\")): If Items.Count Then Sum = Sum - 1
    WSH.Run RHash &_
    " -i -p""%{" & Alg & "} *%f\n"" -o""" & F & """ """ & Path &"\" & Filt & """", 0, True
    With CreateObject("ADODB.Stream")
      .Open : .CharSet = "UTF-8" : .LoadFromFile F : .Type = 1 : .SaveToFile F, 2 : .Close
    End With : C(0) = C(0) + 1 : C(2) = C(2) + Sum
  End If
  If Test Then
    Items.Filter 160, "*"
    If Items.Count Then C(1) = 1 : For Each Fold in Items : ForFolder Fold.Path, F : Next
  End If
End Sub