Серый форум — LangMF 11: CRC32 файла

Re: LangMF 11: CRC32 файла

null@example.com (atomix) — Tue, 14 Sep 2021 16:20:35 +0000

Поправил у себя этот пример, работает с большими файлами если BUFFER_SIZE кратно 65536.

Спасибо за выявленный баг.

Re: LangMF 11: CRC32 файла

null@example.com (Poltergeyst) — Mon, 13 Sep 2021 17:42:28 +0000

Кажется есть вариант, если в коде оригинального примера изменить значение


Const BUFFER_SIZE = 8000000

например на


Const BUFFER_SIZE = 65536

т.е:


Private Declare Function RtlComputeCrc32 Lib "ntdll.dll" (ByVal dwInitial As Long, ByVal pData As Long, ByVal iLen As Long) As Long
<#Module=mdlMain>
'---------------------------------------
Sub Load(cmdLine)
 
	nameFile = "C:\Users\Public\Documents\OOo_2.0.1_windows_install_ru.zip"
	MsgBox CRC32(nameFile),vbSystemModal
	EndMF
End Sub

'---------------------------------------
Function CRC32(nFile)
    Dim fs, pos, sz, ptr
    
    Const OPEN_EXISTING  = 3
    Const GENERIC_READ   = &H80000000
    '/Const BUFFER_SIZE    = 8000000
    Const BUFFER_SIZE    = 65536
    
    CRC32 = 0
    
    Set f = sys.file.api
    If f.FOpen(nFile, OPEN_EXISTING, GENERIC_READ) = -1 Then Exit Function
    
    pos = 0  :  fs = f.LOF  :  sz = BUFFER_SIZE
    
    Do
        If fs - pos = 0 Then Exit Do
        If fs - pos < BUFFER_SIZE Then sz = fs - Pos
        
        f.UnMap
        ptr = f.Map(,,pos,sz)
        If ptr = 0 Then Exit Do
  
        CRC32 = RtlComputeCrc32(CRC32, ptr, sz)
        
        pos = pos + sz
    Loop Until pos >= fs
    
    f.FClose
    
    CRC32 = Hex(CRC32)
End Function
<#Module>

то результат CRC32 для большого файла соответствует 7zip - 4B5EA7E9. Видимо скрипт из первого поста оказался не нужным.

Re: LangMF 11: CRC32 файла

null@example.com (Poltergeyst) — Mon, 13 Sep 2021 17:19:30 +0000

Нет, быстродействие не сравнивал. Использовал сокращенный код LagMF 11 из оригинального примера Examples\FileHash:


Private Declare Function RtlComputeCrc32 Lib "ntdll.dll" (ByVal dwInitial As Long, ByVal pData As Long, ByVal iLen As Long) As Long
<#Module=mdlMain>
'---------------------------------------
Sub Load(cmdLine)
 
	nameFile = "C:\Users\Public\Documents\OOo_2.0.1_windows_install_ru.zip"
	MsgBox CRC32(nameFile),vbSystemModal
	EndMF
End Sub

'---------------------------------------
Function CRC32(nFile)
    Dim fs, pos, sz, ptr
    
    Const OPEN_EXISTING  = 3
    Const GENERIC_READ   = &H80000000
    Const BUFFER_SIZE    = 8000000
    
    CRC32 = 0
    
    Set f = sys.file.api
    If f.FOpen(nFile, OPEN_EXISTING, GENERIC_READ) = -1 Then Exit Function
    
    pos = 0  :  fs = f.LOF  :  sz = BUFFER_SIZE
    
    Do
        If fs - pos = 0 Then Exit Do
        If fs - pos < BUFFER_SIZE Then sz = fs - Pos
        
        f.UnMap
        ptr = f.Map(,,pos,sz)
        If ptr = 0 Then Exit Do
  
        CRC32 = RtlComputeCrc32(CRC32, ptr, sz)
        
        pos = pos + sz
    Loop Until pos >= fs
    
    f.FClose
    
    CRC32 = Hex(CRC32)
End Function
<#Module>

Результат для файла OOo_2.0.1_windows_install_ru.zip(78,9 МБ): 160CDEDF. Результат 7zip для того же файла: 4B5EA7E9. Собственно на 7zip и равнялся.

Re: LangMF 11: CRC32 файла

null@example.com (atomix) — Mon, 13 Sep 2021 16:37:46 +0000

Интересное использование. А сравнивал по быстродействию с оригинальным примером?

LangMF 11: CRC32 файла

null@example.com (Poltergeyst) — Mon, 13 Sep 2021 15:29:01 +0000

В LangMF 11, так понял, отсутствует функция получения crc32 файла, а используется скрипт с применением RtlComputeCrc32 (ntdll.dll). Как вариант (тестировалось на Win 7):



' Поиск CRC32 файла
' Потребуется установленный LangMF 11
' OC Win 7

Private Declare Function RtlComputeCrc32 Lib "ntdll.dll" (ByVal dwInitial As Long, ByVal pData As Long, ByVal iLen As Long) As Long
<#Module=crc32>

'-----------------------------------------------------------------------
Sub Load(cmdstr)

	'Архив размером 78,9 МБ. CRC32 совпадает с результатом 7zip
	sFilePath = "C:\Users\Public\Documents\OOo_2.0.1_windows_install_ru.zip"

	MsgBox "File CRC32: 0x" & Hex(GetCRC32(sFilePath)), vbSystemModal + vbExclamation, "Reply"
	EndMF

End Sub

'/Получить CRC32 файла/
'-----------------------------------------------------------------------
Function GetCRC32(sFile)

	Dim buf()
	Dim buf1
	Dim crc32
	Dim lSize, chunk, div, SZ
	Dim u
	Dim ptr

	Const OPEN_EXISTING = 3
	Const GENERIC_READ = &H80000000

	'/Чем больше размер BUF_SIZE тем быстрее работает скрипт за счет сокращения обращений к RtlComputeCrc32/
	Const BUF_SIZE = 65536

	Set f = sys.file.api
	If f.FOpen(sFile, OPEN_EXISTING, GENERIC_READ)=-1 Then GetCRC32=-1 : Exit Function
	
	lSize = f.LOF
	chunk = lSize Mod BUF_SIZE
	div = (lSize - chunk)/BUF_SIZE

	'/Получение контрольной суммы фрагментами/
	'---------------------------------------------------------------
	crc32 = 0

	' Для фрагментов равных размеру буфера
	'---------------------------------------------------------------
	SZ = BUF_SIZE
	ReDim buf(SZ-1)
	buf1 = Sys.SHD.ArrayByte(buf)
	ptr = Sys.SHD.ArrayPtr(buf1)

	For u=0 To div-1
		f.FGet buf1
		crc32 = RtlComputeCrc32(crc32, ptr, SZ)
	Next
			
	' Для остаточного фрагмента (вынесено из цикла)
	'---------------------------------------------------------------
	SZ = chunk
	ReDim buf(SZ-1)
	f.FGet buf1
	crc32 = RtlComputeCrc32(crc32, ptr, SZ)

	'---------------------------------------------------------------
	f.FClose
	GetCRC32 = crc32

End Function
<#Module>