1 подписчик

Контроль целостности файлов в Excel!

4 февраля 20244 фев 2024

10 мин

Предисловие

Неожиданно появились безопасные безопасники с требованием срочно и прямо вчера показать как работает контроль целостности файлов на серверах и АРМах под управлением Windows технологической сети. Аргументы что такой функционал отсутствует и никем ранее не запрашивался - не аргументы. Сваяв на коленке программку на Python получаем отказ, нет согласования на использование не учтенного в реестре безопасности ПО. Что за реестр и как туда попасть лучше не узнавать. Ну что же, Excel разрешен - а в нем есть VBA.

Не много о контроле целостности

Проверка целостности файлов - это процесс, который используется для установления того, что данные в файлах не были изменены или утеряны с момента их создания или последнего сохранения. Процесс проверки основан на использовании криптографических хеш-функций, которые преобразуют исходный файл в массив байт фиксированной длины (хеш-сумму), который затем может храниться вместе с исходным файлом как его «идентификатор». При следующем открытии файла, вычисляется его новое хеш-значение и сравнивается с прежним значением. Если они различны, то это означает, что данные изменились или были повреждены.

Выбор хэш-функции

Хэш-функция - это алгоритм, который используется для преобразования произвольных данных в короткие уникальные числовые кодовые строки. Эти хэш-суммы являются очень чувствительными к малейшим изменениям в исходном сообщении, что делает их полезным средством для шифрования, аутентификации и проверки целостности данных.

Среди множества хэш-алгоритмов, одни из самых распространённых и надежных являются алгоритмы семейства Secure Hash Algorithm.

Можно остановиться на SHA-512 как оптимальном варианте по уровню безопасности и хорошей производительности на современных процессорах.

Excel и SHA-512

Вариант первый,вычисление с помощью .NET Framework класс System.Security.Cryptography.SHA512Managed для вычисления SHA-512. Хорошо работает с большим количеством маленьких файлов.

Вариант второй, вычислять через утилиту certutil запуская ее через CMD или PowerShell. Хорошо работает с большими файлами.

Будем использовать оба варианта.

Х.Х. и в продакшн!

Техническое задание:

Возможность выбора папок для проверки.

Возможность выбора разрешений файлов для проверки.

Экспорт результатов в формате CSV, для дальнейшего сравнения.

Набросаем немножко интерфейса:

Макросы

Sub SearchFilesWithMultipleExtensions()
Dim folderRange As Range
Dim folderCell As Range
Dim extensionsRange As Range
Dim extensionCell As Range
Dim rowIndex As Long
Dim lastRow As Long

ThisWorkbook.Sheets("Лист1").Range("G2").Value = 0
ThisWorkbook.Sheets("Лист1").Range("G3").Value = 0
ThisWorkbook.Sheets("Лист1").Range("G4").Value = 0
ThisWorkbook.Sheets("Лист1").Range("G5").Value = 0
' Получение диапазона ячеек с папками из D1:D5
Set folderRange = ThisWorkbook.Sheets("Лист1").Range("D2:D2")

' Получение диапазона ячеек с расширениями из E1:E5
Set extensionsRange = ThisWorkbook.Sheets("Лист1").Range("E2:E6")

' Очистка столбца A перед выполнением операции
ThisWorkbook.Sheets("Лист1").Range("A:C").ClearContents

' Установка начального значения для индекса строки
rowIndex = 1
lastRow = 1

' Поиск файлов с заданными расширениями для каждой папки
For Each folderCell In folderRange
Dim folderPath As String
folderPath = folderCell.Value

' Проверка наличия закрывающего слеша в папке
If Right(folderPath, 1) <> "\" Then
folderPath = folderPath & "\"
End If

For Each extensionCell In extensionsRange
Dim extension As String
extension = extensionCell.Value
If extension <> "" Then
RecursiveFileSearch folderPath, extension, rowIndex
End If
Next extensionCell

ThisWorkbook.Sheets("Лист1").Range("G2").Value = rowIndex - 1

Dim bigCount As Long
Dim smallCount As Long
Dim zeroCount As Long

With ThisWorkbook.Sheets("Лист1")
lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row

bigCount = Application.WorksheetFunction.CountIf(.Range("C1:C" & lastRow), "big")
smallCount = Application.WorksheetFunction.CountIf(.Range("C1:C" & lastRow), "small")
zeroCount = Application.WorksheetFunction.CountIf(.Range("C1:C" & lastRow), "zero")

.Range("G3").Value = bigCount
.Range("G4").Value = smallCount
.Range("G5").Value = zeroCount

End With

Next folderCell
Call WriteZeroToColumnB
End Sub

Sub RecursiveFileSearch(folderPath As String, fileExtension As String, ByRef rowIndex As Long)
Dim objFileSystem As Object
Set objFileSystem = CreateObject("Scripting.FileSystemObject")

Dim objFolder As Object
On Error Resume Next
Set objFolder = objFileSystem.GetFolder(folderPath)
On Error GoTo 0
If objFolder Is Nothing Then
Exit Sub
End If

Dim objFile As Object

For Each objFile In objFolder.Files
If LCase(Right(objFile.Name, Len(fileExtension))) = LCase(fileExtension) Then
On Error Resume Next
ThisWorkbook.Sheets("Лист1").Cells(rowIndex, 1).Value = objFile.Path
On Error GoTo 0
If Err.Number = 0 Then
' Дополнение: проверка размера файла
If objFileSystem.GetFile(objFile.Path).Size = 0 Then
ThisWorkbook.Sheets("Лист1").Cells(rowIndex, 3).Value = "zero"
ElseIf objFileSystem.GetFile(objFile.Path).Size > 20240000 Then
ThisWorkbook.Sheets("Лист1").Cells(rowIndex, 3).Value = "big"
Else
ThisWorkbook.Sheets("Лист1").Cells(rowIndex, 3).Value = "small"
End If
rowIndex = rowIndex + 1
End If
End If
Next objFile

Dim objSubFolder As Object
On Error Resume Next
For Each objSubFolder In objFolder.SubFolders
RecursiveFileSearch objSubFolder.Path, fileExtension, rowIndex
Next objSubFolder
On Error GoTo 0
End Sub

Sub CalculateSHA512WithFileSystemObject()
Dim filePath As String
Dim fs As Object
Set fs = CreateObject("Scripting.FileSystemObject")

' Очищаем столбец B, чтобы удалить старые результаты
ThisWorkbook.activeSheet.Range("B1:B" & ThisWorkbook.activeSheet.Cells(Rows.Count, 1).End(xlUp).Row).ClearContents

' Проходим по всем ячейкам в столбце A
Dim cell As Range
For Each cell In ThisWorkbook.activeSheet.Range("A1:A" & ThisWorkbook.activeSheet.Cells(Rows.Count, 1).End(xlUp).Row)
If cell.Offset(0, 2).Value = "small" Then ' Проверяем, что в столбце C указано "small"
filePath = cell.Value

' Проверяем, что файл существует
If Len(filePath) > 0 And fs.FileExists(filePath) Then
' Получаем файловый объект
Dim file As Object
Set file = fs.GetFile(filePath)

' Удаляем нестандартные символы из пути файла
filePath = ReplaceSpecialCharacters(filePath)

' Вычисляем SHA512
Dim hashValue As String
hashValue = GetFileSHA512(file)

' Записываем результат (хеш) в ячейку B, соответствующую записи в A
cell.Offset(0, 1).Value = hashValue
End If
End If
Next cell

End Sub

Function GetFileSHA512(file As Object) As String
On Error Resume Next ' Игнорировать ошибки

Dim stream As Object
Set stream = CreateObject("ADODB.Stream")
stream.Open
stream.Type = 1 ' Binary
stream.LoadFromFile file.Path

If Err.Number = 3002 Then ' Проверка на ошибку 3002
GetFileSHA512 = "Процесс не может получить доступ к файлу, так как этот файл занят другим процессом." ' Возврат сообщения об ошибке в результате работы функции
Exit Function ' Выход из функции
End If

' Создаем объект хеша
Dim sha As Object
Set sha = CreateObject("System.Security.Cryptography.SHA512Managed")

' Вычисляем хеш
Dim hash() As Byte
hash = sha.ComputeHash_2(stream.Read)

' Закрываем поток
stream.Close

' Преобразуем байты в строку
GetFileSHA512 = BytesToHex(hash)
End Function

Function BytesToHex(bytes() As Byte) As String
'Эта функция преобразует массив байтов в шестнадцатеричную строку
Dim i As Integer
Dim result As String
For i = LBound(bytes) To UBound(bytes)
result = result & Right("0" & Hex(bytes(i)), 2)
Next i
BytesToHex = result
End Function

Function ReplaceSpecialCharacters(filePath As String) As String
' Удаляем нестандартные символы из пути файла
Dim specialCharacters() As String
specialCharacters = Split("\/:*?""<>|", ",")

Dim character As Variant
For Each character In specialCharacters
filePath = Replace(filePath, character, "")
Next character

ReplaceSpecialCharacters = filePath
End Function

Sub CalculateSHA512AndWriteToCell_big()
Dim filePath As String
Dim cmdOutput As String
Dim objShell As Object
Dim lastRow As Long
Dim i As Long

' Получаем последнюю заполненную строку в столбце A
lastRow = ThisWorkbook.activeSheet.Cells(Rows.Count, 1).End(xlUp).Row

' Создаем объект Shell
Set objShell = VBA.CreateObject("WScript.Shell")

' Проходимся по каждой строке
For i = 1 To lastRow
' Проверяем значение в столбце C
If ThisWorkbook.activeSheet.Cells(i, 3).Value = "big" Then
' Получаем адрес файла из столбца A
filePath = ThisWorkbook.activeSheet.Cells(i, 1).Value

' Выполняем команду cmd для вычисления SHA512 и записываем результат
cmdOutput = objShell.Exec("cmd /c certutil -hashfile """ & filePath & """ SHA512").StdOut.ReadAll

' Разбиваем вывод на строки
Dim lines() As String
lines = Split(cmdOutput, vbNewLine)

' Ищем вторую строку, содержащую значение хеша
Dim hashLine As String
hashLine = lines(1)

' Находим первое вхождение двоеточия - это будет начало строки с хешем
Dim colonPos As Integer
colonPos = InStr(1, hashLine, ":")

' Получаем подстроку после двоеточия, содержащую значение хеша
Dim hashValue As String
hashValue = Trim(Mid(hashLine, colonPos + 1))

' Записываем результат (хеш) в столбец B текущей строки
ThisWorkbook.activeSheet.Cells(i, 2).Value = hashValue
End If
Next i
End Sub

Sub ExportToCSV()
Dim ws As Worksheet
Dim filename As String
Dim file As Object

' Указываем рабочий лист
Set ws = ThisWorkbook.Sheets("Лист1")

' Формируем имя файла
filename = Format(Now(), "YYYYMMDD_HHMMSS") & "_" & ws.Range("H2").Value

' Создаем новый файл CSV
Set file = CreateObject("Scripting.FileSystemObject").CreateTextFile(filename & ".csv", True)

' Перебираем каждую строку с данными в столбцах A и B
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

Dim i As Long
For i = 1 To lastRow
' Получаем значения из столбцов A и B
Dim valueA As String
On Error Resume Next
valueA = ws.Cells(i, 1).Value

Dim valueB As String
valueB = ws.Cells(i, 2).Value

' Записываем строку в файл CSV
file.WriteLine valueA & "," & valueB
Next i

' Закрываем файл CSV
file.Close

End Sub

Sub WriteZeroToColumnB()
Dim lastRow As Long
Dim i As Long

' Номер последней заполненной строки в столбце C
lastRow = ThisWorkbook.activeSheet.Cells(Rows.Count, 3).End(xlUp).Row

' Проходим по каждой строке
For i = 1 To lastRow
' Равно ли значение в ячейке столбца C значению "zero"
If ThisWorkbook.activeSheet.Cells(i, 3).Value = "zero" Then
' Записываем значение "zero" в соответствующую ячейку столбца B.
ThisWorkbook.activeSheet.Cells(i, 2).Value = "zero"
End If
Next i
End Sub

Sub RunThreeMacros()
' Запуск поиска
Call SearchFilesWithMultipleExtensions

' Запуск подсчета хэш маленьких файлов
Call CalculateSHA512WithFileSystemObject

' Запуск подсчета хэш больших файлов
Call CalculateSHA512AndWriteToCell_big

' Пустые файлы
Call WriteZeroToColumnB

' Запуск экспорта результатов в CSV
Call ExportToCSV

End Sub