La funcion lo que realiza es una verificación del exe para saber si a ido modificaco o no (es una seguridad muy basica).
Edito--->
(NO ES NECESARIO) OJO si lo van a usar deberan realinear el formato PE... o usar los ultimos 4 bytes de el exe (habitualmente son bytes 0)
En un modulo...
Código
Option Explicit #Const INSERTCRC32TOEXE = False Public Function itsOkCRC32() As Boolean ' // ' // Funcion itsOkCRC32 creada por BlackZeroX (http://infrangelux.hostei.com) ' // ' // Instrucciones: ' // * COMPILA TU EXE FINAL con la constante INSERTCRC32TOEXE = false. ' // * Cambia INSERTCRC32TOEXE de false a true ( #Const INSERTCRC32TOEXE = true ) ' // * Cambia la linea {Open "c:\testCRC32.exe" For Binary As hFile} de este proceso con ' // la ruta del exe que compilaste anteriormente, por ejemplo {Open "c:\testCRC32.exe" For Binary As hFile} ' // * Ejecuta el proyecto desde este IDE, si todo a ido correctamente les aparecera un mensaje {"CRC32 configurado Correctamente"}. ' // * Comprube tu EXE Final {c:\testCRC32.exe} ejecutandolo directamente. ' // Si todo a hido correctamente el exe te mostrara {"CRC32 Correcto"} si solo has generado el exe y no cambiaste {INSERTCRC32TOEXE a true} te mostrara {"CRC32 erroneo"} en este ejemplo. Dim byteData() As Byte Dim dwSizeFile As Long Dim dwCRC32ReadFile As Long Dim dwCRC32Generate As Long Dim oCRC32 As cCRC32 Dim hFile As Integer hFile = FreeFile #If (INSERTCRC32TOEXE = False) Then Open App.Path & "\" & App.EXEName & ".exe" For Binary As hFile #Else Open "c:\testCRC32.exe" For Binary As hFile #End If dwSizeFile = LOF(hFile) If ((dwSizeFile - 4) > 0) Then #If (INSERTCRC32TOEXE = True) Then ReDim byteData(0 To (dwSizeFile - 1)) #Else ReDim byteData(0 To (dwSizeFile - 1 - 4)) #End If Get 1, , byteData Get 1, , dwCRC32ReadFile Set oCRC32 = New cCRC32 dwCRC32Generate = oCRC32.GetByteArrayCrc32(byteData) Set oCRC32 = Nothing If (dwCRC32Generate = dwCRC32ReadFile) Then itsOkCRC32 = True #If (INSERTCRC32TOEXE = True) Then MsgBox "CRC32 Ya se encontraba configurado." Else Put hFile, , dwCRC32Generate MsgBox "CRC32 configurado Correctamente." End #End If End If End If Close hFile End Function
cCRC32.cls (Modulo de clase)
Código:
Option Explicit
' This code is taken from the VB.NET CRC32 algorithm
' provided by Paul (wpsjr1@succeed.net) - Excellent work!
Private crc32Table() As Long
Public Function GetByteArrayCrc32(ByRef buffer() As Byte) As Long
Dim crc32Result As Long: crc32Result = &HFFFFFFFF
Dim i As long
Dim iLookup As long
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
Private Sub Class_initialize()
' This is the official polynomial used by CRC32 in PKZip.
' Often the polynomial is shown reversed (04C11DB7).
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
Private Sub Class_Terminate()
Erase crc32Table
End Sub
Ejemplo:
Código
option explicit Sub main() If (itsOkCRC32) Then MsgBox "CRC32 Correcto" Else MsgBox "CRC32 erroneo" End If End Sub
Decargar Ejemplo (Compilar en "C:\" el proyecto con el nombre "testCRC32.exe" o configurar las lineas segun lo requieran y con la constante en false, despues solo ejecutar desde el IDE con la constante en true):
http://infrangelux.sytes.net/FileX/index.php?dir=/BlackZeroX/Programacion/vb6/ejemplos%20VB6&file=itsOKCRC32.zip
Alternativa: http://foro.elhacker.net/programacion_visual_basic/src_self_crc32_check_01_poc-t351610.0.html
Dulces Lunas!¡.