VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "cCRC32"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private crc32Table() As Long
Private Const BUFFER_SIZE As Long = 8192
Public Function GetByteArrayCrc32(ByRef buffer() As Byte) As Long
Dim crc32Result As Long
crc32Result = &HFFFFFFFF
Dim i As Integer
Dim iLookup As Integer
For i = LBound(buffer) To UBound(buffer)
iLookup = (crc32Result And &HFF) Xor buffer(i)
crc32Result = ((crc32Result And &HFFFFFF00) / &H100) And 16777215 ' nasty shr 8 with vb :/
crc32Result = crc32Result Xor crc32Table(iLookup)
Next i
GetByteArrayCrc32 = Not (crc32Result)
End Function
Public Function GetFileCrc32(ByRef stream As cBinaryFileStream) As Long
Dim crc32Result As Long
crc32Result = &HFFFFFFFF
Dim buffer(0 To BUFFER_SIZE - 1) As Byte
Dim readSize As Long
readSize = BUFFER_SIZE
Dim count As Integer
count = stream.Read(buffer, readSize)
Dim i As Integer
Dim iLookup As Integer
Dim tot As Integer
Do While (count > 0)
For i = 0 To count - 1
iLookup = (crc32Result And &HFF) Xor buffer(i)
crc32Result = ((crc32Result And &HFFFFFF00) / &H100) And 16777215 ' nasty shr 8 with vb :/
crc32Result = crc32Result Xor crc32Table(iLookup)
Next i
count = stream.Read(buffer, readSize)
Loop
GetFileCrc32 = Not (crc32Result)
End Function
Private Sub Class_initialize()
Dim dwPolynomial As Long
dwPolynomial = &HEDB88320
Dim i As Integer, j As Integer
ReDim crc32Table(256)
Dim dwCrc As Long
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 dwPolynomial
Else
dwCrc = ((dwCrc And &HFFFFFFFE) / 2&) And &H7FFFFFFF
End If
Next j
crc32Table(i) = dwCrc
Next i
End Sub
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "cBinaryFileStream"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private m_sFile As String
Private m_iFile As Integer
Private m_iLen As Long
Private m_iOffset As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Public Property Get File() As String
File = m_sFile
End Property
Public Property Let File(ByVal sFile As String)
Dispose
m_sFile = sFile
Dim lErr As Long
If (FileExists(m_sFile, lErr)) Then
m_iFile = FreeFile
Open m_sFile For Binary Access Read Lock Write As #m_iFile
m_iLen = LOF(m_iFile)
Else
Err.Raise lErr, App.EXEName & ".File"
End If
End Property
Private Function FileExists(ByVal sFile As String, ByRef lErr As Long) As Boolean
lErr = 0
On Error Resume Next
Dim sDir As String
sDir = Dir(sFile)
lErr = Err.Number
On Error GoTo 0
If (lErr = 0) Then
If (Len(sDir) > 0) Then
FileExists = True
Else
lErr = 53
End If
End If
End Function
Public Property Get Length() As Long
Length = m_iLen
End Property
Public Function Read( _
buffer() As Byte, _
ByVal readSize As Long _
) As Long
Dim lReadSize As Long
lReadSize = readSize
If (m_iOffset + lReadSize >= m_iLen) Then
readSize = m_iLen - m_iOffset
If (readSize > 0) Then
ReDim newBuffer(0 To readSize - 1) As Byte
Get #m_iFile, , newBuffer
CopyMemory buffer(0), newBuffer(0), readSize
Else
Dispose
End If
m_iOffset = m_iOffset + readSize
Else
' Can read
Get #m_iFile, , buffer
m_iOffset = m_iOffset + readSize
End If
Read = readSize
End Function
Public Sub Dispose()
If (m_iFile) Then
Close #m_iFile
m_iFile = 0
End If
End Sub
Private Sub Class_Terminate()
Dispose
End Sub