clscrc.cls

vb做的看图系统

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsCRC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：2007/10/12
'描    述：极速数码照片查看播放工具 Ver 2.02
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************

'CRC Checksum Class
'------------------------------------
'
'A very fast solution to calculate the
'CRC Checksum (at the moment CRC16 and
'CRC32 values) with the help of some
'pre-compiled assembler code
'
'(c) 2000, Fredrik Qvarfort
'

Option Explicit

Public Enum CRCAlgorithms
  CRC16
  CRC32
End Enum
Private m_Algorithm As Boolean

Private m_CRC16 As Long
Private m_CRC16Asm() As Byte
Private m_CRC16Init As Boolean
Private m_CRC16Table(0 To 255) As Long

Private m_CRC32 As Long
Private m_CRC32Asm() As Byte
Private m_CRC32Init As Boolean
Private m_CRC32Table(0 To 255) As Long

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Function AddBytes(ByteArray() As Byte) As Variant

  Dim ByteSize As Long
  
  'We need to add a simple error trapping
  'here because if the bytearray is not
  'dimensioned we want it to just skip
  'the assembler code call below
  On Local Error GoTo NoData
  
  'Precalculate the size of the byte array
  ByteSize = UBound(ByteArray) - LBound(ByteArray) + 1
  
  'No error trapping needed, if something
  'goes bad below something is definitely
  'fishy with your computer
  On Local Error GoTo 0
  
  'Run the pre-compiled assembler code
  'for the current selected algorithm
  Select Case m_Algorithm
  Case CRC16
    Call CallWindowProc(VarPtr(m_CRC16Asm(0)), VarPtr(m_CRC16), VarPtr(ByteArray(LBound(ByteArray))), VarPtr(m_CRC16Table(0)), ByteSize)
  Case CRC32
    Call CallWindowProc(VarPtr(m_CRC32Asm(0)), VarPtr(m_CRC32), VarPtr(ByteArray(LBound(ByteArray))), VarPtr(m_CRC32Table(0)), ByteSize)
  End Select
  
NoData:
  'Return the current CRC value
  AddBytes = Value
  
End Function
Public Function AddString(Text As String) As Variant

  'Convert the string into a byte array
  'and send it to the function that can
  'handle bytearrays
  AddString = AddBytes(StrConv(Text, vbFromUnicode))
  
End Function
Public Property Let Algorithm(New_Value As CRCAlgorithms)

  'Set the new algorithm
  m_Algorithm = New_Value

  'Make sure we have initialized the
  'current selected algorithm
  Select Case m_Algorithm
  Case CRC16
    If (Not m_CRC16Init) Then Call InitializeCRC16
  Case CRC32
    If (Not m_CRC32Init) Then Call InitializeCRC32
  End Select

  'Make sure we reset the data of the
  'current selected algorithm
  Call Clear
  
End Property
Public Property Get Algorithm() As CRCAlgorithms

  Algorithm = m_Algorithm
  
End Property

Public Function CalculateBytes(ByteArray() As Byte) As Variant

  'Reset the current CRC calculation
  Call Clear
  
  'Calculate the CRC from the bytearray
  'and return the current CRC value
  CalculateBytes = AddBytes(ByteArray)
  
End Function

Public Function CalculateFile(FileName As String) As Variant
On Error Resume Next
  Dim Filenr As Integer
  Dim ByteArray() As Byte
  
  'Make sure the file contains data
  'to avoid errors later below
  If (FileLen(FileName) = 0) Then Exit Function
  
  'Open the file in binary mode, read
  'the data into a bytearray and then
  'close the file
  On Error GoTo CalcErrHandler
  Filenr = FreeFile
  Open FileName For Binary As #Filenr
  ReDim ByteArray(0 To LOF(Filenr) - 1)
  Get #Filenr, , ByteArray()
  Close #Filenr
  
  'Now send the bytearray to the function
  'that can calculate a CRC from it
  CalculateFile = CalculateBytes(ByteArray)
  Exit Function
  
CalcErrHandler:
  CalculateFile = "00000000"
End Function
Public Function CalculateString(Text As String)

  'Convert the string into a bytearray
  'and send it to the function that
  'calculates the CRC from a bytearray
  CalculateString = CalculateBytes(StrConv(Text, vbFromUnicode))
  
End Function
Public Property Get Value() As Variant

  Select Case m_Algorithm
  Case CRC16
    Value = (m_CRC16 And 65535)
  Case CRC32
    Value = (Not m_CRC32)
  End Select
  
End Property

Public Property Let Value(New_Value As Variant)

  Select Case m_Algorithm
  Case CRC16
    m_CRC16 = New_Value
  Case CRC32
    m_CRC32 = New_Value
  End Select
  
End Property

Private Sub InitializeCRC16()

  Dim i As Long
  Dim j As Long
  Dim k As Long
  Dim CRC As Long
  Dim sASM As String
  
  'Create the fixed lookup-table, this
  'is calculated because it won't take
  'long and is only done once
  For i = 0 To 255
    k = i * 256
    CRC = 0
    For j = 0 To 7
      If (((CRC Xor k) And 32768) = 32768) Then
        CRC = (CRC * 2) Xor &H1021
      Else
        CRC = (CRC * 2)
      End If
      k = k * 2
    Next
    m_CRC16Table(i) = CRC '(CRC And 65535)
  Next
  
  'Create a bytearray to hold the
  'precompiled assembler code
  sASM = "5589E55756505351528B45088B008B750C8B7D108B4D1431DB8A1E30E3668B149F30C66689D0464975EF25FFFF00008B4D0889015A595B585E5F89EC5DC21000"
  ReDim m_CRC16Asm(0 To Len(sASM) \ 2 - 1)
  For i = 1 To Len(sASM) Step 2
    m_CRC16Asm(i \ 2) = Val("&H" & Mid$(sASM, i, 2))
  Next
  
  'Mark the CRC16 algorithm as initialized
  m_CRC16Init = True
  
End Sub
Public Sub Clear()

  'Here can be sloppy and reset both
  'crc variables (this procedure will
  'be more advanced when adding more
  'checksums algorithms..)
  m_CRC16 = 0
  m_CRC32 = &HFFFFFFFF
  
End Sub

Private Sub InitializeCRC32()

  Dim i As Long
  Dim sASM As String
  
  m_CRC32Table(0) = &H0
  m_CRC32Table(1) = &H77073096
  m_CRC32Table(2) = &HEE0E612C
  m_CRC32Table(3) = &H990951BA
  m_CRC32Table(4) = &H76DC419
  m_CRC32Table(5) = &H706AF48F
  m_CRC32Table(6) = &HE963A535
  m_CRC32Table(7) = &H9E6495A3
  m_CRC32Table(8) = &HEDB8832
  m_CRC32Table(9) = &H79DCB8A4
  m_CRC32Table(10) = &HE0D5E91E
  m_CRC32Table(11) = &H97D2D988
  m_CRC32Table(12) = &H9B64C2B
  m_CRC32Table(13) = &H7EB17CBD
  m_CRC32Table(14) = &HE7B82D07
  m_CRC32Table(15) = &H90BF1D91
  m_CRC32Table(16) = &H1DB71064
  m_CRC32Table(17) = &H6AB020F2