CODING CRC32 DENGAN VB 6.0

Private crcTable(0 To 255) As Long 'crc32

Private Function CRC32(ByRef bArrayIn() As Byte, ByVal lLen As Long, Optional ByVal lcrc As Long = 0) As Long
'bArrayIn adalah array byte dari file yang dibaca
'lLen adalah ukuran atau size file

Dim lCurPos As Long 'Current position untuk iterasi proses array bArrayIn
Dim lTemp As Long 'Variabel temp hasil perhitungan

BuildTable

If lLen = 0 Then Exit Function 'keluar fungsi apabila ukuran file = 0
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
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
crcTable(i) = crc
Next i
End Function


Public Function enkrip(ByVal T1 As String, Optional ByVal T2 As String) As String
Dim ast() As Byte
Dim ast2() As Byte
Dim tampP As String
Dim tamp2P As String
Dim tampU As String
Dim tamp2U As String
Dim i As Integer

tamp2U = ""
tamp2P = ""
If Len(T1) > 0 Then
If Len(T2) > 0 Then
ReDim ast2(0 To Len(T2) - 1) As Byte
For i = 0 To Len(T2) - 1
ast2(i) = Asc(Mid(T2, i + 1, 1))
Next i
tampU = CStr(CRC32(ast2, Len(T2) - 1))
'MsgBox tamp
tampU = Abs(Val(tampU))
Do While Len(tampU) Mod 2 <> 0
tampU = "0" & tampU
Loop
'MsgBox tamp
i = 1
tamp2U = ""
Do While i < Len(tampU)
'RichTextBox1.Text = RichTextBox1.Text & vbCrLf & Val(Mid(tamp, i, 2)) Mod 16
Select Case Val(Mid(tampU, i, 2)) Mod 16
Case 0 To 9
tamp2U = tamp2U & Val(Mid(tampU, i, 2)) Mod 16
Case Else
If Val(Mid(tampU, i, 2)) Mod 16 = 10 Then
tamp2U = tamp2U & "A"
ElseIf Val(Mid(tampU, i, 2)) Mod 16 = 11 Then
tamp2U = tamp2U & "B"
ElseIf Val(Mid(tampU, i, 2)) Mod 16 = 12 Then
tamp2U = tamp2U & "C"
ElseIf Val(Mid(tampU, i, 2)) Mod 16 = 13 Then
tamp2U = tamp2U & "D"
ElseIf Val(Mid(tampU, i, 2)) Mod 16 = 14 Then
tamp2U = tamp2U & "E"
ElseIf Val(Mid(tampU, i, 2)) Mod 16 = 15 Then
tamp2U = tamp2U & "F"
End If
End Select
i = i + 2
Loop
End If
ReDim ast(0 To Len(T1) - 1) As Byte
For i = 0 To Len(T1) - 1
ast(i) = Asc(Mid(T1, i + 1, 1))
Next i
tampP = CStr(CRC32(ast, Len(T1) - 1))
'MsgBox tamp
tampP = Abs(Val(tampP))
Do While Len(tampP) Mod 2 <> 0
tampP = "0" & tampP
Loop
'MsgBox tamp
i = 1
tamp2P = ""
Do While i < Len(tampP)
'RichTextBox1.Text = RichTextBox1.Text & vbCrLf & Val(Mid(tamp, i, 2)) Mod 16
Select Case Val(Mid(tampP, i, 2)) Mod 16
Case 0 To 9
tamp2P = tamp2P & Val(Mid(tampP, i, 2)) Mod 16
Case Else
If Val(Mid(tampP, i, 2)) Mod 16 = 10 Then
tamp2P = tamp2P & "A"
ElseIf Val(Mid(tampP, i, 2)) Mod 16 = 11 Then
tamp2P = tamp2P & "B"
ElseIf Val(Mid(tampP, i, 2)) Mod 16 = 12 Then
tamp2P = tamp2P & "C"
ElseIf Val(Mid(tampP, i, 2)) Mod 16 = 13 Then
tamp2P = tamp2P & "D"
ElseIf Val(Mid(tampP, i, 2)) Mod 16 = 14 Then
tamp2P = tamp2P & "E"
ElseIf Val(Mid(tampP, i, 2)) Mod 16 = 15 Then
tamp2P = tamp2P & "F"
End If
End Select
i = i + 2
Loop
enkrip = tamp2U & tamp2P
'MsgBox tamp2
End If
End Function