• Home
 · 
• Encryption
 · 
• Create an encrypted string (in a function) encrypted in both design mode and on compiled code (the

Create an encrypted string (in a function) encrypted in both design mode and on compiled code (the

Create an encrypted string (in a function) encrypted in both design mode and on compiled code (the only way to see the contents is to use

Rate Create an encrypted string (in a function) encrypted in both design mode and on compiled code (the

• 1
• 2
• 3
• 4
• 5

(3(3 Vote))

    'Creates an encrypted string. The following are the parameters:
    '   Name            The Name of the String
    '   Contents        The String Contents
    '   DestinationFile Where to save the function (encrypted string) (Empty will be Immediate)

    'Note: The string is to be used as a constant
    'Note: It looks better to transfer the encrypted string to a normal string
    '   during runtime if you are going to access the ecrypted string frequently
    '   For Example:
    '       NormalString = EncryptedString

    Dim FF As Integer
    Dim Char As Long
    Dim CharStatus() As Boolean
    Dim Finish As Boolean

    Dim RandomNum As Integer

    If IsMissing(DestinationFile) Then DestinationFile = ""
    
    If DestinationFile <> "" Then
        FF = FreeFile
        Open DestinationFile For Output As FF
    End If

    'Names the function
    If DestinationFile = "" Then Debug.Print "Private Function " + Name + "() As String 'Encrypted String"
    If DestinationFile <> "" Then Print #FF, "Private Function " + Name + "() As String 'Encrypted String"
    
    'Declarations
    If DestinationFile = "" Then Debug.Print "    Dim Char as Long"
    If DestinationFile <> "" Then Print #FF, "    Dim Char as Long"
    
    If DestinationFile = "" Then Debug.Print "    Dim Buffer as String"
    If DestinationFile <> "" Then Print #FF, "    Dim Buffer as String"
    
    If DestinationFile = "" Then Debug.Print ""
    If DestinationFile <> "" Then Print #FF, ""
    
    'Loop (to make it difficult) (this is where the slowdown comes from)
    If DestinationFile = "" Then Debug.Print "    For Char = 1 to " + Trim$(Str$(Len(Contents)))
    If DestinationFile <> "" Then Print #FF, "    For Char = 1 to " + Trim$(Str$(Len(Contents)))
    
    'Select case, assigning contents
    If DestinationFile = "" Then Debug.Print "        Select Case Char"
    If DestinationFile <> "" Then Print #FF, "        Select Case Char"
    
    ReDim CharStatus(1 To Len(Contents)) As Boolean
    For CChar = 1 To Len(Contents)
        Randomize Timer
        'If DestinationFile = "" Then Debug.Print "            Case " + Trim$(Str$(Char)) + ": Buffer = Buffer + Chr$(Asc(Chr$(Asc(""" + Mid$(Contents, Char, 1) + """))))"
        'If DestinationFile <> "" Then Print #FF, "            Case " + Trim$(Str$(Char)) + ": Buffer = Buffer + Chr$(Asc(Chr$(Asc(""" + Mid$(Contents, Char, 1) + """))))"
        
        
        'The Case contents are completely random
        Finish = False
        Do
            RandomNumber = Int(Rnd * Len(Contents)) + 1
            If CharStatus(RandomNumber) = False Then
                CharStatus(RandomNumber) = True
                Finish = True
                Char = RandomNumber
            End If
        Loop Until Finish
        
        RandomNumber = Int(Rnd * 8192)
        If DestinationFile = "" Then Debug.Print "            Case " + Trim$(Str$(Char)) + ": Buffer = Buffer + Chr$(Asc(Chr$(Asc(Chr$(" + Trim$(Str$(RandomNumber + Asc(Mid$(Contents, Char, 1)))) + " - " + Trim$(Str$(RandomNumber)) + ")))))"
        If DestinationFile <> "" Then Print #FF, "            Case " + Trim$(Str$(Char)) + ": Buffer = Buffer + Chr$(Asc(Chr$(Asc(Chr$(" + Trim$(Str$(RandomNumber + Asc(Mid$(Contents, Char, 1)))) + " - " + Trim$(Str$(RandomNumber)) + ")))))"
    Next
    
    'End the select case block
    If DestinationFile = "" Then Debug.Print "        End Select"
    If DestinationFile <> "" Then Print #FF, "        End Select"

    'end the loop
    If DestinationFile = "" Then Debug.Print "    Next"
    If DestinationFile <> "" Then Print #FF, "    Next"
    
    'Move from the buffer
    If DestinationFile = "" Then Debug.Print "    " + Name + " = Buffer"
    If DestinationFile <> "" Then Print #FF, "    " + Name + " = Buffer"

    'Finish the function
    If DestinationFile = "" Then Debug.Print "End Function"
    If DestinationFile <> "" Then Print #FF, "End Function"
End Sub



'Sample, you may delete from here

'Can you tell what it says?
Private Function TellThis() As String 'Encrypted String
    Dim Char As Long
    Dim Buffer As String

    For Char = 1 To 11
        Select Case Char
            Case 6: Buffer = Buffer + Chr$(Asc(Chr$(Asc(Chr$(7201 - 7169)))))
            Case 3: Buffer = Buffer + Chr$(Asc(Chr$(Asc(Chr$(2719 - 2611)))))
            Case 8: Buffer = Buffer + Chr$(Asc(Chr$(Asc(Chr$(870 - 759)))))
            Case 9: Buffer = Buffer + Chr$(Asc(Chr$(Asc(Chr$(1594 - 1480)))))
            Case 7: Buffer = Buffer + Chr$(Asc(Chr$(Asc(Chr$(4994 - 4907)))))
            Case 5: Buffer = Buffer + Chr$(Asc(Chr$(Asc(Chr$(6156 - 6045)))))
            Case 1: Buffer = Buffer + Chr$(Asc(Chr$(Asc(Chr$(6528 - 6456)))))
            Case 4: Buffer = Buffer + Chr$(Asc(Chr$(Asc(Chr$(8015 - 7907)))))
            Case 11: Buffer = Buffer + Chr$(Asc(Chr$(Asc(Chr$(4665 - 4565)))))
            Case 10: Buffer = Buffer + Chr$(Asc(Chr$(Asc(Chr$(746 - 638)))))
            Case 2: Buffer = Buffer + Chr$(Asc(Chr$(Asc(Chr$(5505 - 5404)))))
        End Select
    Next
    TellThis = Buffer
End Function