Excel vba контрольная сумма - Word и Excel - помощь в работе с программами

Name already in use

A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?

1
branch

0
tags

Code

Use Git or checkout with SVN using the web URL.
Open with GitHub Desktop
Download ZIP

Latest commit

add readme description

159d506

Files

Permalink

Failed to load latest commit information.

Type

Name

Latest commit message

Commit time

====
VBA-CRC32

Calc CRC32 for string or file.

Installation

Import file-module in VBA project

Function

CalcStr(Text AS String) AS String
CalcFile(PathFile AS String, [FileBuffer AS Long = 32768]) AS String

Example

Example of calc string:

Dim Str, StrCRC32 as String
Str = "Test string"
StrCRC32 = CRC32.CalcStr(Str)

Example of calc file:

Dim FileName, StrCRC32 as String
Dim FileBuffer as Long
FileName = "C:Test_file_for_CRC32.txt"
FileBuffer = 65536
StrCRC32 = CRC32.CalcFile(FileName, FileBuffer)
If Not StrCRC32 Then
    Debug.Print "File not found!"
End If

Источник

Summary

This project was to create an Excel VBA that generated and checked CRC-32s for text strings. When generating CRCs an input csv file was selected using a file dialog window and read by the Excel VBA. A CRC is calculated for each row in the .csv file for any number of columns. An output file is saved with .crc extension with an additional column in each row that contained the CRC-32 value. Checking CRCs reads the .crc file and identifies any detected errors.

Implementation

When creating CRCs there are a few different algorithms that are available. One of the best resources was an Online Calculator that is configurable with input type, output type, CRC length, and algorithm. For each algorithm it calculates a CRC based on an input. The website also shows the CRC’s polynomial, accumulator initialization value, RefIn/RefOut, and XorOut parameters.

This project implemented CRC-32Q, which is used in aviation. For CRC-32Q the polynomial is 0x814141AB, initialization 0x00000000, RefIn=false, RefOut=false, and XorOut 0x00000000. Some readers may not be familiar with RefIn and RefOut. If RefIn/RefOut is true then the data is reflected, i.e. bit 0 becomes the msb.

The Excel VBA reads the input data as text using a query. Reading the file as csv may cause Excel to change data based on a type guess, which impacts your CRC calculation. Each text string is stored in a row on a worksheet for processing (including commas). The CRC process uses a table created as an array of 256 long integers. To calculate the CRC per string (row), each character (8-bits) generates a new CRC-32 value. Once the end of the string is encountered the CRC-32 calculation is complete for that string.

When performing the CRC-32 calculation on a byte by byte basis, shifting data left and right is necessary. These functions are not available in Excel. Separate functions were created to perform shift left and shift right. Realize that shifting right is a simple divide by 2^N function but shifting left is not a simple multiple by 2^N function. With 2’s complement data the MSB is a sign bit. Shifting data into the sign bit impacts how the data is represented. So special handing of the potential MSB when shifting left is required.

Shifting Functions Code

Function shl(ByVal Value As Long, ByVal Shift As Byte) As Long
    ' shift left is a complex algorithm
    ' shift left is multiply by 2
    ' need to worry about overflow
    shl = Value
    If Shift > 0 Then
        Dim i As Byte
        Dim m As Long
        For i = 1 To Shift          ' multiply by 2
            m = shl And &H40000000  ' check for overflow
            shl = (shl And &H3FFFFFFF) * 2  ' mask off overflow
            If m <> 0 Then
                shl = shl Or &H80000000     ' add bit if overflow
            End If
        Next i
    End If
End Function

Function shr(ByVal Value As Long, ByVal Shift As Byte) As Long
    ' shift right is a simple integer divide 2^power
    shr = Value
    If Shift > 0 Then
        shr = Int(shr / (2 ^ Shift))
    End If
End Function

Источник

Виктор Степанович Семенчук

Пользователь

Сообщений: 34
Регистрация: 01.01.1970

09.11.2016 16:20:49

Добрый день. Нужны макросы а точнее 2-е функции, одна для расчета а вторая для проверки CRC кода. Описание во вложении.

Скрытый текст

Sanja Пользователь Сообщений: 14838 Регистрация: 10.01.2013	Постановка ЗАДАЧ в ЭТОМ разделе Согласие есть продукт при полном непротивлении сторон.

Виктор Степанович Семенчук

Пользователь

Сообщений: 34
Регистрация: 01.01.1970

10.11.2016 00:46:52

Есть функция которая вычисляет CRC-16 но результат не совпадает. Для данного значения «0d84580000000001010800» в hex должно получится AEB1. Проверял на сайте

калькулятор crc

, совпадает. Помогите подправить.

Код

Function CRC_16_RTU(OutputString As String) As String

Dim Generator, CRC As Long
Dim I As Integer, J As Integer, Length As Integer
Dim Bit As Boolean
Dim Temp As Byte
Length = Len(OutputString)
CRC = 65535
Generator = 8005 '40961

For I = 1 To Length
  Temp = Asc(Mid(OutputString, I, 1))
         CRC = CRC Xor Temp
         For J = 1 To 8
           Bit = CRC And 1
           CRC = CRC  2
           If Bit = True Then
              CRC = CRC Xor Generator
           End If
       Next J
     Next I
'     CRC_16 = Chr(CRC Mod 256) & Chr(CRC  256)
     CRC_16_RTU = Hex(CRC Mod 256) & Hex(CRC  256)
 End Function

Виктор Степанович Семенчук

Пользователь

Сообщений: 34
Регистрация: 01.01.1970

10.11.2016 17:03:10

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

Код

Function CRC_16_RTU(OutputString, h12, h13 As String) As String  ' функция подсчета контрольной суммы сообщения RTU
    Dim Polenom, crc As Long
    Dim i As Integer, j As Integer, Length As Integer
    Dim Bit As Boolean
    Dim Temp As Byte

    Length = Len(OutputString)
    crc = 65535
    Polenom = 8005 ''&H1F45 ''40961
    
    For i = 1 To Length
        Temp = "&H" & Mid(OutputString, i, 1)
        '  Temp = Asc(Mid(OutputString, i, 1))
        crc = crc Xor Temp
        For j = 1 To 8
            Bit = crc And 1
            crc = crc  2
            If Bit = True Then crc = crc Xor Polenom
        Next j
    Next i
    
    '     CRC_16 = Chr(CRC Mod 256) & Chr(CRC  256)
    CRC_16_RTU = Hex(crc Mod 256) & Hex(crc  256)
    If Len(Hex(crc Mod 256)) = 1 Then h12 = 0 & Hex(crc Mod 256) Else h12 = Hex(crc Mod 256)
    If Len(Hex(crc  256)) = 1 Then h13 = 0 & Hex(crc  256) Else h13 = Hex(crc  256)
End Function

Doober

Пользователь

Сообщений: 2201
Регистрация: 09.04.2013

10.11.2016 19:44:38

Зачем себя насиловать , если есть сайт.С него брать не вариант?

Код

Sub getCode()
    s = CRC_16("0d84580000000001010800")
End Sub
Function CRC_16(ByVal crc)
    URL = "https://www.lammertbies.nl/comm/info/crc-calculation.php?crc=" & crc & "&method=hex"
    CRC_16=""
  On Error Resume Next
    Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    With oXMLHTTP
        .Open "GET", URL, False
        .send
        htmlcode = .responsetext
    End With
    Set oXMLHTTP = Nothing
    Set RegExp = CreateObject("VBScript.RegExp")

    RegExp.Pattern = "<td[^>]*>CRC-16</td>" & _
                     "<td[^>]*><b>0x(.+?)</b></td>"

    Set oMatches = RegExp.Execute(htmlcode)
    If oMatches.Count > 0 Then
        CRC_16 = oMatches(0).subMatches(0)
    End If
End Function

Изменено: Doober — 10.11.2016 19:52:19

<#0>

Виктор Степанович Семенчук Пользователь Сообщений: 34 Регистрация: 01.01.1970	#6 10.11.2016 21:25:55 Doober, спасибо, что отозвались, конечно Ваш вариант имеет место на жизнь, но не всегда есть интернет для доступа к сайту. Я только, что запустил свой вариант.

Источник

Вставка размера фала и контрольной суммы

Ибет

Дата: Понедельник, 09.01.2023, 17:49 |
Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация:
0
±

Замечаний:
0% ±

Здравствуйте, ничего не понимаю в vba, необходимо вставить в ячейку размер файла в байтах (другого файла на который указан путь) и контрольную сумму md5. (по возможности в одной ячейке указываешь путь, в других появляется размер и контр. сумма). Полазив по форуму удалось сделать только автоматическую вставку даты и времени. Похожие темы видел, но что-то не смог сам сделать

К сообщению приложен файл:

0252171.xlsm
(18.8 Kb)

Сообщение отредактировал Ибет — Понедельник, 09.01.2023, 17:52

Ответить

Nic70y

Дата: Вторник, 10.01.2023, 08:16 |
Сообщение № 2

Группа: Друзья

Ранг: Экселист

Сообщений: 8132

Репутация:
1998
±

Замечаний:
0% ±

Excel 2010

[vba]

Код

[f6] = FileLen(FilePath)

[/vba]

ЮMoney 41001841029809

Ответить

Ибет

Дата: Вторник, 10.01.2023, 09:59 |
Сообщение № 3

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация:
0
±

Замечаний:
0% ±

Спасибо большое, получилось, ещё разобрался как брать путь из ячейки. Осталось разобраться как md5 файла вставить

Ответить

Nic70y

Дата: Вторник, 10.01.2023, 10:41 |
Сообщение № 4

Группа: Друзья

Ранг: Экселист

Сообщений: 8132

Репутация:
1998
±

Замечаний:
0% ±

Excel 2010

ЮMoney 41001841029809

Ответить

Ибет

Дата: Вторник, 10.01.2023, 10:58 |
Сообщение № 5

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация:
0
±

Замечаний:
0% ±

Не подошло)

Ответить

bmv98rus

Дата: Вторник, 10.01.2023, 20:33 |
Сообщение № 6

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4009

Репутация:
760
±

Замечаний:
0% ±

Excel 2013/2016

[vba]

Код

Sub MifV()

                Dim fsoFile, FileDateTime, s
        Dim FilePath As String
            Dim objFSO: Set objFSO = CreateObject(«Scripting.FileSystemObject»)
            ‘FilePath = «C:UsersАльбертDesktopУЛРаздел ПД №5 подраздел ПД №6 ИОС6.pdf»
            FilePath=[a1]
            Set fsoFile = objFSO.GetFile(FilePath)
            FileDateTime = (fsoFile.DateCreated)
            [d4] = FileMD5(FilePath)
            [d6] = FileDateTime ‘в ячейку d6 текущего листа вставляем дату создания файла
            [f6] = FileLen(FilePath)
End Sub
Function FileMD5$(sFilePath$)
    On Error GoTo err
    Dim byteArr() As Byte
    With CreateObject(«adodb.stream»)
        .Type = 1: .Open: .LoadFromFile sFilePath
        byteArr = .read
    End With
    With CreateObject(«System.Security.Cryptography.MD5CryptoServiceProvider»)
        FileMD5 = Join(Application.Dec2Hex(.ComputeHash_2(byteArr), 2), «»)
    End With
    Erase byteArr
    Exit Function
err: Debug.Print «Err: » & err.Number & » — » & err.Description
FileMD5$ = err.Description
End Function

[/vba]

~~Замечательный~~ Временно просто медведь ~~, процентов на 20~~.

Сообщение отредактировал bmv98rus — Вторник, 10.01.2023, 21:13

Ответить

Источник

10-10-2013, 11:06 PM

#1

Calculate CRC32 checksum

I want to create a VBA function that can calculate the CRC32 checksum for a file.

I found this webpage which looks promising: http://www.vbaccelerator.com/home/VB…32/article.asp

The only catch is that the code provided is VB not VBA. How hard would it be to tweak this code to run in VBA?

Last edited by mc84excel; 10-14-2013 at 08:43 PM.
10-11-2013, 02:09 AM

#2

Re: Calculate CRC32 checksum / Convert VB code to VBA code?

It’s a very easy port with minor changes but these are probably in code you will not use.

Problems:
Userform (if to be used) needs to be rebuild.
References to APP object can be replaced with APPLICATION.
References to PRINTER object and SCREEN object have no direct equivalents in VBA but as they are part of supplementary code can probably be ignored.

Nothing else noticed on reading

* the source, but the core of the calculation should be a simple copy/paste into a class module. There is at least 1 conditional compilation constants (fComponent), this seems to be a flag if the code is part of a system, or a stand alone project. It can be removed or left as is.

*Note: Code was read, not compiled or tested…
10-13-2013, 06:54 PM

#3

Re: Calculate CRC32 checksum / Convert VB code to VBA code?

Hi cytop.

I see the userform as unnecessary for my purposes. A simple file picker will do to pick the file and a MsgBox will be sufficient to return the CRC32 result (see attached workbook)

I’m afraid that I have never learnt classes. :S I have copy/pasted the code into class modules but I get invalid outside procedure messages…
10-13-2013, 08:24 PM

#4

Re: Calculate CRC32 checksum / Convert VB code to VBA code?

Tested on one text file …

Entia non sunt multiplicanda sine necessitate
10-13-2013, 10:32 PM

#5

Re: Calculate CRC32 checksum / Convert VB code to VBA code?

Thanks shg +1, this code looks like what I was after.

Before I mark this as solved however, I am uncertain about the output produced.

I tried a random file and obtained the CRC32 checksum using your function. It returned a result of 3281A458. I then tested the same file again on an online CRC32 calculator (I googled for one and used this website: http://hash.online-convert.com/crc32-generator) The checksum that this site returned on the uploaded file was 74EF76B6.

Why the difference?
10-14-2013, 12:09 AM

#6

Re: Calculate CRC32 checksum / Convert VB code to VBA code?

The file read probably needs to be changed to a straight binary input. Over to you.
10-14-2013, 11:44 AM

#7

Re: Calculate CRC32 checksum / Convert VB code to VBA code?
10-14-2013, 07:01 PM

#8

Re: Calculate CRC32 checksum / Convert VB code to VBA code?

I set a reference to Microsoft ActiveX Data Objects 2.0 Library and ended up with a «user defined type» error on the line

Google provided the solution. You need to use Microsoft ActiveX Data Objects 2.5 Library (or higher version) to prevent this happening.

I am posting this here in case anyone else runs into this.
10-14-2013, 07:07 PM

#9

Re: Calculate CRC32 checksum / Convert VB code to VBA code?

Brilliant work shg.

This thread is solved. I am posting my final version of this code below.

Last edited by mc84excel; 10-14-2013 at 07:47 PM.

Reason: solved problem
10-14-2013, 08:21 PM

#10

Re: Calculate CRC32 checksum / Convert VB code to VBA code?

This is illogical. I created a dummy test file to compare the CRC32 result against other online calculators. To my surprise, there were a wide variety of results from different systems! How can this be?!

My test file is attached and the results I received are below:

D5509719 = Excel function

3578828569 = Checksum Calculator http://www.checksumcalculator.com/

D959103E = http://hash.online-convert.com/crc32-generator

d959103e = online-domain-tools (can’t provide URL link — the post crashes whenever I try)

D5509719 = http://crc32-checksum.waraxe.us/

UPDATE:

I realised that there are only

two different results in the above, not three. (Checksum Calculator result of 3578828569 = D5509719 in Hex).
So three different tools are returning D5509719 and two others are returning D959103E

Last edited by mc84excel; 10-14-2013 at 09:56 PM.
02-19-2014, 09:04 PM

#11

Re: Calculate CRC32 checksum

To follow/contribute to the next stage of this project, see: http://www.excelforum.com/excel-prog…stage-2-a.html
06-13-2016, 11:22 AM

#12

Registered User

Re: Calculate CRC32 checksum

The CRC32-Mpeg2 seems use different algorithm, the explanation as following:
http://www.lammertbies.nl/forum/viewtopic.php?t=1398

And it also calculate by website correcty:
http://www.sunshine2k.de/coding/java…rc/crc_js.html

Configuration:
CRC-32
CRC32_MPEG2
Fill Data(00 to FF):
«000102030405060708090a0b0c0d0e0f101112131415161718191a1b1c1d1e1f202122232425262728292a2b2c2d2e2f303132333435363738393a3b3c3d3e3f404142434445464748494a4b4c4d4e4f505152535455565758595a5b5c5d5e5f606162636465666768696a6b6c6d6e6f707172737475767778797a7b7c7d7e7f808182838485868788898a8b8c8d8e8f909192939495969798999a9b9c9d9e9fa0a1a2a3a4a5a6a7a8a9aaabacadaeafb0b1b2b3b4b5b6b7b8b9babbbcbdbebfc0c1c2c3c4c5c6c7c8c9cacbcccdcecfd0d1d2d3d4d5d6d7d8d9dadbdcdddedfe0e1e2e3e4e5e6e7e8e9eaebecedeeeff0f1f2f3f4f5f6f7f8f9fafbfcfdfeff»

CRC32_MPEG2 result is «494a116a».

The algorithm for normal CRC32 as following:
For I = 0 To 255
dwCrc = I

For j = 8 To 1 Step -1
If (dwCrc And 1) Then
dwCrc = ((dwCrc And &HFFFFFFFE) 2&) And &H7FFFFFFF
dwCrc = dwCrc Xor iPoly
Else
dwCrc = ((dwCrc And &HFFFFFFFE) 2&) And &H7FFFFFFF
End If
Next j

aiCRC(I) = dwCrc
Next I

But it seems not suit for CRC32-MPEG2.
Does someone can help to implement this algorithm? Thanks!!