VB6 to B4A enCrypt deCrypt Function Help

[niteuser]

Hello Im new to B4A and have a VB6 encrypt decrypt function I would like to contribute and convert to b4a code can someone help me make this work?

VB6 DECLARE CODE

Dim x1a0(9) As Long
Dim cle(17) As Long
Dim x1a2 As Long
Dim fois As Long
Dim champ1 As String
Dim lngchamp1 As Long
Dim cfc As Long
Dim cfd As Long
Dim compte As Int
Dim dcryp As Long
Dim ecryp As Long
Dim intercpt As Long
Dim rescpt As Long
Dim ax As Long
Dim bx As Long
Dim cx As Long
Dim dx As Long
Dim si As Long
Dim tmp As Long
Dim icryp As Long
Dim crest As Byte

VB6 Assemble Function

Sub Assemble()

x1a0(0) = ((cle(1) * 256) + cle(2)) Mod 65536
code
intercpt = rescpt

x1a0(1) = x1a0(0) Xor ((cle(3) * 256) + cle(4))
code
intercpt = intercpt Xor rescpt


x1a0(2) = x1a0(1) Xor ((cle(5) * 256) + cle(6))
code
intercpt = intercpt Xor rescpt

x1a0(3) = x1a0(2) Xor ((cle(7) * 256) + cle(8))
code
intercpt = intercpt Xor rescpt

x1a0(4) = x1a0(3) Xor ((cle(9) * 256) + cle(10))
code
intercpt = intercpt Xor rescpt

x1a0(5) = x1a0(4) Xor ((cle(11) * 256) + cle(12))
code
intercpt = intercpt Xor rescpt

x1a0(6) = x1a0(5) Xor ((cle(13) * 256) + cle(14))
code
intercpt = intercpt Xor rescpt

x1a0(7) = x1a0(6) Xor ((cle(15) * 256) + cle(16))
code
intercpt = intercpt Xor rescpt

icryp = 0

End Sub

VB6 CODE FUNCTION

Sub code()
dx = (x1a2 + icryp) Mod 65536
ax = x1a0(icryp)
cx = &H15A
bx = &H4E35

tmp = ax
ax = si
si = tmp

tmp = ax
ax = dx
dx = tmp

If (ax <> 0) Then
ax = (ax * bx) Mod 65536
End If

tmp = ax
ax = cx
cx = tmp

If (ax <> 0) Then
ax = (ax * si) Mod 65536
cx = (ax + cx) Mod 65536
End If

tmp = ax
ax = si
si = tmp
ax = (ax * bx) Mod 65536
dx = (cx + dx) Mod 65536

ax = ax + 1

x1a2 = dx
x1a0(icryp) = ax

rescpt = ax Xor dx
icryp = icryp + 1

End Sub

VB6 ENCRYPT SUB

Sub crypt(strencrypt As String) As String
si = 0
x1a2 = 0
icryp = 0

For fois = 1 To 16
cle(fois) = 0
Next fois

champ1 = "dsrfdswawwfyrewb"
lngchamp1 = Len(champ1)

For fois = 1 To lngchamp1
cle(fois) = Asc(Mid(champ1, fois, 1))
Next fois

champ1 = strencrypt
lngchamp1 = Len(champ1)
For fois = 1 To lngchamp1
crest = Asc(Mid(champ1, fois, 1))

Assemble

If intercpt > 65535 Then
intercpt = intercpt - 65536
End If

cfc = (((intercpt / 256) * 256) - (intercpt Mod 256)) / 256
cfd = intercpt Mod 256

For compte = 1 To 16

cle(compte) = cle(compte) Xor crest

Next compte

crest = crest Xor (cfc Xor cfd)

dcryp = (((crest / 16) * 16) - (crest Mod 16)) / 16
ecryp = crest Mod 16

crypt = crypt + Chr$(&H61 + dcryp) ' d+&h61 give one letter range from a to p for the 4 high bits of crest
crypt = crypt + Chr$(&H61 + ecryp) ' e+&h61 give one letter range from a to p for the 4 low bits of crest


Next fois
End Sub

VB6 DECRYPT FUNCTION

Sub decrypt(strdecrypt As String) As String

si = 0
x1a2 = 0
icryp = 0

For fois = 1 To 16
cle(fois) = 0
Next fois

champ1 = "dsrfdswawwfyrewb"
lngchamp1 = Len(champ1)

For fois = 1 To lngchamp1
cle(fois) = Asc(Mid(champ1, fois, 1))
Next fois

champ1 = strdecrypt
lngchamp1 = Len(champ1)

For fois = 1 To lngchamp1

dcryp = Asc(Mid(champ1, fois, 1))
If (dcryp - &H61) >= 0 Then
dcryp = dcryp - &H61  ' to transform the letter to the 4 high bits of crest
If (dcryp >= 0) AND (dcryp <= 15) Then
dcryp = dcryp * 16
End If
End If
If (fois <> lngchamp1) Then
fois = fois + 1
End If
ecryp = Asc(Mid(champ1, fois, 1))
If (ecryp - &H61) >= 0 Then
ecryp = ecryp - &H61 ' to transform the letter to the 4 low bits of crest
If (ecryp >= 0) AND (ecryp <= 15) Then
crest = dcryp + ecryp
End If
End If

Assemble

If intercpt > 65535 Then
intercpt = intercpt - 65536
End If

cfc = (((intercpt / 256) * 256) - (intercpt Mod 256)) / 256
cfd = intercpt Mod 256

crest = crest Xor (cfc Xor cfd)

For compte = 1 To 16

cle(compte) = cle(compte) Xor crest

Next compte

decrypt = decrypt + Chr$(crest)

Next fois
End Sub

:sign0163:

Thanks!!

 

[Erel]

See this page: http://www.b4x.com/forum/basic4android-getting-started-tutorials/9347-converting-vb6-b4a.html