TOTP 100% qb64 Yup - sorta LOL

[Ra7eN]

I redid the encryption on my app, remember I am not building a PWM for military use ahahahaha,  Just something local but needs to be fairly strong. I call this AES LITE, because I thought it was ALMOST as good.  Back when I wrote this  - I thought it was amazing LOL, However recently after reading how AES performcs, and qb64 doesn't do a good job handling much o it, I found out it wasn't as good as I thought... So don't laugh. Any tips?? Greatly appreciated. Again it is for local and offline, so I think it does the trick.

But I like it. secure where I need it. In the app, each record has it's own key, so no two record will have the same key.

Code: (Select All)

' aesLite.bi

' AES-lite with XOR, round key derivation, and mode handling



' ================================

' Function: keyGen$

' Returns a 32-character random key from uppercase letters and numbers

' ================================

Function keyGen$ ()

    Dim theKey As String, pool As String, ch As String * 1

    pool = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789abcdefghijklmnopqrstuvwxyz"



    Do

        ch = Mid$(pool, Int(Rnd * Len(pool)) + 1, 1)

        theKey = theKey + ch

    Loop Until Len(theKey) = 32

    keyGen$ = theKey

End Function



' ================================

' Function: StrReverse$

' Reverses a string manually for QB64 compatibility

' ================================

Function StrReverse$ (s As String)

    Dim i As Integer, r As String

    For i = Len(s) To 1 Step -1

        r = r + Mid$(s, i, 1)

    Next

    StrReverse$ = r

End Function



' ================================

' Function: DeriveKey$

' Derives a round key from a base and seed key using XOR transformation

' ================================

Function DeriveKey$ (baseStr As String, seed As String)

    Dim result As String

    Dim i As Integer, ch As String * 1, sch As String * 1

    Dim xorVal As Integer



    For i = 1 To Len(baseStr)

        ch = Mid$(baseStr, i, 1)

        sch = Mid$(seed, ((i - 1) Mod Len(seed)) + 1, 1)

        xorVal = Asc(ch) Xor Asc(sch) Xor (i Mod 255)

        result = result + Chr$(xorVal Mod 256)

    Next



    DeriveKey$ = result

End Function



' ================================

' Function: encryptAESLite$

' AES-lite encryption/decryption based on mode

' ================================

Function encryptAESLite$ (text As String, keyString As String, mode As String)

    Dim result As String, temp As String

    Dim i As Integer, j As Integer

    Dim ch As String * 1, kch As String * 1

    Dim xorVal As Integer

    Dim roundKey(0 To 3) As String * 32



    roundKey(0) = keyString

    For i = 1 To 3

        roundKey(i) = DeriveKey$(roundKey(i - 1), keyString)

    Next



    result = text



    If LCase$(mode) = "e" Then

        For i = 0 To 3

            temp = ""

            For j = 1 To Len(result)

                ch = Mid$(result, j, 1)

                kch = Mid$(roundKey(i), ((j - 1) Mod 32) + 1, 1)

                xorVal = Asc(ch) Xor Asc(kch) Xor (j + (i * 17))

                temp = temp + Chr$(xorVal Mod 256)

            Next

            result = StrReverse$(temp)

        Next

    ElseIf LCase$(mode) = "d" Then

        For i = 3 To 0 Step -1

            result = StrReverse$(result)

            temp = ""

            For j = 1 To Len(result)

                ch = Mid$(result, j, 1)

                kch = Mid$(roundKey(i), ((j - 1) Mod 32) + 1, 1)

                xorVal = Asc(ch) Xor Asc(kch) Xor (j + (i * 17))

                temp = temp + Chr$(xorVal Mod 256)

            Next

            result = temp

        Next

    End If



    encryptAESLite$ = result

End Function



' Detects tampering or wrong key use

' Add a 4-character checksum at the end of encrypted data, then verify it during decrypt.

Function AddCheckTag$ (text As String)

    Dim i As Integer, sum As Integer

    For i = 1 To Len(text)

        sum = sum + Asc(Mid$(text, i, 1))

    Next

    sum = sum Mod 65536

    AddCheckTag$ = text + MKI$(sum)

End Function



Function StripCheckTag$ (cipher As String, passed As Integer)

    Dim tag As Integer, real As Integer

    Dim dataStr As String, i As Integer

    If Len(cipher) < 3 Then passed = 0: StripCheckTag$ = "": Exit Function

    dataStr = Left$(cipher, Len(cipher) - 2)

    tag = CVI(Right$(cipher, 2))

    For i = 1 To Len(dataStr)

        real = real + Asc(Mid$(dataStr, i, 1))

    Next

    real = real Mod 65536

    If real = tag Then passed = -1 Else passed = 0

    StripCheckTag$ = dataStr

End Function



' ================================

' Function: EncryptField$

' Encrypts data and adds checksum tag

' ================================

Function EncryptField$ (dataStr As String, keyStr As String)

    EncryptField$ = AddCheckTag$(encryptAESLite$(dataStr, keyStr, "e"))

End Function



' ================================

' Function: DecryptField$

' Decrypts data and verifies checksum tag

' Returns 'passed' = -1 if OK, 0 if tampered/invalid

' ================================

Function DecryptField$ (cipher As String, keystr As String, passed As Integer)

    DecryptField$ = StripCheckTag$(encryptAESLite$(cipher, keystr, "d"), passed)

End Function





'=== EXAMPLE USAGE ======

'----------------------------------------

'DIM myKey AS STRING, encrypted$ AS STRING, decrypted$ AS STRING, isGood AS INTEGER



'myKey = keyGen$

'encrypted$ = EncryptField$("topsecret123", myKey)

'decrypted$ = DecryptField$(encrypted$, myKey, isGood)



'IF isGood THEN

'    PRINT "Decrypted OK: "; decrypted$

'ELSE

'    PRINT "Invalid decryption or tampered data!"

'END IF