-
Hi
I found a code sample at platet source code by HUNTER
I have 2 buttond command1 and command2, and a textbox
when I click command1 I want to all Ncrypt and encrypt
the text in the textbox and the opposite with command2
how is this done?
And another question.
In the decription of this code HUNTER sais it's 5 bit
how do you determen that?
Is it because the ex. Case "10241" asing 5 possible charachters?
------------------------------------------------------
'The code
Function Dcrypt(normalstring) As String
On Error Resume Next
Dim buildstring As String
Dim buildingstring As String
buildstring = ""
buildingstring = normalstring
For i = 1 To Len(normalstring)
Select Case Mid(buildingstring, i, 5)
Case "1024Ä"
buildstring = buildstring & " "
Case "10241"
buildstring = buildstring & "a"
Case "12242"
buildstring = buildstring & "b"
Case "10443"
buildstring = buildstring & "c"
Case "10254"
buildstring = buildstring & "d"
Case "10245"
buildstring = buildstring & "e"
Case "13246"
buildstring = buildstring & "f"
Case "10447"
buildstring = buildstring & "g"
Case "10258"
buildstring = buildstring & "h"
Case "14249"
buildstring = buildstring & "i"
Case "10540"
buildstring = buildstring & "j"
Case "1026a"
buildstring = buildstring & "k"
Case "1524b"
buildstring = buildstring & "l"
Case "1064c"
buildstring = buildstring & "m"
Case "1027d"
buildstring = buildstring & "n"
Case "1624e"
buildstring = buildstring & "o"
Case "1074f"
buildstring = buildstring & "p"
Case "1028g"
buildstring = buildstring & "q"
Case "1724h"
buildstring = buildstring & "r"
Case "1084i"
buildstring = buildstring & "s"
Case "1029j"
buildstring = buildstring & "t"
Case "1824k"
buildstring = buildstring & "u"
Case "1094l"
buildstring = buildstring & "v"
Case "1020m"
buildstring = buildstring & "w"
Case "1024n"
buildstring = buildstring & "x"
Case "1224o"
buildstring = buildstring & "y"
Case "1034p"
buildstring = buildstring & "z"
Case "1024q"
buildstring = buildstring & "1"
Case "2024r"
buildstring = buildstring & "2"
Case "1324s"
buildstring = buildstring & "3"
Case "1044t"
buildstring = buildstring & "4"
Case "3024u"
buildstring = buildstring & "5"
Case "1424v"
buildstring = buildstring & "6"
Case "1054w"
buildstring = buildstring & "7"
Case "4024x"
buildstring = buildstring & "8"
Case "1524y"
buildstring = buildstring & "9"
Case "1064z"
buildstring = buildstring & "0"
Case "5024A"
buildstring = buildstring & "!"
Case "1624B"
buildstring = buildstring & "@"
Case "1074C"
buildstring = buildstring & "#"
Case "6024D"
buildstring = buildstring & "$"
Case "1724E"
buildstring = buildstring & "%"
Case "1084F"
buildstring = buildstring & "^"
Case "7024G"
buildstring = buildstring & "&"
Case "1824H"
buildstring = buildstring & "*"
Case "1094I"
buildstring = buildstring & "("
Case "8024J"
buildstring = buildstring & ")"
Case "1924K"
buildstring = buildstring & "-"
Case "1004L"
buildstring = buildstring & "_"
Case "0024M"
buildstring = buildstring & "="
Case "1924N"
buildstring = buildstring & "+"
Case "1084O"
buildstring = buildstring & "["
Case "9024P"
buildstring = buildstring & "]"
Case "1824Q"
buildstring = buildstring & "{"
Case "1074R"
buildstring = buildstring & "}"
Case "8024S"
buildstring = buildstring & "\"
Case "1724T"
buildstring = buildstring & "|"
Case "1064U"
buildstring = buildstring & ";"
Case "7024V"
buildstring = buildstring & ":"
Case "1624W"
buildstring = buildstring & "'"
Case "1054X"
buildstring = buildstring & Chr(22)
Case "6024Y"
buildstring = buildstring & "<"
Case "1524Z"
buildstring = buildstring & ">"
Case "1044!"
buildstring = buildstring & ","
Case "5024@"
buildstring = buildstring & "."
Case "1424#"
buildstring = buildstring & "/"
Case "1034$"
buildstring = buildstring & "?"
Case "4024%"
buildstring = buildstring & "`"
Case "1324^"
buildstring = buildstring & "~"
Case "1024&"
buildstring = buildstring & Chr(13)
Case "3024*"
buildstring = buildstring & Chr(10)
End Select
Next i
Dcrypt = buildstring
DoEvents
End Function
Function Ncrypt(normalstring) As String
On Error Resume Next
Dim buildstring As String
Dim buildingstring As String
buildstring = ""
buildingstring = LCase(normalstring)
For i = 1 To Len(normalstring)
Select Case Mid(buildingstring, i, 1)
Case " "
buildstring = buildstring & "1024Ä"
Case "a"
buildstring = buildstring & "10241"
Case "b"
buildstring = buildstring & "12242"
Case "c"
buildstring = buildstring & "10443"
Case "d"
buildstring = buildstring & "10254"
Case "e"
buildstring = buildstring & "10245"
Case "f"
buildstring = buildstring & "13246"
Case "g"
buildstring = buildstring & "10447"
Case "h"
buildstring = buildstring & "10258"
Case "i"
buildstring = buildstring & "14249"
Case "j"
buildstring = buildstring & "10540"
Case "k"
buildstring = buildstring & "1026a"
Case "l"
buildstring = buildstring & "1524b"
Case "m"
buildstring = buildstring & "1064c"
Case "n"
buildstring = buildstring & "1027d"
Case "o"
buildstring = buildstring & "1624e"
Case "p"
buildstring = buildstring & "1074f"
Case "q"
buildstring = buildstring & "1028g"
Case "r"
buildstring = buildstring & "1724h"
Case "s"
buildstring = buildstring & "1084i"
Case "t"
buildstring = buildstring & "1029j"
Case "u"
buildstring = buildstring & "1824k"
Case "v"
buildstring = buildstring & "1094l"
Case "w"
buildstring = buildstring & "1020m"
Case "x"
buildstring = buildstring & "1024n"
Case "y"
buildstring = buildstring & "1224o"
Case "z"
buildstring = buildstring & "1034p"
Case "1"
buildstring = buildstring & "1024q"
Case "2"
buildstring = buildstring & "2024r"
Case "3"
buildstring = buildstring & "1324s"
Case "4"
buildstring = buildstring & "1044t"
Case "5"
buildstring = buildstring & "3024u"
Case "6"
buildstring = buildstring & "1424v"
Case "7"
buildstring = buildstring & "1054w"
Case "8"
buildstring = buildstring & "4024x"
Case "9"
buildstring = buildstring & "1524y"
Case "0"
buildstring = buildstring & "1064z"
Case "!"
buildstring = buildstring & "5024A"
Case "@"
buildstring = buildstring & "1624B"
Case "#"
buildstring = buildstring & "1074C"
Case "$"
buildstring = buildstring & "6024D"
Case "%"
buildstring = buildstring & "1724E"
Case "^"
buildstring = buildstring & "1084F"
Case "&"
buildstring = buildstring & "7024G"
Case "*"
buildstring = buildstring & "1824H"
Case "("
buildstring = buildstring & "1094I"
Case ")"
buildstring = buildstring & "8024J"
Case "-"
buildstring = buildstring & "1924K"
Case "_"
buildstring = buildstring & "1004L"
Case "="
buildstring = buildstring & "0024M"
Case "+"
buildstring = buildstring & "1924N"
Case "["
buildstring = buildstring & "1084O"
Case "]"
buildstring = buildstring & "9024P"
Case "{"
buildstring = buildstring & "1824Q"
Case "}"
buildstring = buildstring & "1074R"
Case "\"
buildstring = buildstring & "8024S"
Case "|"
buildstring = buildstring & "1724T"
Case ";"
buildstring = buildstring & "1064U"
Case ":"
buildstring = buildstring & "7024V"
Case "'"
buildstring = buildstring & "1624W"
Case Chr(22)
buildstring = buildstring & "1054X"
Case "<"
buildstring = buildstring & "6024Y"
Case ">"
buildstring = buildstring & "1524Z"
Case ","
buildstring = buildstring & "1044!"
Case "."
buildstring = buildstring & "5024@"
Case "/"
buildstring = buildstring & "1424#"
Case "?"
buildstring = buildstring & "1034$"
Case "`"
buildstring = buildstring & "4024%"
Case "~"
buildstring = buildstring & "1324^"
Case Chr(13)
buildstring = buildstring & "1024&"
Case Chr(10)
buildstring = buildstring & "3024*"
End Select
Next i
Ncrypt = buildstring
DoEvents
End Function
-----------------------------------------------------
Thanks for your time
Chris Davidsen
-
<?>
Code:
'to encrypt a string in a textbox
''
Public Function Encrypt(Text As String, Password As String)
On Error Resume Next
Dim X As Long
Dim Y As Long
Dim CurChar As Byte
Dim CurChar1 As Byte
Dim CurChar2 As Byte
Dim EncText As String
Dim UnEncText As String
Dim CodeLoop As Integer
Dim Code As Byte
Dim LoopVar As Byte
Dim FirstLetter As Byte
UnEncText = Text & Password
LoopVar = 1
Do While LoopVar <> Len(Password) + 1
CodeLoop = CodeLoop + Asc(Mid(Password, LoopVar, 1))
LoopVar = LoopVar + 1
Loop
Code = Int((CodeLoop / LoopVar / 2)) - 1
FirstLetter = Int(Asc(Mid(Password, 1, 1)) / 2) - 1
X = 0
Y = Len(UnEncText)
Do While X < Y
X = X + 1
CurChar = Asc(Mid(UnEncText, X, 1))
CurChar1 = Int(CurChar / 2) + FirstLetter
CurChar2 = Int(CurChar / 2) + Code
If CurChar1 - FirstLetter + CurChar2 - Code <> CurChar Then CurChar2 = CurChar2 + 1
EncText = Chr(CurChar1) & Chr(CurChar2) & EncText
Loop
Encrypt = EncText
End Function
'
'-----------------------------------------------------------------
'
Public Function Decrypt(Text As String, Password As String)
On Error Resume Next
Dim X As Long
Dim Y As Long
Dim CurChar As Byte
Dim EncText As String
Dim CodeLoop As Integer
Dim Code As Byte
Dim LoopVar As Byte
Dim FirstLetter As Byte
LoopVar = 1
Do While LoopVar <> Len(Password) + 1
CodeLoop = CodeLoop + Asc(Mid(Password, LoopVar, 1))
LoopVar = LoopVar + 1
Loop
Code = Int((CodeLoop / LoopVar / 2)) - 1
FirstLetter = Int(Asc(Mid(Password, 1, 1)) / 2) - 1
X = 0
Y = Len(Text)
Do While X < Y
X = X + 2
CurChar = Asc(Mid(Text, X - 1, 1)) + Asc(Mid(Text, X, 1)) - Code - FirstLetter
EncText = Chr(CurChar) & EncText
Loop
If Len(EncText) = 0 Then
Decrypt = ""
Else
If Len(Password) > Len(EncText) Then
Decrypt = "Wrong password."
Else
If Password = Mid(EncText, Len(EncText) - Len(Password) + 1) Then
Decrypt = Mid(EncText, 1, Len(EncText) - Len(Password))
Else
Decrypt = "Wrong password."
End If
End If
End If
End Function
'
'------------------------------------------------------------------
'
'to encrypt
'
Text1.Text = Encrypt(text1.text, "*.%jl;")
'
'To decrypt is just as easy.
'To decrypt Text1 and put it in Text2, use this:
'
Text1.Text = Decrypt(Text1.Text, "*.%jl;")
'
-
HeSaiJoe's code is much better then the code from hunter.
