CRC Generator

Dalam tutorial ini saya akan sedikit menuliskan bagaimana membuat sebuah CRC Generator agar kita bisa mendapatkan nilai CRC sebuah file dengan menggunakan visual basic 6.0.
Disini kita hanya membutuhkan sebuah form dan sebuah user control.

kita mulai dengan membuat sebuah project baru lalu tambahkanlah sebuah user control
Atur properti heightnya menjadi 360 kemudian widthnya menjadi 480 kemudian simpan dengan nama CRC
Lalu ketikanlah script berikut ini pada user control tersebut :

Option Explicit
Private crcTable(0 To 255) As Long

Private Sub UserControl_Initialize()
BuildTable
End Sub

Private Function CRC32(ByRef bArrayIn() As Byte, ByVal lLen As Long, Optional ByVal lcrc As Long = 0) As Long
Dim lCurPos As Long
Dim lTemp As Long
If lLen = 0 Then Exit Function
lTemp = lcrc Xor &HFFFFFFFF
For lCurPos = 0 To lLen
lTemp = (((lTemp And &HFFFFFF00) \ &H100) And &HFFFFFF) Xor (crcTable((lTemp And 255) Xor bArrayIn(lCurPos)))
Next lCurPos
CRC32 = lTemp Xor &HFFFFFFFF
DoEvents
End Function

Private Function BuildTable() As Boolean
Dim i As Long, x As Long, CRC As Long
Const Limit = &HEDB88320
For i = 0 To 255
CRC = i
For x = 0 To 7
If CRC And 1 Then
CRC = (((CRC And &HFFFFFFFE) \ 2) And &H7FFFFFFF) Xor Limit
Else
CRC = ((CRC And &HFFFFFFFE) \ 2) And &H7FFFFFFF
End If
Next x
crcTable(i) = CRC
Next i
DoEvents
End Function

Public Function FromFile(SPathFile As String) As String
Dim b() As Byte, lcrc As Long
On Error Resume Next
If Len(SPathFile) = 0 Then Exit Function
Open SPathFile For Binary Access Read As #1
ReDim b(FileLen(SPathFile) - 1)
Get #1, , b
Close #1
lcrc = UBound(b())
lcrc = CRC32(b(), lcrc)
FromFile = Hex(lcrc)
DoEvents
End Function

Sekarang kita mulai mendesign tampilan formnya..
tambahkan sebuah form baru lalu designlah seperti gambar berikut ini :

Di form tersebut digunakan 5 buah objek yaitu label, textbox, command button, common dialog, crc ( user control yang sebelumnya telah dibuat). atur propertiesnya sesuai dengan gambar.
kalau sudah tambahkan script berikut ini pada form :

Private Sub cmdbrowse_Click()
On Error Resume Next
With cd
.Filter = "All Files (*.*) |*.*"
.ShowOpen
If Len(.FileName) = 0 Then Exit Sub
txtfilename.Text = .FileName
End With
End Sub

Private Sub cmdproses_Click()
txtcrc32.Text = CRC.FromFile(txtfilename.Text)
End Sub

Selamat mencoba