ROBOT.LK

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