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
VB6 Assemble Function
VB6 CODE FUNCTION
VB6 ENCRYPT SUB
VB6 DECRYPT FUNCTION
:sign0163:
Thanks!!
VB6 DECLARE CODE
B4X:
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 ByteVB6 Assemble Function
B4X:
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 SubVB6 CODE FUNCTION
B4X:
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 SubVB6 ENCRYPT SUB
B4X:
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 SubVB6 DECRYPT FUNCTION
B4X:
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!!
