Encryption using Visual Basic 6 (VB6)
Posted: Wed Jul 14, 2010 6:09 am
This is a very good 31-bit encryption algorithm for VB6. You may convert it to any other language you like.
Code: Select all
Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Function RandomBinaryB(ByVal tmpLength As Long) As String
Dim tmpRandomBinaryB() As Byte
Dim tmpIndex As Long
ReDim tmpRandomBinaryB(tmpLength - 1)
For tmpIndex = 0 To tmpLength - 1
tmpRandomBinaryB(tmpIndex) = Int(Rnd * 256)
Next
RandomBinaryB = StrConv(tmpRandomBinaryB, vbUnicode)
End Function
Public Function RndCrypt(ByVal Str As String, ByVal Password As String) As String
' Made by Michael Ciurescu (CVMichael from vbforums.com)
' Original thread: [url]http://www.vbforums.com/showthread.php?t=231798[/url]
Dim SK As Long, K As Long
Rnd -1
Randomize Len(Password)
For K = 1 To Len(Password)
SK = SK + (((K Mod 256) Xor Asc(Mid$(Password, K, 1))) Xor Fix(256 * Rnd))
Next K
Rnd -1
Randomize SK
For K = 1 To Len(Str)
Mid$(Str, K, 1) = Chr(Fix(256 * Rnd) Xor Asc(Mid$(Str, K, 1)))
Next K
RndCrypt = Str
End Function
Public Function RndCryptB(ByRef tmpToEncrypt As String, ByVal tmpPassword As String) As String
' Original function/idea by Michael Ciurescu (CVMichael from vbforums.com)
' This function by frozen on vbforums.com
' Original thread: [url]http://www.vbforums.com/showthread.php?t=231798[/url]
Dim tmpToEncryptB() As Byte
Dim tmpPasswordB() As Byte
Dim tmpIndex As Long
Dim tmpSeed As Long
Rnd -1
Randomize Len(tmpPassword)
tmpPasswordB = StrConv(tmpPassword, vbFromUnicode)
For tmpIndex = 0 To UBound(tmpPasswordB) - 1
tmpSeed = tmpSeed + (((tmpIndex Mod 256) Xor tmpPasswordB(tmpIndex)) Xor Fix(256 * Rnd))
Next
Rnd -1
Randomize tmpSeed
tmpToEncryptB = StrConv(tmpToEncrypt, vbFromUnicode)
For tmpIndex = 0 To UBound(tmpToEncryptB) - 1
tmpToEncryptB(tmpIndex) = Fix(256 * Rnd) Xor tmpToEncryptB(tmpIndex)
Next tmpIndex
RndCryptB = StrConv(tmpToEncryptB, vbUnicode)
End Function
Private Sub Form_Load()
Dim tmpBinary As String
Dim tmpIndex As Long
Dim tmpTicks As Long
tmpBinary = RandomBinaryB(1048576)
For tmpIndex = 0 To 5
tmpTicks = GetTickCount()
Call RndCrypt(tmpBinary, "abc")
Debug.Print tmpIndex, "RndCrypt(tmpBinary, abc)", GetTickCount() - tmpTicks
tmpTicks = GetTickCount()
Call RndCryptB(tmpBinary, "abc")
Debug.Print tmpIndex, "RndCryptB(tmpBinary, abc)", GetTickCount() - tmpTicks
Next
End Sub