• Home
 · 
• String Manipulation
 · 
• This code uses two forms of encryption, and a simple form of compression to thoroughly encrypt any

This code uses two forms of encryption, and a simple form of compression to thoroughly encrypt any

This code uses two forms of encryption, and a simple form of compression to thoroughly encrypt any string given (the compression doesn't work

Rate This code uses two forms of encryption, and a simple form of compression to thoroughly encrypt any

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

    Text1.text = encrypt$(compress$(Text1.text))
end sub

private sub Command2_click()
    Text1.text = decompress$(decrypt$(Text1.text))
end sub


Public Function compress$(inString$)

r$ = ""
For i = 1 To Len(inString$)
     a$ = Mid$(inString$, i, 1)
     If a$ = " " Then
          i = i + 1
          a$ = Mid$(inString$, i, 1)
          a$ = Chr$(127 + Asc(a$))
     End If
     r$ = r$ + a$
Next i

compress$ = r$

End Function

Public Function decompress$(inString$)

r$ = ""
For i = 1 To Len(inString$)
     a$ = Mid$(inString$, i, 1)
     If Asc(a$) >= 127 Then a$ = " " + Chr$(Asc(a$) - 127)
     r$ = r$ + a$
Next i

decompress$ = r$

End Function

Public Function decryptIt$(inString$)

    Dim lineLen%(10)
    Dim lineString$(10)
    onLine% = 1
    
    l% = 14
    head$ = Left$(inString$, l% + 1)
    cI% = Asc(Left$(inString$, 1))
    For i = 1 To 10
         lineLen%(i) = Asc(Mid$(inString$, i + 1, 1))
    Next i
    tL% = 0 'Asc(Mid$(inString$, 12, 1))
    For i = 1 To 10
        tL% = tL% + lineLen%(i)
    Next i
    
    For i = 1 To 10
         lineString$(i) = inverseLine$(Mid$(inString$, l%, lineLen%(i)))
         l% = l% + lineLen%(i)
    Next i
    
    
    c% = 1: l% = 1
    un$ = ""
    For i = 1 To tL%
         a% = Asc(Mid$(lineString$(l%), c%, 1)) - cI%
         If a% < 0 Then a% = a% + 255
         un$ = un$ + Chr$(a%)
         l% = l% + 1
         If l% = 11 Then l% = 1: c% = c% + 1
    Next i
    
    decryptIt$ = un$

End Function

Public Function encryptIt$(inString$, comTyp%)
'comTyp% = 0 for not compressed, 1 for compressed

    Dim lineString$(10)
    onLine% = 1
    
    startStr$ = inString$
    
    For i = 1 To Len(startStr$)
         a = Asc(Mid$(startStr$, i, 1)) + codeIncrease%
         If a > 255 Then a = a - 255
        
         lineString$(onLine%) = lineString$(onLine%) + Chr$(a)
         onLine% = onLine% + 1
         If onLine% = 11 Then onLine% = 1
    Next i
    
    
    head$ = ""
    For i = 1 To 10
         head$ = head$ + Chr$(Len(lineString$(i)))
    Next i
    
    outString$ = Chr$(codeIncrease%) + head$ + Chr$(Len(" ")) + Chr$(comTyp% + 254)
    For i = 1 To 10
        outString$ = outString$ + inverseLine$(lineString$(i))
    Next i
    
    encryptIt$ = outString$

End Function

Private Function inverseLine$(inString$)

a$ = ""
For i = Len(inString$) To 1 Step -1
    a$ = a$ + Mid$(inString$, i, 1)
Next i

inverseLine$ = a$

End Function

Public Function determineType(inString$)

'0 = regular text file
'1 = is compressed
'2 = is encrypted
'3 = is both
    
    determineType = 0
        
    a$ = Mid$(inString$, 12, 1)
    If a$ = Chr$(255) Then
        determineType = 3
    ElseIf a$ = Chr$(254) Then
        determineType = 2
    Else
        For i = 1 To Len(inString$)
            If Mid$(inString$, i, 1) = " " Then Exit For
        Next i
        If i = Len(inString$) Then determineType = 1
    End If

End Function