by Anonymous (267 Submissions)
Category: Encryption
Compatability: Visual Basic 3.0
Difficulty: Unknown Difficulty
Originally Published: Tue 23rd September 2003
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
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
VBcoders
'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
No comments have been posted about Create an encrypted string (in a function) encrypted in both design mode and on compiled code (the . Why not be the first to post a comment about Create an encrypted string (in a function) encrypted in both design mode and on compiled code (the .
