home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / Fast_Strin2133581192008.psc / cFileSearchCRC.cls < prev   
Text File  |  2008-11-09  |  50KB  |  1,363 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "cFileSearchCRC"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. 'CRC Checksum Class
  15. '------------------------------------
  16. '
  17. 'A very fast solution to calculate the
  18. 'CRC Checksum (at the moment CRC16 and
  19. 'CRC32 values) with the help of some
  20. 'pre-compiled assembler code
  21. '
  22. '(c) 2000, Fredrik Qvarfort
  23. '
  24.  
  25. Option Explicit
  26.  
  27. Public Enum CRCAlgorithms
  28.   CRC16
  29.   CRC32
  30. End Enum
  31. Private m_Algorithm As Boolean
  32.  
  33. Private m_CRC16 As Long
  34. Private m_CRC16Asm() As Byte
  35. Private m_CRC16Init As Boolean
  36. Private m_CRC16Table(0 To 255) As Long
  37.  
  38. Private m_CRC32 As Long
  39. Private m_CRC32Asm() As Byte
  40. Private m_CRC32Init As Boolean
  41. Private m_CRC32Table(0 To 255) As Long
  42.  
  43. 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
  44. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal byteLen As Long)
  45.  
  46. '=================================================================================
  47. 'CRC Checksum & String Search Functions
  48. '=================================================================================
  49. '
  50. 'A very fast solution to calculate the CRC Checksum (CRC16 and CRC32 values)
  51. 'and String Searching with the help of some pre-compiled assembler code
  52. '
  53. '(c) 2008, by D.Senthilathiban
  54. 'E-mail:samram20@hotmail.com
  55. 'This code is for Personal usage only! and not to be used for commercial purpose.
  56. '===============================MEMORY MAPPING ===============================
  57. '
  58. 'MEMORY MAPPING APIs----------------------------------------------------------
  59. '
  60. Private Declare Function MapViewOfFile Lib "kernel32.dll" (ByVal hFile As Long, _
  61.                                                            ByVal dwDesiredAccess As Long, _
  62.                                                            ByVal dwFileOffsetHigh As Long, _
  63.                                                            ByVal dwFileOffsetLow As Long, _
  64.                                                            ByVal dwNumberOfBytesToMap As Long) As Long
  65. Private Declare Function CreateFileMapping Lib "kernel32.dll" Alias "CreateFileMappingA" (ByVal hFile As Long, _
  66.                                                            ByVal lpAttributes As Long, ByVal flProtect As Long, _
  67.                                                            ByVal dwMaximumSizeHigh As Long, _
  68.                                                            ByVal dwMaximumSizeLow As Long, _
  69.                                                            ByVal lpName As String) As Long
  70. Private Declare Function UnmapViewOfFile Lib "kernel32.dll" (ByVal lpBaseAddress As Long) As Boolean
  71. 'Private Declare Function ReadFileEx Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, _
  72.                                                     ByVal nNumberOfBytesToRead As Long, _
  73.                                                     lpOverlapped As OVERLAPPED, _
  74.                                                     ByVal lpCompletionRoutine As Long) As Long
  75. 'Private Declare Function FileIOCompletionRoutine Lib "kernel32" (dwErrorCode As Long, _
  76.                                                                  dwNumberOfBytesTransfered As Long, _
  77.                                                                  lpOverlapped As OVERLAPPED)
  78. 'Private Declare Function GetLastError Lib "kernel32" () As Long
  79.  
  80. Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, _
  81.                                                                         ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
  82.                                                                         ByVal lpSecurityAttributes As Long, _
  83.                                                                         ByVal dwCreationDisposition As Long, _
  84.                                                                         ByVal dwFlagsAndAttributes As Long, _
  85.                                                                         ByVal hTemplateFile As Long) As Long
  86. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  87. Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
  88. Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
  89.  
  90. 'USER TYPE -------------------------------------------------------------------
  91. Private Type OVERLAPPED
  92.         Internal As Long
  93.         InternalHigh As Long
  94.         Offset As Long
  95.         OffsetHigh As Long
  96.         hEvent As Long
  97. End Type
  98.  
  99. Private Type MEMORYSTATUS
  100.         dwLength As Long
  101.         dwMemoryLoad As Long
  102.         dwTotalPhys As Long
  103.         dwAvailPhys As Long
  104.         dwTotalPageFile As Long
  105.         dwAvailPageFile As Long
  106.         dwTotalVirtual As Long
  107.         dwAvailVirtual As Long
  108. End Type
  109.  
  110. 'CONSTANTS--------------------------------------------------------------------
  111. Private Const FILE_SHARE_READ = &H1
  112. 'Private Const FILE_SHARE_WRITE = &H2
  113. 'Private Const MOVEFILE_REPLACE_EXISTING = &H1
  114. Private Const FILE_ATTRIBUTE_TEMPORARY = &H100
  115. Private Const FILE_ATTRIBUTE_NORMAL = &H80
  116. Private Const FILE_BEGIN = 0
  117. Private Const CREATE_NEW = 1
  118. Private Const OPEN_EXISTING = 3
  119. Private Const OPEN_ALWAYS = 4
  120. Private Const GENERIC_READ = &H80000000
  121. Private Const GENERIC_WRITE = &H40000000
  122. Private Const GENERIC_READWRITE = &HC0000000
  123. Private Const PAGE_READWRITE = &H4
  124. Private Const FILE_MAP_WRITE = &H2
  125. Private Const FILE_MAP_READ = &H4
  126. Private Const FILE_MAP_READWRITE = &H6
  127. 'Private Const FADF_FIXEDSIZE = &H10
  128. Private Const PAGE_READONLY = &H2
  129. Private Const INVALIDHANDLE = -1
  130. Private Const CLOSEDHANDLE = 0
  131. 'MEMORY MAPPED FILE VARIABLES-------------------------------------------------
  132. Private hFile As Long       'HANDLE TO FILE
  133. Private hFileMap As Long    'HANDLE TO FILE MAPPING
  134. Private hMapView As Long    'HANDLE TO MAP VIEW
  135. Private mBaseAddr As Long   'FILE POINTER = HANDLE TO MAP VIEW
  136. Private mFileSize As Long   'SIZE OF THE MEMORY MAPPED FILE
  137. '=============================================================================
  138.  
  139. '===============================STRING MAPPING ===============================
  140. ' Thanks to Chris Lucas for the String mapping Concepts.
  141.  
  142. Private Declare Function ArrPtr& Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any)
  143. Private Declare Function lstrlenW Lib "kernel32" (ByVal psString As Any) As Long
  144.  
  145. Private strHeader(5) As Long        ' Header for the StringArray Map
  146. Private patHeader(5) As Long        ' Header for the PatternArray Map
  147.  
  148. 'Character string array = 2 Bytes per element for UNICODE Char
  149. Private strArrayW() As Integer      ' Maps onto the Text's string
  150. Private patArrayW() As Integer      ' Maps onto the Pattern's string
  151.  
  152. 'Private UB_strArrayW  As Long       ' UBound size of strArrayW()
  153. 'Private UB_patArrayW  As Long       ' UBound size of patArrayW()
  154.  
  155. 'Character string array = 1 Byte per element for ANSI Char
  156. Private strArrayB() As Byte         ' Maps onto the Text's string
  157. Private patArrayB() As Byte         ' Maps onto the Pattern's string
  158.  
  159. 'Private UB_strArrayB  As Long       ' UBound size of strArrayB()
  160. 'Private UB_patArrayB  As Long       ' UBound size of patArrayB()
  161.  
  162. Private m_StrBuffer As String      ' variable to hold string to search in
  163. 'Private m_PatBuffer As String      ' variable to hold Pattern string to search for
  164. '=============================================================================
  165.  
  166. '===============================STRING SEARCHING==============================
  167. ' (c) 2008, by D.Senthilathiban, E-mail:samram20@hotmail.com
  168. ' ******************************* WARNING ************************************
  169. ' The code is tested for binary comparison with ANSI code input only.UNICODE
  170. ' character input and strings have ligatures are not tested. It is upto the
  171. ' user to test the code with UNICODE/special character input and validate.
  172. ' It is assumed that the pattern text length always small in size hence the
  173. ' pattern string is converted into byte array using VB in-built functions.
  174. ' ****************************************************************************
  175.  
  176. Public Enum eSearchAlgorithms
  177.         Asm_BMHA 'Boyer-Moore horspool string searching Algorithm-Assembly code
  178.         Asm_STRC 'C language StrStr String searching Algorithm   -Assembly code
  179.         Asm_BYTE 'Byte by byte string searching using Assembly string instruction
  180.         Vb_BMHA  'Boyer-Moore horspool string searching Algorithm-Vb Native code
  181.         Vb_InStr 'Visual basic Instr function
  182.         'Vb_InStrMAP 'Visual basic Instr function
  183. End Enum
  184.  
  185. Public Enum eCharCode
  186.         ANSISTD_CHAR 'ASCII character set (1 byte per char 0-255)
  187.         UNICODE_CHAR 'UniCode character set (2 byte per char 0 to 65,535)
  188.         'DEFAULT_CHAR 'check the sting and set ASCII OR UniCode character set
  189.         'DBCSSTD_CHAR 'double byte char set
  190. End Enum
  191. Private m_SearchAlgorithm As eSearchAlgorithms
  192. Private m_MyFindAlgorithm As eSearchAlgorithms
  193. Private m_BMHA32Asm() As Byte
  194. Private m_BYTE32Asm() As Byte
  195. Private m_STRC32Asm() As Byte
  196.  
  197. Private m_BMHA32Init As Boolean
  198. Private m_BYTE32Init As Boolean
  199. Private m_STRC32Init As Boolean
  200.  
  201. Private m_Skip32Table(0 To 255) As Long
  202. Private m_PatData(0 To 2) As Long
  203. Private m_PatArray() As Byte
  204. Private m_PatString As String
  205. Private m_PatLength As Long
  206. Private m_PatFormat As eCharCode
  207. Private m_PatChrLen As Long
  208. '
  209. '
  210. '====================================================================================
  211.  
  212. Private Function CloseMapFile()
  213.     
  214.         UnmapViewOfFile hMapView
  215.         CloseHandle hFileMap
  216.         CloseHandle hFile
  217.         hMapView = CLOSEDHANDLE
  218.         hFileMap = CLOSEDHANDLE
  219.         hFile = INVALIDHANDLE
  220.         mBaseAddr = CLOSEDHANDLE
  221.         mFileSize = CLOSEDHANDLE
  222.         
  223. End Function
  224.  
  225. Sub FileMapSearchCRC(ByVal FileName As String, ByVal SearchText As String, ByRef strCRC As String, ByRef strFound As Boolean)
  226.  
  227. Dim bOpenMap As Boolean
  228.  
  229. strCRC = ""
  230. strFound = False
  231. Clear 'clear old CRC value stored in the variable m_CRC16 or m_CRC32
  232. mFileSize = FileLen(FileName) 'Find the length of the target file.
  233.  
  234. If mFileSize > 0 Then
  235.     '===========================================================================
  236.     '*************************FILE MAPPING**************************************
  237.     '===========================================================================
  238.     'JUST MAP THE FILE AND GET THE FILE BASE ADDRESS IN THE VIRTUAL MEMORY SPACE.
  239.     'SAY GOOD BYE FOR BYTE ARRAY MEMORY ALLOCATION & MOVING CHUNK INTO THE ARRAY.
  240.     'SO OBVIOUSLY WE HAVE SAVED THE PROCESSOR TIME,HUGE MEMORY SPACE.
  241.     hFile = CreateFile(FileName, GENERIC_READ, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
  242.     hFileMap = CreateFileMapping(hFile, 0, PAGE_READONLY, 0, 0, vbNullString)
  243.     hMapView = MapViewOfFile(hFileMap, FILE_MAP_READ, 0, 0, 0)
  244.     'hFile = CreateFile(FileName, GENERIC_READWRITE, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
  245.     'hFileMap = CreateFileMapping(hFile, 0, PAGE_READWRITE, 0, 0, 0) ' vbNullString)
  246.     'hMapView = MapViewOfFile(hFileMap, FILE_MAP_READWRITE, 0, 0, 0)
  247.     '===========================================================================
  248.  
  249.     If hMapView <> CLOSEDHANDLE Then
  250.         
  251.        mBaseAddr = hMapView
  252.        bOpenMap = True 'SET TRUE IF THE FILE IS MAPPED
  253.        'Set error trapping incase any error
  254.        On Local Error GoTo NoData
  255.       
  256.       'Run the pre-compiled assembler code
  257.       'for the current selected algorithm
  258.       Select Case m_Algorithm
  259.       
  260.         Case CRC16
  261.         
  262.         Call CallWindowProc(VarPtr(m_CRC16Asm(0)), VarPtr(m_CRC16), _
  263.                             ByVal mBaseAddr, VarPtr(m_CRC16Table(0)), mFileSize)
  264.       
  265.         Case CRC32
  266.         
  267.         Call CallWindowProc(VarPtr(m_CRC32Asm(0)), VarPtr(m_CRC32), _
  268.                             ByVal mBaseAddr, VarPtr(m_CRC32Table(0)), mFileSize)
  269.       
  270.       End Select
  271.     
  272.     End If
  273.  
  274. Else
  275.     
  276.     strCRC = "00000000"
  277.     strFound = False
  278.     'If InstrFIND(SearchText) > 0 Then
  279.     '    strFound = False
  280.     '    strCRC = Right$(strCRC & Hex$(Value), 8)
  281.     'End If
  282.     Exit Sub
  283.     
  284. End If
  285.  
  286. NoData:
  287.  
  288.   'Return the current CRC value
  289.   strCRC = "00000000"
  290.   strFound = False
  291.   If bOpenMap = True Then
  292.         If InstrFIND(SearchText) > 0 Then
  293.             strFound = True
  294.             strCRC = Right$(strCRC & Hex$(Value), 8)
  295.         End If
  296.   End If
  297.   CloseMapFile 'close the handle
  298.   
  299. End Sub
  300.  
  301. Public Function FileMapCRC(ByVal FileName As String) As String
  302.  
  303. Dim bOpenMap As Boolean
  304.  
  305.  
  306. Clear 'clear old CRC value stored in the variable m_CRC16 or m_CRC32
  307. mFileSize = FileLen(FileName) 'Find the length of the target file.
  308.  
  309. If mFileSize > 0 Then
  310.     '===========================================================================
  311.     '*************************FILE MAPPING**************************************
  312.     '===========================================================================
  313.     'JUST MAP THE FILE AND GET THE FILE BASE ADDRESS IN THE VIRTUAL MEMORY SPACE.
  314.     'SAY GOOD BYE FOR BYTE ARRAY MEMORY ALLOCATION & MOVING CHUNK INTO THE ARRAY.
  315.     'SO OBVIOUSLY WE HAVE SAVED THE PROCESSOR TIME,HUGE MEMORY SPACE.
  316.     hFile = CreateFile(FileName, GENERIC_READ, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
  317.     hFileMap = CreateFileMapping(hFile, 0, PAGE_READONLY, 0, 0, vbNullString)
  318.     hMapView = MapViewOfFile(hFileMap, FILE_MAP_READ, 0, 0, 0)
  319.     '===========================================================================
  320.     
  321.     If hMapView <> CLOSEDHANDLE Then
  322.        mBaseAddr = hMapView
  323.        bOpenMap = True 'SET TRUE IF THE FILE IS MAPPED
  324.        'Set error trapping incase any error
  325.        On Local Error GoTo NoData
  326.       
  327.       'Run the pre-compiled assembler code
  328.       'for the current selected algorithm
  329.       Select Case m_Algorithm
  330.       
  331.         Case CRC16
  332.         
  333.         Call CallWindowProc(VarPtr(m_CRC16Asm(0)), VarPtr(m_CRC16), _
  334.                             ByVal mBaseAddr, VarPtr(m_CRC16Table(0)), mFileSize)
  335.       
  336.         Case CRC32
  337.         
  338.         Call CallWindowProc(VarPtr(m_CRC32Asm(0)), VarPtr(m_CRC32), _
  339.                             ByVal mBaseAddr, VarPtr(m_CRC32Table(0)), mFileSize)
  340.       
  341.       End Select
  342.     
  343.     End If
  344.  
  345. Else
  346.     
  347.     FileMapCRC = "00000000"
  348.     Exit Function
  349.     
  350. End If
  351.  
  352. NoData:
  353.   'Return the current CRC value
  354.   FileMapCRC = Right$("00000000" & Hex$(Value), 8)
  355.   CloseMapFile 'close the handle
  356.   
  357. End Function
  358.  
  359. Public Function FileMapSearch(ByVal FileName As String, ByVal SearchText As String) As Long
  360.  
  361. FileMapSearch = 0
  362. mFileSize = FileLen(FileName) 'Find the length of the target file.
  363.  
  364. If mFileSize > 0 Then
  365.     '===========================================================================
  366.     '*************************FILE MAPPING**************************************
  367.     '===========================================================================
  368.     'JUST MAP THE FILE AND GET THE FILE BASE ADDRESS IN THE VIRTUAL MEMORY SPACE.
  369.     'SAY GOOD BYE FOR BYTE ARRAY MEMORY ALLOCATION & MOVING CHUNK INTO THE ARRAY.
  370.     'SO OBVIOUSLY WE HAVE SAVED THE PROCESSOR TIME,HUGE MEMORY SPACE.
  371.     hFile = CreateFile(FileName, GENERIC_READ, 0, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
  372.     hFileMap = CreateFileMapping(hFile, 0, PAGE_READONLY, 0, 0, vbNullString)
  373.     hMapView = MapViewOfFile(hFileMap, FILE_MAP_READ, 0, 0, 0)
  374.     '===========================================================================
  375.     'Set error trapping incase any error
  376.     On Local Error GoTo NoData
  377.     
  378.     If hMapView <> CLOSEDHANDLE Then
  379.        mBaseAddr = hMapView
  380.        FileMapSearch = InstrFIND(SearchText, 1, ANSISTD_CHAR)
  381.     End If
  382.  
  383. Else
  384.     
  385.     FileMapSearch = 0
  386.     Exit Function
  387.     
  388. End If
  389.  
  390. NoData:
  391.   CloseMapFile 'close the handle
  392.   
  393. End Function
  394.  
  395. Private Function InstrFIND(ByVal msText As String, Optional ByVal StartAt As Long = 1, Optional chrFormat As eCharCode = ANSISTD_CHAR) As Long
  396.  
  397. Dim Offset As Long
  398.  
  399. 'On Error Resume Next
  400.  
  401.     If Len(msText) = 0 Then
  402.         InstrFIND = 1
  403.         Exit Function
  404.     End If
  405.     
  406.     If mFileSize = 0 Then
  407.         InstrFIND = 0
  408.         Exit Function
  409.     End If
  410.     'm_SearchAlgorithm = Asm_BMHA
  411.     'verify any change is happed in pattern text or in text format or in Search Algorithm
  412.     If m_PatString <> msText Or m_PatFormat <> chrFormat Or m_SearchAlgorithm <> m_MyFindAlgorithm Then
  413.         m_PatString = msText
  414.         m_PatFormat = chrFormat
  415.         m_PatChrLen = chrFormat + 1
  416.         m_MyFindAlgorithm = m_SearchAlgorithm
  417.         'Initialize the pattern
  418.         InitializePattern chrFormat
  419.         'Boyer-Moore horspool Algorithm skip table
  420.         'InitializeSkip32  'chrFormat
  421.     End If
  422.     
  423.     'reduce 1 from startAt as the byteArray is assumed to start at index 0
  424.     If StartAt < 1 Then StartAt = 1
  425.     Offset = StartAt - 1
  426.     'Run the pre-compiled assembler code
  427.     
  428.     Select Case m_SearchAlgorithm
  429.       
  430.         Case Asm_BMHA
  431.           
  432.           'Boyer-Moore horspool string searching Algorithm' for patlength > 2
  433.           'Assembly string instruction used for the string searching upto patlength<=2
  434.             Call CallWindowProc(VarPtr(m_BMHA32Asm(0)), VarPtr(m_PatData(0)), ByVal (mBaseAddr + Offset), _
  435.                                 VarPtr(m_Skip32Table(0)), (mFileSize - Offset))
  436.                         
  437.         Case Asm_STRC
  438.           'C language StrStr String searching Algorithm' for patlength > 1
  439.           'Assembly string instruction for the string searching upto patlength=1
  440.             Call CallWindowProc(VarPtr(m_STRC32Asm(0)), VarPtr(m_PatData(0)), ByVal (mBaseAddr + Offset), _
  441.                                 ByVal 0&, (mFileSize - Offset))
  442.         
  443.         Case Asm_BYTE
  444.           'Byte by byte string searching using Assembly string instruction for any patlength
  445.             Call CallWindowProc(VarPtr(m_BYTE32Asm(0)), VarPtr(m_PatData(0)), ByVal (mBaseAddr + Offset), _
  446.                                 ByVal 0&, (mFileSize - Offset))
  447.                         
  448.         Case Vb_BMHA
  449.         
  450.             strHeader(3) = mBaseAddr  'pointer to MMF '= StrPtr(m_StrBuffer)' Pointer to StrArray
  451.             strHeader(4) = mFileSize  'MMF Size '=  String Array size (max= &H7FFFFFFF)
  452.             m_PatData(2) = SearchBMH(StartAt)
  453.         
  454.         Case Vb_InStr
  455.           'Vb Native function
  456.             strHeader(3) = mBaseAddr '= StrPtr(m_StrBuffer)' Pointer to StrArray
  457.             strHeader(4) = mFileSize  ' String Array size (max= &H7FFFFFFF)
  458.             '===========================================================================
  459.             '**************WARNING*************WARNING**************WARNING*************
  460.             '===========================================================================
  461.             'THE VB IDE MAY CRASH AT THIS LOCATION IF THE SIZE OF MEMORY MAPPED FILE(MMF)
  462.             'IS VERY LARGE. ALSO WE LOST THE PORPOSE OF USING MEMORY MAPPED FILE POINTER
  463.             'BECAUSE THE 'StrConv' FUNCTION CONVERTS THE WHOLE BYTE ARRAY BACK TO STRING
  464.             'BY ALLOCATING REQD MEMOREY SIZE & MOVES ALL THE CHARS INTO STRING VARIABLE.
  465.             'SO OBVIOUSLY WE HAVE WASTED THE PROCESSOR TIME,HUGE MEMORY SPACE.
  466.             m_StrBuffer = StrConv(strArrayB, vbUnicode) 'convert byte array to string
  467.             '===========================================================================
  468.             m_PatData(2) = InStr(StartAt, m_StrBuffer, m_PatString)
  469.             
  470.       End Select
  471.     
  472.     If StopSearch = True Then 'flag to triminate the process
  473.             InstrFIND = 0
  474.             '=====================================================================
  475.             'incase user teriminates the loop this must execute else IDE will crash
  476.             TerminateHeaders
  477.             '=====================================================================
  478.             Exit Function
  479.     End If
  480.     
  481.     InstrFIND = m_PatData(2)
  482.     
  483. End Function
  484.  
  485.  
  486. Private Function ValidateContainedText(ByVal msText As String) As Boolean
  487.     
  488.     If Len(msText) = 0 Then
  489.         ValidateContainedText = True
  490.         Exit Function
  491.     End If
  492.     
  493.     If mFileSize = 0 Then
  494.         ValidateContainedText = False
  495.         Exit Function
  496.     End If
  497.     
  498.     On Error Resume Next
  499.     
  500.     Dim lbFirstTime As Boolean
  501.     Dim lsWide As String
  502.     Dim myMainArray() As Byte
  503.     Dim chunkSize As Long
  504.     Dim readSize As Long
  505.     Dim leftSize As Long
  506.     Dim Offset As Long
  507.     Dim miDoubleTextLen As Long
  508.     
  509.     Offset = 0
  510.     chunkSize = 65536 '65536=64kb'104857600 '100 * 1024 * 1024
  511.     miDoubleTextLen = Len(StrConv(msText, vbUnicode))  ' Len(msText) * 2
  512.     If chunkSize < miDoubleTextLen Then chunkSize = miDoubleTextLen
  513.     lbFirstTime = True
  514.     
  515.     If mFileSize > chunkSize Then
  516.         readSize = chunkSize
  517.         leftSize = mFileSize - readSize
  518.     Else
  519.         readSize = mFileSize
  520.         leftSize = 0
  521.     End If
  522.     
  523.     Do While (readSize > 0 Or leftSize > 0)
  524.                 If lbFirstTime Then
  525.                     lbFirstTime = False
  526.                     ReDim myMainArray(0 To readSize - 1)
  527.                     CopyMemory myMainArray(0), ByVal (mBaseAddr + Offset), readSize
  528.                     Offset = Offset + readSize - miDoubleTextLen
  529.                     If leftSize = 0 Then readSize = 0
  530.                 Else
  531.                     If (leftSize + miDoubleTextLen) > chunkSize Then
  532.                         ''''pending''''''''''''''''''''''''
  533.                         readSize = chunkSize
  534.                         ReDim myMainArray(0 To readSize - 1) 'clear past data
  535.                         CopyMemory myMainArray(0), ByVal (mBaseAddr + Offset), readSize
  536.                         leftSize = (leftSize + miDoubleTextLen) - chunkSize
  537.                         Offset = Offset + readSize - miDoubleTextLen
  538.                     Else
  539.                         ''''''pending''''''''''''''''''''''''
  540.                         readSize = (leftSize + miDoubleTextLen)
  541.                         ReDim myMainArray(0 To readSize - 1) 'clear past data
  542.                         CopyMemory myMainArray(0), ByVal (mBaseAddr + Offset), readSize
  543.                         leftSize = 0: readSize = 0 'flag to exit loop
  544.                     End If
  545.                 End If
  546.                 
  547.                 lsWide = StrConv(myMainArray, vbUnicode)
  548.                 If InStr(1, myMainArray, msText, vbTextCompare) > 0 Then
  549.                         ValidateContainedText = True
  550.                         Exit Do
  551.                 End If
  552.                  If InStr(1, lsWide, msText, vbTextCompare) > 0 Then
  553.                         ValidateContainedText = True
  554.                         Exit Do
  555.                 End If
  556.     Loop
  557.         
  558. End Function
  559.  
  560.  
  561. Public Function ByteArrayToString(ByteArray() As Byte) As String
  562.     Dim strResult As String
  563.     Dim lngPos As Long
  564.     
  565.     strResult = StrConv(ByteArray, vbUnicode)
  566.     lngPos = InStr(strResult, Chr(0))
  567.     If lngPos > 0 Then strResult = Left(strResult, lngPos - 1)
  568.     
  569.     ByteArrayToString = strResult
  570.  
  571.  End Function
  572.  
  573. Private Sub InitializeHeaders()
  574.  
  575.     ' Set TextArrayHeader for search in strings
  576.     strHeader(0) = 1              ' Number of dimensions
  577.     strHeader(1) = m_PatChrLen    ' Bytes per element (= 2 for integer)/(= 1 for byte)
  578.     'strHeader(2) = '
  579.     'strHeader(3) = mBaseAddr'= StrPtr(m_StrBuffer)' Pointer to StrArray
  580.     'strHeader(4) = mFileSize  ' String Array size (max= &H7FFFFFFF)
  581.     ' set strArray to use strHeader as its own header
  582.     CopyMemory ByVal ArrPtr(strArrayW), VarPtr(strHeader(0)), 4 ' Word Array
  583.     CopyMemory ByVal ArrPtr(strArrayB), VarPtr(strHeader(0)), 4 ' Byte Array
  584.     
  585.     ' Set PatArrayHeader to look at the search text
  586.     patHeader(0) = 1              ' Number of dimensions
  587.     patHeader(1) = m_PatChrLen    ' Bytes per element (= 2 for integer)/(= 1 for byte)
  588.     'patHeader(2) = '
  589.     patHeader(3) = m_PatData(0)   ' Pointer to pattern array 'StrPtr(m_PatBuffer)
  590.     patHeader(4) = m_PatLength    ' Pattern Array size (max= &H7FFFFFFF)
  591.     ' Set patArray to use patHeader as its own header
  592.     CopyMemory ByVal ArrPtr(patArrayW), VarPtr(patHeader(0)), 4 ' Word Array
  593.     CopyMemory ByVal ArrPtr(patArrayB), VarPtr(patHeader(0)), 4 ' Byte Array
  594.     'convert byte array to string
  595.     'm_PatBuffer = StrConv(m_PatArray, vbUnicode)
  596.     'm_PatBuffer = m_PatString
  597.     m_StrBuffer = ""             ' dummy string to hold Text string to search in
  598.     'm_PatBuffer = ""             ' dummy string to hold Pattern string to search for
  599.     
  600. End Sub
  601.  
  602. Private Sub TerminateHeaders()
  603.     ' Set back strArray and patArray to use their own headers
  604.     
  605.     ' If this code doesn't run the IDE will crash
  606.     CopyMemory ByVal ArrPtr(strArrayW), 0&, 4
  607.     CopyMemory ByVal ArrPtr(patArrayW), 0&, 4
  608.     
  609.     CopyMemory ByVal ArrPtr(strArrayB), 0&, 4
  610.     CopyMemory ByVal ArrPtr(patArrayB), 0&, 4
  611.     
  612. End Sub
  613.  
  614. Private Sub InitializePattern(Optional charFormat As eCharCode = ANSISTD_CHAR)
  615.  
  616.    m_PatLength = Len(m_PatString)
  617.    If m_PatLength > 0 Then
  618.    'If m_PatString <> "" Then
  619.       
  620.       If charFormat = ANSISTD_CHAR Then
  621.       'METHOD-1
  622.             'm_PatLength = Len(m_PatString)
  623.             ReDim m_PatArray(m_PatLength - 1)
  624.             'If Not CaseSensitive Then m_PatString = StrConv(m_PatString, vbLowerCase)
  625.             '==================================
  626.             m_PatArray = StrConv(m_PatString, vbFromUnicode)
  627.             '==================================
  628.       'METHOD-2
  629.             'm_PatArray = StrConv(m_PatString, vbFromUnicode)
  630.             'm_PatLength = UBound(m_PatArray) + 1
  631.       ElseIf charFormat = UNICODE_CHAR Then
  632.       'METHOD-1
  633.             m_PatArray = m_PatString 'set String pointer to m_PatArray
  634.             m_PatLength = UBound(m_PatArray) + 1 'OR = m_PatLength * 2
  635.       'METHOD-2
  636.             'm_PatLength = LenB(m_PatString)'OR = m_PatLength * 2
  637.             'ReDim m_PatArray(m_PatLength - 1)
  638.             'CopyMemory m_PatArray(0), ByVal StrPtr(m_PatString), m_PatLength
  639.       End If
  640.       
  641.       'set the input/output variables
  642.       m_PatData(0) = VarPtr(m_PatArray(0))  'ptrPatArray(0)
  643.       m_PatData(1) = CLng(m_PatLength - 1)  'PatLength-1
  644.       m_PatData(2) = CLng(0)                'Default Match Location = 0 (no Match)
  645.       
  646.       If m_SearchAlgorithm = Asm_BMHA Then
  647.             'set skip table for Boyer-Moore horspool String searching Algorithm
  648.             InitializeSkip32
  649.       ElseIf m_SearchAlgorithm = Vb_BMHA Then
  650.       'set skip table for Boyer-Moore horspool String searching Algorithm
  651.             InitializeSkip32
  652.             InitializeHeaders
  653.       ElseIf m_SearchAlgorithm = Vb_InStr Then
  654.             'set safe array headers to map the String in byte or Integer array
  655.             InitializeHeaders
  656.       End If
  657.       
  658.    End If
  659.  
  660. End Sub
  661.  
  662. Private Sub InitializeSkip32()
  663.  
  664. Dim k As Long
  665.  
  666.    If m_PatLength > 0 Then
  667.             'set skip table for Boyer-Moore horspool String searching Algorithm
  668.             For k = 0 To 255
  669.                m_Skip32Table(k) = CLng(m_PatLength - 1)
  670.             Next k
  671.             For k = 0 To m_PatLength - 2
  672.                m_Skip32Table(m_PatArray(k)) = CLng(m_PatLength - k - 1)
  673.             Next k
  674.    End If
  675.  
  676. End Sub
  677.  
  678. Public Function IsUnicode(msText As String) As Boolean
  679.    Dim i As Long
  680.    Dim lngByteSize As Long
  681.    Dim MapStringArray() As Byte
  682.    'msText = msText & ChrW(&H6B22)
  683.    If LenB(msText) Then
  684.       MapStringArray = msText 'set pointer
  685.       'CHECK EACH WIDECHAR HI BYTE VALUE
  686.       lngByteSize = UBound(MapStringArray)
  687.       For i = 1 To lngByteSize Step 2
  688.          If (MapStringArray(i) > 0) Then
  689.             IsUnicode = True
  690.             Exit Function
  691.          End If
  692.       Next
  693.    End If
  694. End Function
  695.  
  696. Private Function SearchBMH(ByVal StartAt As Long) As Long
  697. Dim i As Long
  698. Dim j As Long
  699. Dim k As Long
  700.  
  701.    SearchBMH = 0&
  702.    i = CLng(StartAt + m_PatLength - 2)
  703.    
  704.    If m_PatLength > 1 Then
  705.    
  706.         Do While i < mFileSize
  707.            k = m_PatLength - 1
  708.            j = i
  709.            Do While strArrayB(j) = patArrayB(k)
  710.               If k = 0 Then
  711.                  SearchBMH = j + 1&
  712.                  Exit Function
  713.               End If
  714.               k = k - 1&
  715.               j = j - 1&
  716.            Loop
  717.            i = i + m_Skip32Table(strArrayB(i))
  718.         Loop
  719.         
  720.    ElseIf m_PatLength = 1 Then
  721.         
  722.         k = m_PatLength - 1
  723.         Do While i < mFileSize
  724.            'k = m_PatLength - 1
  725.            j = i
  726.            If strArrayB(j) = patArrayB(k) Then
  727.                  SearchBMH = j + 1&
  728.                  Exit Function
  729.            End If
  730.            i = i + 1 'm_Skip32Table(strArrayB(i))
  731.         Loop
  732.    
  733.    End If
  734.    
  735. End Function
  736.  
  737. Public Property Let SearchAlgorithm(New_Value As eSearchAlgorithms)
  738.  
  739.   'Set the new algorithm
  740.   m_SearchAlgorithm = New_Value
  741.  
  742.   'Make sure we have initialized the
  743.   'current selected algorithm
  744.   Select Case m_SearchAlgorithm
  745.     Case Asm_BMHA
  746.         If (Not m_BMHA32Init) Then Call InitializeBMHA32
  747.     Case Asm_STRC
  748.         If (Not m_STRC32Init) Then Call InitializeSTRC32
  749.     Case Asm_BYTE
  750.         If (Not m_BYTE32Init) Then Call InitializeBYTE32
  751.   End Select
  752.  
  753.   'Make sure we reset the data of the
  754.   'current selected algorithm
  755.   Call ClearPatData
  756.   
  757. End Property
  758.  
  759. Public Property Get SearchAlgorithm() As eSearchAlgorithms
  760.  
  761.   SearchAlgorithm = m_SearchAlgorithm
  762.   
  763. End Property
  764.  
  765. Public Function CalculateFileCRC(ByVal strFilePath As String) As String
  766. Dim bArrayFile() As Byte
  767. Dim lngCRC32 As Long
  768. Dim lngChunkSize As Long
  769. Dim lngSize As Long
  770. Dim lngReadPos As Long
  771. Dim FileNo
  772. On Local Error GoTo NoData
  773.  
  774. lngSize = FileLen(strFilePath)
  775. lngChunkSize = 4096 '=4kb '65536=64kb'
  776.  
  777. If lngSize <> 0 Then
  778.     ' Read byte array from file
  779.     FileNo = FreeFile
  780.     Open strFilePath For Binary Access Read As #FileNo
  781.     Clear 'clear old CRC value
  782.     lngReadPos = Seek(FileNo)
  783.     Do While lngReadPos < lngSize
  784.         If (lngSize - lngReadPos) > lngChunkSize Then
  785.             Do While lngReadPos < (lngSize - lngChunkSize)
  786.                 ReDim bArrayFile(lngChunkSize - 1)
  787.                 Get #FileNo, , bArrayFile()
  788.                 'Calculate the current chunk
  789.                 lngCRC32 = AddBytes(bArrayFile)
  790.                 Select Case m_Algorithm
  791.                     Case CRC16
  792.                       Value = m_CRC16 Or lngCRC32 'Setback last actual checksum
  793.                     Case CRC32
  794.                       Value = Not lngCRC32        'Setback last actual checksum
  795.                 End Select
  796.                 DoEvents
  797.                 If StopSearch = True Then 'flag to triminate the process
  798.                     CalculateFileCRC = "00000000"
  799.                     Close #FileNo
  800.                     Exit Function
  801.                 End If
  802.                 lngReadPos = Seek(FileNo)
  803.             Loop
  804.         Else
  805.             ReDim bArrayFile(lngSize - lngReadPos)
  806.             Get #FileNo, , bArrayFile()
  807.             lngCRC32 = AddBytes(bArrayFile)
  808.             Select Case m_Algorithm
  809.                     Case CRC16
  810.                       Value = m_CRC16 Or lngCRC32 'Setback last actual checksum
  811.                     Case CRC32
  812.                       Value = Not lngCRC32        'Setback last actual checksum
  813.             End Select
  814.             'lngCRC32 = AddBytes(bArrayFile)
  815.         End If
  816.         DoEvents
  817.     lngReadPos = Seek(FileNo)
  818.     Loop
  819.  
  820.     Close #FileNo
  821.     
  822.     lngCRC32 = Value
  823. NoData:
  824.     CalculateFileCRC = Right$("00000000" & Hex$(lngCRC32), 8)
  825. Else
  826.     CalculateFileCRC = "00000000"
  827. End If
  828.  
  829. End Function
  830.  
  831. Public Sub ClearPatData()
  832.  
  833.   'reset all variables
  834.   m_PatData(0) = 0
  835.   m_PatData(1) = 0
  836.   m_PatData(2) = 0
  837. End Sub
  838.  
  839.  
  840. Private Sub InitializeBMHA32()
  841.  
  842.   Dim i As Long
  843.   Dim sASM As String
  844.  
  845.   'Create a bytearray to hold the
  846.   'precompiled assembler code
  847.   sASM = "5589E55756505351528B45088B750C8B7D108B500481FA010000007E3A31DB31C93B55147D738B45088B58048B0089D18A04188A240E38E0751181FB0000000074644B498B45088B00EBE531C08A04168B048701C2EBCAFC8B008B7D0C89FE8B4D1481FA01000000751E81F9020000007C27668B00F2AE67E31F3A2775F74F89F929F1E91E0000008A00F2AE67E30A4F89F929F1E90D0000008B450831DB895808E907000000418B45088948085A595B585E5F89EC5DC21000"
  848.  
  849.   ReDim m_BMHA32Asm(0 To Len(sASM) \ 2 - 1)
  850.   For i = 1 To Len(sASM) Step 2
  851.     m_BMHA32Asm(i \ 2) = Val("&H" & Mid$(sASM, i, 2))
  852.   Next
  853.   
  854.   'Mark the BMH32 algorithm as initialized
  855.   m_BMHA32Init = True
  856.  
  857. End Sub
  858.  
  859. Private Sub InitializeBYTE32()
  860.  
  861.   Dim i As Long
  862.   Dim sASM As String
  863.  
  864.   'Create a bytearray to hold the
  865.   'precompiled assembler code
  866.    sASM = "5589E55756505351528B45088B750C8B4D148B388B500442FC89FB89F039CA7F1989D1F3A674204089C689F12B4D0C01D13B4D147F0489DFEBE78B450831DB895808E90C00000089C12B4D0C418B45088948085A595B585E5F89EC5DC21000"
  867.   ReDim m_BYTE32Asm(0 To Len(sASM) \ 2 - 1)
  868.   For i = 1 To Len(sASM) Step 2
  869.     m_BYTE32Asm(i \ 2) = Val("&H" & Mid$(sASM, i, 2))
  870.   Next
  871.   
  872.   'Mark the BYTE32 algorithm as initialized
  873.   m_BYTE32Init = True
  874.  
  875. End Sub
  876.  
  877. Private Sub InitializeSTRC32()
  878.  
  879.   Dim i As Long
  880.   Dim sASM As String
  881.  
  882.   'Create a bytearray to hold the
  883.   'precompiled assembler code
  884.   sASM = "5589E55756505351528B45088B7D0C8B088B58044381FB010000007F2D31C089FE8B5D148A21FCAC38E0740E4B81FB0000000075F2E99500000089F12B4D0C8B4508894808E9A10000008A118A710189FE8B4D088B5904438B098A074638D0742589F02B450C01D83B45147F6231C08A064638D0741089F02B450C01D83B45147F4D31C0EBE98A064638F075E58D7EFF81FB0200000074448A61028A0681C60200000038E075A881FB03000000742D8A41038A66FF38E0759681C10200000081EB0200000081FB02000000740FEBC98B450831DB895808E90F0000008D47FF89C12B4D0C418B45088948085A595B585E5F89EC5DC21000"
  885.  
  886.   ReDim m_STRC32Asm(0 To Len(sASM) \ 2 - 1)
  887.   For i = 1 To Len(sASM) Step 2
  888.     m_STRC32Asm(i \ 2) = Val("&H" & Mid$(sASM, i, 2))
  889.   Next
  890.   
  891.   'Mark the StrStr C algorithm as initialized
  892.   m_STRC32Init = True
  893.  
  894. End Sub
  895.  
  896. Private Sub Class_Initialize()
  897.     
  898.   hFile = INVALIDHANDLE
  899.   hFileMap = CLOSEDHANDLE
  900.   hMapView = CLOSEDHANDLE
  901.   mBaseAddr = CLOSEDHANDLE
  902.   mFileSize = CLOSEDHANDLE
  903.   Algorithm = CRC32 'The default algorithm is CRC32
  904.   If (Not m_BYTE32Init) Then Call InitializeBYTE32
  905.   If (Not m_STRC32Init) Then Call InitializeSTRC32
  906.   If (Not m_BMHA32Init) Then Call InitializeBMHA32
  907.   'InitializeHeaders
  908.   SearchAlgorithm = Asm_BMHA 'The default algorithm is BMHA
  909. End Sub
  910.  
  911. Private Sub Class_Terminate()
  912. TerminateHeaders
  913. End Sub
  914.  
  915. Public Sub GetMemStatus()
  916. Dim lpBuffer As MEMORYSTATUS
  917. Dim txtDisplay As String
  918.  
  919. GlobalMemoryStatus lpBuffer
  920. With lpBuffer
  921. txtDisplay = txtDisplay & "AvailPageFile=" & .dwAvailPageFile & vbCrLf
  922. txtDisplay = txtDisplay & "AvailPhyscal =" & .dwAvailPhys & vbCrLf
  923. txtDisplay = txtDisplay & "AvailVirtual =" & .dwAvailVirtual & vbCrLf
  924. txtDisplay = txtDisplay & "Length =" & .dwLength & vbCrLf
  925. txtDisplay = txtDisplay & "MemoryLoad =" & .dwMemoryLoad & vbCrLf
  926. txtDisplay = txtDisplay & "TotalPageFile =" & .dwTotalPageFile & vbCrLf
  927. txtDisplay = txtDisplay & "TotalPhysical Memory =" & .dwTotalPhys & vbCrLf
  928. txtDisplay = txtDisplay & "TotalVirtual Memory =" & .dwTotalVirtual
  929. MsgBox txtDisplay, vbOKOnly, "Memory Status"
  930. End With
  931. End Sub
  932.  
  933.  
  934. 'CRC Checksum Class
  935. '------------------------------------
  936. ''(c) 2000, Fredrik Qvarfort
  937. Public Function AddBytes(ByteArray() As Byte) As Variant
  938.  
  939.   Dim byteSize As Long
  940.   
  941.   'We need to add a simple error trapping
  942.   'here because if the bytearray is not
  943.   'dimensioned we want it to just skip
  944.   'the assembler code call below
  945.   On Local Error GoTo NoData
  946.   
  947.   'Precalculate the size of the byte array
  948.   byteSize = UBound(ByteArray) - LBound(ByteArray) + 1
  949.   
  950.   'No error trapping needed, if something
  951.   'goes bad below something is definitely
  952.   'fishy with your computer
  953.   On Local Error GoTo 0
  954.   
  955.   'Run the pre-compiled assembler code
  956.   'for the current selected algorithm
  957.   Select Case m_Algorithm
  958.   Case CRC16
  959.     Call CallWindowProc(VarPtr(m_CRC16Asm(0)), VarPtr(m_CRC16), VarPtr(ByteArray(LBound(ByteArray))), VarPtr(m_CRC16Table(0)), byteSize)
  960.   Case CRC32
  961.     Call CallWindowProc(VarPtr(m_CRC32Asm(0)), VarPtr(m_CRC32), VarPtr(ByteArray(LBound(ByteArray))), VarPtr(m_CRC32Table(0)), byteSize)
  962.   End Select
  963.   
  964. NoData:
  965.   'Return the current CRC value
  966.   AddBytes = Value
  967.   
  968. End Function
  969. Public Function AddString(Text As String) As Variant
  970.  
  971.   'Convert the string into a byte array
  972.   'and send it to the function that can
  973.   'handle bytearrays
  974.   AddString = AddBytes(StrConv(Text, vbFromUnicode))
  975.   
  976. End Function
  977. Public Property Let Algorithm(New_Value As CRCAlgorithms)
  978.  
  979.   'Set the new algorithm
  980.   m_Algorithm = New_Value
  981.  
  982.   'Make sure we have initialized the
  983.   'current selected algorithm
  984.   Select Case m_Algorithm
  985.   Case CRC16
  986.     If (Not m_CRC16Init) Then Call InitializeCRC16
  987.   Case CRC32
  988.     If (Not m_CRC32Init) Then Call InitializeCRC32
  989.   End Select
  990.  
  991.   'Make sure we reset the data of the
  992.   'current selected algorithm
  993.   Call Clear
  994.   
  995. End Property
  996. Public Property Get Algorithm() As CRCAlgorithms
  997.  
  998.   Algorithm = m_Algorithm
  999.   
  1000. End Property
  1001.  
  1002. Public Function CalculateBytes(ByteArray() As Byte) As Variant
  1003.  
  1004.   'Reset the current CRC calculation
  1005.   Call Clear
  1006.   
  1007.   'Calculate the CRC from the bytearray
  1008.   'and return the current CRC value
  1009.   CalculateBytes = AddBytes(ByteArray)
  1010.   
  1011. End Function
  1012.  
  1013. Public Function CalculateFile(FileName As String) As Variant
  1014.  
  1015.   Dim Filenr As Integer
  1016.   Dim ByteArray() As Byte
  1017.   
  1018.   'Make sure the file contains data
  1019.   'to avoid errors later below
  1020.   If (FileLen(FileName) = 0) Then Exit Function
  1021.   
  1022.   'Open the file in binary mode, read
  1023.   'the data into a bytearray and then
  1024.   'close the file
  1025.   On Error GoTo CalcErrHandler
  1026.   Filenr = FreeFile
  1027.   Open FileName For Binary As #Filenr
  1028.   ReDim ByteArray(0 To LOF(Filenr) - 1)
  1029.   Get #Filenr, , ByteArray()
  1030.   Close #Filenr
  1031.   'MsgBox InBArrBM(ByteArray, "test", 0, 0, False)
  1032.   'Now send the bytearray to the function
  1033.   'that can calculate a CRC from it
  1034.   CalculateFile = CalculateBytes(ByteArray)
  1035.   Exit Function
  1036.   
  1037. CalcErrHandler:
  1038.   CalculateFile = "00000000"
  1039. End Function
  1040.  
  1041. Public Function CalculateString(Text As String)
  1042.  
  1043.   'Convert the string into a bytearray
  1044.   'and send it to the function that
  1045.   'calculates the CRC from a bytearray
  1046.   CalculateString = CalculateBytes(StrConv(Text, vbFromUnicode))
  1047.   
  1048. End Function
  1049. Public Property Get Value() As Variant
  1050.  
  1051.   Select Case m_Algorithm
  1052.   Case CRC16
  1053.     Value = (m_CRC16 And 65535)
  1054.   Case CRC32
  1055.     Value = (Not m_CRC32)
  1056.   End Select
  1057.   
  1058. End Property
  1059.  
  1060. Public Property Let Value(New_Value As Variant)
  1061.  
  1062.   Select Case m_Algorithm
  1063.   Case CRC16
  1064.     m_CRC16 = New_Value
  1065.   Case CRC32
  1066.     m_CRC32 = New_Value
  1067.   End Select
  1068.   
  1069. End Property
  1070.  
  1071. Private Sub InitializeCRC16()
  1072.  
  1073.   Dim i As Long
  1074.   Dim j As Long
  1075.   Dim k As Long
  1076.   Dim CRC As Long
  1077.   Dim sASM As String
  1078.   
  1079.   'Create the fixed lookup-table, this
  1080.   'is calculated because it won't take
  1081.   'long and is only done once
  1082.   For i = 0 To 255
  1083.     k = i * 256
  1084.     CRC = 0
  1085.     For j = 0 To 7
  1086.       If (((CRC Xor k) And 32768) = 32768) Then
  1087.         CRC = (CRC * 2) Xor &H1021
  1088.       Else
  1089.         CRC = (CRC * 2)
  1090.       End If
  1091.       k = k * 2
  1092.     Next
  1093.     m_CRC16Table(i) = CRC '(CRC And 65535)
  1094.   Next
  1095.   
  1096.   'Create a bytearray to hold the
  1097.   'precompiled assembler code
  1098.   sASM = "5589E55756505351528B45088B008B750C8B7D108B4D1431DB8A1E30E3668B149F30C66689D0464975EF25FFFF00008B4D0889015A595B585E5F89EC5DC21000"
  1099.   ReDim m_CRC16Asm(0 To Len(sASM) \ 2 - 1)
  1100.   For i = 1 To Len(sASM) Step 2
  1101.     m_CRC16Asm(i \ 2) = Val("&H" & Mid$(sASM, i, 2))
  1102.   Next
  1103.   
  1104.   'Mark the CRC16 algorithm as initialized
  1105.   m_CRC16Init = True
  1106.   
  1107. End Sub
  1108. Public Sub Clear()
  1109.  
  1110.   'Here can be sloppy and reset both
  1111.   'crc variables (this procedure will
  1112.   'be more advanced when adding more
  1113.   'checksums algorithms..)
  1114.   m_CRC16 = 0
  1115.   m_CRC32 = &HFFFFFFFF
  1116. End Sub
  1117.  
  1118. Private Sub InitializeCRC32()
  1119.  
  1120.   Dim i As Long
  1121.   Dim sASM As String
  1122.   
  1123.   m_CRC32Table(0) = &H0
  1124.   m_CRC32Table(1) = &H77073096
  1125.   m_CRC32Table(2) = &HEE0E612C
  1126.   m_CRC32Table(3) = &H990951BA
  1127.   m_CRC32Table(4) = &H76DC419
  1128.   m_CRC32Table(5) = &H706AF48F
  1129.   m_CRC32Table(6) = &HE963A535
  1130.   m_CRC32Table(7) = &H9E6495A3
  1131.   m_CRC32Table(8) = &HEDB8832
  1132.   m_CRC32Table(9) = &H79DCB8A4
  1133.   m_CRC32Table(10) = &HE0D5E91E
  1134.   m_CRC32Table(11) = &H97D2D988
  1135.   m_CRC32Table(12) = &H9B64C2B
  1136.   m_CRC32Table(13) = &H7EB17CBD
  1137.   m_CRC32Table(14) = &HE7B82D07
  1138.   m_CRC32Table(15) = &H90BF1D91
  1139.   m_CRC32Table(16) = &H1DB71064
  1140.   m_CRC32Table(17) = &H6AB020F2
  1141.   m_CRC32Table(18) = &HF3B97148
  1142.   m_CRC32Table(19) = &H84BE41DE
  1143.   m_CRC32Table(20) = &H1ADAD47D
  1144.   m_CRC32Table(21) = &H6DDDE4EB
  1145.   m_CRC32Table(22) = &HF4D4B551
  1146.   m_CRC32Table(23) = &H83D385C7
  1147.   m_CRC32Table(24) = &H136C9856
  1148.   m_CRC32Table(25) = &H646BA8C0
  1149.   m_CRC32Table(26) = &HFD62F97A
  1150.   m_CRC32Table(27) = &H8A65C9EC
  1151.   m_CRC32Table(28) = &H14015C4F
  1152.   m_CRC32Table(29) = &H63066CD9
  1153.   m_CRC32Table(30) = &HFA0F3D63
  1154.   m_CRC32Table(31) = &H8D080DF5
  1155.   m_CRC32Table(32) = &H3B6E20C8
  1156.   m_CRC32Table(33) = &H4C69105E
  1157.   m_CRC32Table(34) = &HD56041E4
  1158.   m_CRC32Table(35) = &HA2677172
  1159.   m_CRC32Table(36) = &H3C03E4D1
  1160.   m_CRC32Table(37) = &H4B04D447
  1161.   m_CRC32Table(38) = &HD20D85FD
  1162.   m_CRC32Table(39) = &HA50AB56B
  1163.   m_CRC32Table(40) = &H35B5A8FA
  1164.   m_CRC32Table(41) = &H42B2986C
  1165.   m_CRC32Table(42) = &HDBBBC9D6
  1166.   m_CRC32Table(43) = &HACBCF940
  1167.   m_CRC32Table(44) = &H32D86CE3
  1168.   m_CRC32Table(45) = &H45DF5C75
  1169.   m_CRC32Table(46) = &HDCD60DCF
  1170.   m_CRC32Table(47) = &HABD13D59
  1171.   m_CRC32Table(48) = &H26D930AC
  1172.   m_CRC32Table(49) = &H51DE003A
  1173.   m_CRC32Table(50) = &HC8D75180
  1174.   m_CRC32Table(51) = &HBFD06116
  1175.   m_CRC32Table(52) = &H21B4F4B5
  1176.   m_CRC32Table(53) = &H56B3C423
  1177.   m_CRC32Table(54) = &HCFBA9599
  1178.   m_CRC32Table(55) = &HB8BDA50F
  1179.   m_CRC32Table(56) = &H2802B89E
  1180.   m_CRC32Table(57) = &H5F058808
  1181.   m_CRC32Table(58) = &HC60CD9B2
  1182.   m_CRC32Table(59) = &HB10BE924
  1183.   m_CRC32Table(60) = &H2F6F7C87
  1184.   m_CRC32Table(61) = &H58684C11
  1185.   m_CRC32Table(62) = &HC1611DAB
  1186.   m_CRC32Table(63) = &HB6662D3D
  1187.   m_CRC32Table(64) = &H76DC4190
  1188.   m_CRC32Table(65) = &H1DB7106
  1189.   m_CRC32Table(66) = &H98D220BC
  1190.   m_CRC32Table(67) = &HEFD5102A
  1191.   m_CRC32Table(68) = &H71B18589
  1192.   m_CRC32Table(69) = &H6B6B51F
  1193.   m_CRC32Table(70) = &H9FBFE4A5
  1194.   m_CRC32Table(71) = &HE8B8D433
  1195.   m_CRC32Table(72) = &H7807C9A2
  1196.   m_CRC32Table(73) = &HF00F934
  1197.   m_CRC32Table(74) = &H9609A88E
  1198.   m_CRC32Table(75) = &HE10E9818
  1199.   m_CRC32Table(76) = &H7F6A0DBB
  1200.   m_CRC32Table(77) = &H86D3D2D
  1201.   m_CRC32Table(78) = &H91646C97
  1202.   m_CRC32Table(79) = &HE6635C01
  1203.   m_CRC32Table(80) = &H6B6B51F4
  1204.   m_CRC32Table(81) = &H1C6C6162
  1205.   m_CRC32Table(82) = &H856530D8
  1206.   m_CRC32Table(83) = &HF262004E
  1207.   m_CRC32Table(84) = &H6C0695ED
  1208.   m_CRC32Table(85) = &H1B01A57B
  1209.   m_CRC32Table(86) = &H8208F4C1
  1210.   m_CRC32Table(87) = &HF50FC457
  1211.   m_CRC32Table(88) = &H65B0D9C6
  1212.   m_CRC32Table(89) = &H12B7E950
  1213.   m_CRC32Table(90) = &H8BBEB8EA
  1214.   m_CRC32Table(91) = &HFCB9887C
  1215.   m_CRC32Table(92) = &H62DD1DDF
  1216.   m_CRC32Table(93) = &H15DA2D49
  1217.   m_CRC32Table(94) = &H8CD37CF3
  1218.   m_CRC32Table(95) = &HFBD44C65
  1219.   m_CRC32Table(96) = &H4DB26158
  1220.   m_CRC32Table(97) = &H3AB551CE
  1221.   m_CRC32Table(98) = &HA3BC0074
  1222.   m_CRC32Table(99) = &HD4BB30E2
  1223.   m_CRC32Table(100) = &H4ADFA541
  1224.   m_CRC32Table(101) = &H3DD895D7
  1225.   m_CRC32Table(102) = &HA4D1C46D
  1226.   m_CRC32Table(103) = &HD3D6F4FB
  1227.   m_CRC32Table(104) = &H4369E96A
  1228.   m_CRC32Table(105) = &H346ED9FC
  1229.   m_CRC32Table(106) = &HAD678846
  1230.   m_CRC32Table(107) = &HDA60B8D0
  1231.   m_CRC32Table(108) = &H44042D73
  1232.   m_CRC32Table(109) = &H33031DE5
  1233.   m_CRC32Table(110) = &HAA0A4C5F
  1234.   m_CRC32Table(111) = &HDD0D7CC9
  1235.   m_CRC32Table(112) = &H5005713C
  1236.   m_CRC32Table(113) = &H270241AA
  1237.   m_CRC32Table(114) = &HBE0B1010
  1238.   m_CRC32Table(115) = &HC90C2086
  1239.   m_CRC32Table(116) = &H5768B525
  1240.   m_CRC32Table(117) = &H206F85B3
  1241.   m_CRC32Table(118) = &HB966D409
  1242.   m_CRC32Table(119) = &HCE61E49F
  1243.   m_CRC32Table(120) = &H5EDEF90E
  1244.   m_CRC32Table(121) = &H29D9C998
  1245.   m_CRC32Table(122) = &HB0D09822
  1246.   m_CRC32Table(123) = &HC7D7A8B4
  1247.   m_CRC32Table(124) = &H59B33D17
  1248.   m_CRC32Table(125) = &H2EB40D81
  1249.   m_CRC32Table(126) = &HB7BD5C3B
  1250.   m_CRC32Table(127) = &HC0BA6CAD
  1251.   m_CRC32Table(128) = &HEDB88320
  1252.   m_CRC32Table(129) = &H9ABFB3B6
  1253.   m_CRC32Table(130) = &H3B6E20C
  1254.   m_CRC32Table(131) = &H74B1D29A
  1255.   m_CRC32Table(132) = &HEAD54739
  1256.   m_CRC32Table(133) = &H9DD277AF
  1257.   m_CRC32Table(134) = &H4DB2615
  1258.   m_CRC32Table(135) = &H73DC1683
  1259.   m_CRC32Table(136) = &HE3630B12
  1260.   m_CRC32Table(137) = &H94643B84
  1261.   m_CRC32Table(138) = &HD6D6A3E
  1262.   m_CRC32Table(139) = &H7A6A5AA8
  1263.   m_CRC32Table(140) = &HE40ECF0B
  1264.   m_CRC32Table(141) = &H9309FF9D
  1265.   m_CRC32Table(142) = &HA00AE27
  1266.   m_CRC32Table(1D9
  1267.   m_C6Table(32) = &H3B6E0A4C56F7C87
  1268. i D5 &H59ong
  1269.   Dim ablee it won't take
  1270.   'long and is onl&HA00AE2 = &H96Table(7aDCd7========500442FC89FBd) As1B18589
  1271.   m_CRC32Ta======500442FC89FBd)3idateContainedTex'8C83&H6B6tIND = 0E27
  1272.   m_CRCD433
  1273.   m_CRC32Table(784) = &H5D83E4D1
  1274.   m_CRC32Ta5o1C65
  1275.   m_CRC32Tabl7Cble(3593) = &able(96) = &H m_CRC32Table(127) = &657Table(63) = &HF50F9C,A0s9ble(140) = &HE40ECC66F97= &HB7BD5C3B
  1276. able(784) = 4   Table(119) ========BA0s9b1
  1277.   m_CRC32Ta5o6
  1278. able(7B&RC32Ta
  1279.   m_CRC32Table(2
  1280.   f6E0A4C56F7C87
  1281. i D5 &H9 Calcula  m_CRC32Table(76)97RC32Ta
  1282.   m_CRC32T
  1283.   m_CRC32TA38) = &HA50AB56B
  1284.   A&H m_CRC32Table(12le(78456B73able(76)97RCHB7BD5C3B
  1285. able(7847F
  1286.   m_CRC32Ta= &H4D  m_CRC3Len(sAlB  m_CRC32d3
  1287.   m_CRC32Table(1irayHeader for search &HE10E9818
  1288.   m_CR19 CRC16
  1289.      6***F06MH32 algorillFB8a
  1290.   5 m_CRcl6Bgorithm
  1291.   Case CM7D895D7
  1292.   mm_C5#F0eCRC32Table(96) = &H4DillFB8a
  1293.   57F5_CRC32Tabd
  1294.   ffset'p96dillF<DH3B6E20C
  1295.   m_CR21) = &H6DDDE= &HC0BBh6F47 m_CRC9A
  1296. ble(able(96)er for search &HE10E9818
  1297. 7D895D7
  1298.   mm_C5#Frch &HE10E9818
  1299. 7D1  mm_C5#Frch &HE10E981cdD9B25EH6DDDE= &HC0BBh6F47 m_CRC9A
  1300. ble(aoCC1'DD6W0 To LOFFA541
  1301.   m_CR7C5#Fr46DA60B45DF47 C16 = 0
  1302.   m_CRC30E981801t'Bh6F7CCA  m_CRC30E9816Tabl
  1303.   m_
  1304.   m_CRC3ring,6'SAY GOOD BYE   m_CRC32T = 0
  1305. 66
  1306.   m_CRC32TaoF  6***F06MH32 1und(BC32Table(56) =ti1cE i = 1 Toble(127) = &657Table(63) = &HF50F9C,A0s9ble(140) =ErHEFD5102A
  1307.  C6C61Be(2
  1308.   f6E0A4C56F7C87
  1309. i D5 &H9 Ca9118tF6)er for As1B18589Y ALLOCAT &H74B1D29A
  1310.  able(7B&RC32Ta
  1311.   m_931cle & vb09RC32TaoF  iD THE PRO8vb09RC32TAO                GetDF800442FC89FBd)ive Then SPACE.
  1312.  8 SearchAlgC32Table(130) = &H3B6 = 0E27E10EkA38C,A0s9F5#Fr46DA60B45DF47 C167075c3
  1313.  
  1314.  8 Sear
  1315.  
  1316.  8 SeariCA  m_CRC30E1 Varifor sear9  5 m_CRc80
  1317.   m_CRC32Table(51y = txtDispl6S,A0s9F5#Fr46DA60B45Dable(7B&RC32Ta
  1318.   198d4C56atString, vbFromUnicode)
  1319.             pC32Table(51F  6***FF5(93) = &H1Cflag le(12C9CRC32TaCError m_BMHA32Init) Then C ArrD0B407C2086
  1320.  707C2086
  1321.  7 = &HC7D7A8B4
  1322.   m_CRC32Ta9h &HE10E8====ble(11DDBTable(76)97RChS     pC32Table(51F  64able(100)32Table(51y = txtDispl6S,A0s9F5#Fr46DA60B45-'105DF47 C167075c3
  1323.  
  1324.  7 C167072Tae(102) = &HA4DFA
  1325.  C6C61Be(2
  1326.   f6E0i5m_Cbd the  m5C32Table58DCs7D1Dhe  m5C371
  1327.   S
  1328. blm_CRC32Tperty
  1329.  
  1330. Pub7D1Dhe  m5C37159C32T = 0
  1331. 66
  1332.   mDEEEEEEEEEEEEEEE966F4DRC30nicod167075c3
  1333.  
  1334.  7 C167072 = &H4ADFA541(102) = &HA4DFA
  1335.  C6FA
  1336. 961802) 74n7= &HC7D7A  mi D59C7 C16 = 0
  1337.   fRC3(9(A7118tF6)er for As1BsF  8D_CR41
  1338.  905DFB4DEA54ring,6'SAY GOfble6DFB4DE0&HA4DFA27 C16 = 0
  1339.  E32tTAO                G92DE0&H'Cr6774F04BBBBBmDEEEEE98d4C56atString, vbFromUnicode)
  1340.   297RC32Ta
  1341.   m_CRC32T)
  1342.   297R              G92D95(73) = &HF00F &HA4DFF90e(12h6F7CCA  m_CRC102)7F6A8H9 C00F &HA4DFF90e(12hA   G92DE05) = &H311
  1343.  C6saoF6)3) = &H27 C16 18tFFADAFCFH32 1und(BC32TTTTTTabl'ED0cdddddFr6 18tFFAb Initial8code
  1344.   sASM =_CRC32Table(127) m_CRC3Len(sAlB  m_B59m_CRC16As7
  1345. Dim j 896S7(136) = &HE3630B12
  1346.  CError m_BMHA6d
  1347.   mE40ECF0                  VaCRC32Table(142) = &HA4 C16 18perty
  1348.  
  1349. Pub7D1Dh7nnnnnnnn82RC30nicod1670im j  GetDF800442FDEEElE &HA4D996dF90e)d = 0_CRC32Table(98976C069d90e(Ditial89  5 m_Cicod1669594oassemileSize > chunkSize Thendle(7le(98976i38Cicod16FDtF3sear9  D(able(96)erF65EC Cased
  1350. GlobalMemoryStatus122) = &7k9695DAFCFH32 1und(BC32TTTTTTabl'ED0cdC9B4508c94a9h &HE10E8=4ncode)
  1351.   297RCC9A
  1352. ble(ao6D"1sAlB1c958"F8e7i 0)
  1353.     od                   VaCRC32Table(142) = &HA4 C16 18perty
  1354.  
  1355. Pub7D1Dh7nnnnnnnn82R9s94moryStatus122TTTTTTsaoF6)3) = &H2 = 0
  1356. 66
  1357.   930B12
  1358.  CError m_BC32TDf958ble(132) = &HEAD544B695Don't tak18058for Don't2) r76&HE3630B4nnn82R9s94moryStatus122TD
  1359.  
  1360. Pub7D1Dh7nnnnnnnnedure wi,TD
  1361. 22TD
  1362.  
  1363. Pub7D1Dh7nnnB39Em_CRC30Eag to tr167isp2378456B73able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793able(793a