Solved: Encrypt/Decrypt code needed 50 points!

Why do you need this?

ASKER

Hey ameba,
Firstly: I need this because i wish to write a program which will allow me and my brother to send private messages to each other. Secondly I wish to know how it is done and some of the various ways this is accomplished for my own private knowledge.
Now, why did you ask ? Is there something that i don't know about encryption pertaining to the law ? Is it illegal to compress information into a non readable state and then uncompress it ? Let me know, I don't want to break any laws of understanding !
Thanks
stnic

ameba

>Now, why did you ask ?
It's nice to hear reasons when somebody wants to 'crack' something.

LadyVyxen ones posted good VB Encrypt/Decrypt code.
You can find her here
https://www.experts-exchange.com/secure/Customer_Service/Lounge/Q.10180832

jjmartin

Encryption is a pretty big topic, and is something you could spend a fair amount of time studying. You can find a variety of encryption methods using VB at www.planet-source-code.com. Just do a search in the VB section. None of them are really spectacular or impossible to crack, but it's a place to start.

Pretty Good Privacy (PGP) is probably the strongest encryption available to the public. You may want to seach the web for that as well.

xlunax

Having been around hackers and such myself and since I have done a little myself I can safly say there is no such thing as an encryption algorithm or logarithm that is mathematically reversable. All math postulates have mathmatic inverses, however long and complex, they still exist. All encryption can EVENTUALLY be broken, its a matter of time and effort. As for doing this is VB, I'd suggest C for it. All the encryption I have seen is done in C using simple yet effective logarithms (mostly XOR's). I have never seen any VB source that can do any type of STRONG encryption, its usually very flimsy. But that also depends on the programmer.

stnic

ASKER

jjmartin,
Thank You for understanding what I need to study to increase my understanding of programming in visual basic. I have checked out your leads and found some actual code to study and play around with. Thank You ! I will visit the PGP page later...

ameba,
I must assume that your intentions in helping me were as real as my need to learn. I do have my doubts as to the address that was given to me above. I'm sure it was an oversight on your part. I have no intentions of cracking anything. There are plenty of "brute force" programs that will do this. I innocently asked and paid for a question that could not be answered by you.
Thank You for trying to help
stnic

Mirkwood

stnic

ASKER

xlunax,
That was very educational. I assume the gentleman who made the statement concerning his program was very happy in successfully making the program. I tend to agree with you however, not because of my programming abilities but because of your statement concerning "all encryption can be broken if one has the time". I am still interested in how it is done and will continue to study. It is very interesting to me.
Thanks Again !
stnic

stnic

ASKER

Hey Mirkwood,
Thanks for all of the listings. I have gone through some of them and will wait for more points to look at the rest.
Thanks Again
stnic

ameba

stnic, I really wanted to help.
The link is a good one. It will notify LadyVyxen. LadyVyxen likes Privacy and she posted code in unrelated LOUNGE question.
And you didnot have to pay anything to see a question.
I am a good guy.

Mirkwood

Search criteria: +ladyvyxen +lounge +privacy

Result: 4 topics

https://www.experts-exchange.com/jsp/qShow.jsp?ta=lounge&qid=10148051
https://www.experts-exchange.com/jsp/qShow.jsp?ta=lounge&qid=10146940
https://www.experts-exchange.com/jsp/qShow.jsp?ta=lounge&qid=10147003

Want to perform another search?
Take a look at https://www.experts-exchange.com/jsp/qShow.jsp?ta=commspt&qid=10167777

ameba

Public Function Decrypt(Entry As String, PassKey As String) As String
Public Function Encrypt(Entry As String, PassKey As String) As String

stnic

ASKER

Hey ameba,
I'm sure you are a good person and I do appreciate your help. I as per usual, fell off the deep end again. I can understand your concern regarding my question. There are those who disquise themselves to gain knowledge for negative reasons. You were just maintaining an awareness of this and nuff said !!!
Thanks Again
stnic

ameba

Thanks. Hope you'll get your code via LadyVyxen or by using Mirkwood's links. It's working (I tested it)

Mirkwood

Cannot find them in the lounge. Maybe the Q got deleted or in not a PAQ yet.

ameba

ok. i'll paste it here (10K module)

' Form
Option Explicit

Private Sub Form_Click()
Dim s As String
s = Encrypt("This is a test", "PASS")
Print s
Print
Print Decrypt(s, "PASS")
End Sub

' Module
Option Explicit
Private f
Private k As Long
Private u As Long
Private Key(0 To 131) As String

Public Function Decrypt(Entry As String, PassKey As String) As String
Dim p$, s$, t$, u$
On Error Resume Next
s = Entry
p = PassKey
InitCrypt p
Do Until Len(s) = 0
u = ""
u = Left$(s, 16)
s = Right$(s, Len(s) - 16)
If Len(u) > 0 Then
t = t + CLDecrypt(u)
End If
Loop
Decrypt = Trim$(t)
End Function

Public Function Encrypt(Entry As String, PassKey As String) As String
Dim p$, s$, t$, u$
On Error Resume Next
s = Entry
p = PassKey
InitCrypt p
t = ""
Do Until Len(s) = 0
u = ""
If Len(s) > 6 Then
u = Left$(s, 6)
s = Right$(s, Len(s) - 6)
Else
u = Left$(s + " ", 6)
s = ""
End If
If Len(u) > 0 Then
t = t + CLEncrypt(u)
End If
Loop
Encrypt = t
End Function
Private Function BigTrans(ByVal inp As String) As Double
Dim tempstr, loopit, tempnum, loopinner, Y
inp = Right$(inp, 8)
tempstr = String$(8 - Len(inp), "0") + inp
inp = ""
For loopit = 1 To 8
tempnum = Val("&H" + Mid$(tempstr, loopit, 1))
For loopinner = 3 To 0 Step -1
If tempnum And 2 ^ loopinner Then
inp = inp + "1"
Else
inp = inp + "0"
End If
Next loopinner
Next loopit
Dim o As Double, i As Integer
o = 0
For i = Len(inp) To 1 Step -1
If Mid(inp, i, 1) = "1" Then
Y = 1
Dim p, x
p = (Len(inp) - i)
x = 2
Do While p > 0
Do While (p / 2) = (p \ 2)
x = (x * x) Mod 255
p = p / 2
Loop
Y = (x * Y) Mod 255
p = p - 1
Loop
o = o + Y
End If
Next i
BigTrans = o
End Function
Private Function BigXOR(ByVal value1 As String, ByVal value2 As String) As String
Dim valueans As String
Dim loopit As Integer, tempnum As Integer
tempnum = Len(value1) - Len(value2)
If tempnum < 0 Then
valueans = Left$(value2, Abs(tempnum))
value2 = Mid$(value2, Abs(tempnum) + 1)
ElseIf tempnum > 0 Then
valueans = Left$(value1, Abs(tempnum))
value1 = Mid$(value1, tempnum + 1)
End If
For loopit = 1 To Len(value1)
valueans = valueans + Hex$(Val("&H" + Mid$(value1, loopit, 1)) Xor Val("&H" + Mid$(value2, loopit, 1)))
Next loopit
BigXOR = Right(valueans, 8)
End Function
Private Function CLDecrypt(inp As String) As String
Dim i
Dim w1(0 To 32) As String, w3(0 To 32) As String, w4(0 To 32) As String, w2(0 To 32) As String
Dim Counter(0 To 32) As Byte
Dim s As String
w1(32) = Mid(inp, 1, 4)
w2(32) = Mid(inp, 5, 4)
w3(32) = Mid(inp, 9, 4)
w4(32) = Mid(inp, 13, 4)
k = 32
u = 31
For i = 0 To 32
Counter(i) = i + 1
Next
For i = 1 To 8
w1(k - 1) = InvG(w2(k), Key())
w2(k - 1) = BigXOR(InvG(w2(k), Key()), BigXOR(w3(k), Hex(Counter(k - 1))))
w3(k - 1) = w4(k)
w4(k - 1) = w1(k)
u = u - 1
k = k - 1
Next
For i = 1 To 8
w1(k - 1) = InvG(w2(k), Key())
w2(k - 1) = w3(k)
w3(k - 1) = w4(k)
w4(k - 1) = BigXOR(BigXOR(w1(k), w2(k)), Hex(Counter(k - 1)))
u = u - 1
k = k - 1
Next
For i = 1 To 8
w1(k - 1) = InvG(w2(k), Key())
w2(k - 1) = BigXOR(InvG(w2(k), Key()), BigXOR(w3(k), Hex(Counter(k - 1))))
w3(k - 1) = w4(k)
w4(k - 1) = w1(k)
u = u - 1
k = k - 1
Next
For i = 1 To 8
w1(k - 1) = InvG(w2(k), Key())
w2(k - 1) = w3(k)
w3(k - 1) = w4(k)
w4(k - 1) = BigXOR(BigXOR(w1(k), w2(k)), Hex(Counter(k - 1)))
u = u - 1
k = k - 1
Next
s = Trim$(w1(0) & w2(0) & w3(0) & w4(0))
s = DeHex(s)
If InStr(s, Chr$(0)) > 0 Then
s = Left$(s, InStr(s, Chr$(0)) - 1)
End If
CLDecrypt = s
End Function
Private Function CLEncrypt(Entry As String) As String
Dim i As Integer
Dim w1(0 To 32) As String, w3(0 To 32) As String, w4(0 To 32) As String, w2(0 To 32) As String
Dim Counter As Long
Dim s As String
s = Entry
s = EnHex(s)
w1(0) = Mid(s, 1, 4)
w2(0) = Mid(s, 5, 4)
w3(0) = Mid(s, 9, 4)
w4(0) = Mid(s, 13, 4)
k = 0
Counter = 1
For i = 1 To 8
w1(k + 1) = BigXOR(BigXOR(G(w1(k), Key()), w4(k)), Hex(Counter))
w2(k + 1) = G(w1(k), Key())
w3(k + 1) = w2(k)
w4(k + 1) = w3(k)
Counter = Counter + 1
k = k + 1
Next
For i = 1 To 8
w1(k + 1) = w4(k)
w2(k + 1) = G(w1(k), Key())
w3(k + 1) = BigXOR(BigXOR(w1(k), w2(k)), Hex(Counter))
w4(k + 1) = w3(k)
Counter = Counter + 1
k = k + 1
Next
For i = 1 To 8
w1(k + 1) = BigXOR(BigXOR(G(w1(k), Key()), w4(k)), Hex(Counter))
w2(k + 1) = G(w1(k), Key())
w3(k + 1) = w2(k)
w4(k + 1) = w3(k)
Counter = Counter + 1
k = k + 1
Next
For i = 1 To 8
w1(k + 1) = w4(k)
w2(k + 1) = G(w1(k), Key())
w3(k + 1) = BigXOR(BigXOR(w1(k), w2(k)), Hex(Counter))
w4(k + 1) = w3(k)
Counter = Counter + 1
k = k + 1
Next
CLEncrypt = w1(32) & w2(32) & w3(32) & w4(32)
End Function
Private Function DeHex(inp As String) As String
Dim i, x
For i = 1 To Len(inp) Step 2
x = x & Chr(Val("&H" & Mid(inp, i, 2)))
Next i
DeHex = x
End Function
Private Function EnHex(x As String) As String
Dim i As Integer, v, inp
For i = 1 To Len(x)
v = Hex(Asc(Mid(x, i, 1)))
If Len(v) = 1 Then
v = "0" & v
End If
inp = inp & v
Next i
EnHex = inp
End Function
Private Function G(inp As String, Key() As String) As String
Dim g1 As String
Dim g2 As String
Dim g3 As String
Dim g4 As String
Dim g5 As String
Dim g6 As String
Dim l As String
g1 = Mid(inp, 1, 2)
g2 = Mid(inp, 3, 2)
l = f(CByte(BigTrans(BigXOR(g2, Key(4 * k)))))
g3 = BigXOR(l, g1)
l = f(CByte(BigTrans(BigXOR(g3, Key((4 * k) + 1)))))
g4 = BigXOR(l, g2)
l = f(CByte(BigTrans(BigXOR(g4, Key((4 * k) + 2)))))
g5 = BigXOR(l, g3)
l = f(CByte(BigTrans(BigXOR(g5, Key((4 * k) + 3)))))
g6 = BigXOR(l, g4)
l = g5 & g6
G = l
End Function
Private Sub InitCrypt(Pass As String)
Dim i As Long
Dim m As String
f = Array("A3", "D7", "09", "83", "F8", "48", "F6", "F4", "B3", "21", "15", "78", "99", "B1", "AF", "F9", "E7", "2D", "4D", _
"8A", "CE", "4C", "CA", "2E", "52", "95", "D9", "1E", "4E", "38", "44", "28", "0A", "DF", "02", "A0", "17", "F1", _
"60", "68", "12", "B7", "7A", "C3", "E9", "FA", "3D", "53", "96", "84", "6B", "BA", "F2", "63", "9A", "19", "7C", _
"AE", "E5", "F5", "F7", "16", "6A", "A2", "39", "B6", "7B", "0F", "C1", "93", "81", "1B", "EE", "B4", "1A", "EA", _
"D0", "91", "2F", "B8", "55", "B9", "DA", "85", "3F", "41", "BF", "E0", "5A", "58", "80", "5F", "66", "0B", "D8", _
"90", "35", "D5", "C0", "A7", "33", "06", "65", "69", "45", "00", "94", "56", "6D", "98", "9B", "76", "97", "FC", _
"B2", "C2", "B0", "FE", "DB", "20", "E1", "EB", "D6", "E4", "DD", "47", "4A", "1D", "42", "ED", "9E", "6E", "49", _
"3C", "CD", "43", "27", "D2", "07", "D4", "DE", "C7", "67", "18", "89", "CB", "30", "1F", "8D", "C6", "8F", "AA", _
"C8", "74", "DC", "C9", "5D", "5C", "31", "A4", "70", "88", "61", "2C", "9F", "0D", "2B", "87", "50", "82", "54", _
"64", "26", "7D", "03", "40", "34", "4B", "1C", "73", "D1", "C4", "FD", "3B", "CC", "FB", "7F", "AB", "E6", "3E", _
"5B", "A5", "AD", "04", "23", "9C", "14", "51", "22", "F0", "29", "79", "71", "7E", "FF", "8C", "0E", "E2", "0C", _
"EF", "BC", "72", "75", "6F", "37", "A1", "EC", "D3", "8E", "62", "8B", "86", "10", "E8", "08", "77", "11", "BE", _
"92", "4F", "24", "C5", "32", "36", "9D", "CF", "F3", "A6", "BB", "AC", "5E", "6C", "A9", "13", "57", "25", "B5", _
"E3", "BD", "A8", "3A", "01", "05", "59", "2A", "46")
SetKey Pass
End Sub
Private Function InvG(inp As String, Key() As String) As String
Dim g1 As String
Dim g2 As String
Dim g3 As String
Dim g4 As String
Dim g5 As String
Dim g6 As String
Dim l As String
g5 = Mid(inp, 1, 2)
g6 = Mid(inp, 3, 2)
l = f(CByte(BigTrans(BigXOR(g5, Key((4 * u) + 3)))))
g4 = BigXOR(l, g6)
l = f(CByte(BigTrans(BigXOR(g4, Key((4 * u) + 2)))))
g3 = BigXOR(l, g5)
l = f(CByte(BigTrans(BigXOR(g3, Key((4 * u) + 1)))))
g2 = BigXOR(l, g4)
l = f(CByte(BigTrans(BigXOR(g2, Key(4 * u)))))
g1 = BigXOR(l, g3)
l = g1 & g2
InvG = l
End Function
Private Sub SetKey(Pass As String)
Dim i As Integer
For i = 0 To 131 Step 10
If i = 130 Then
Key(i + 0) = Mid(Pass, 1, 2)
Key(i + 1) = Mid(Pass, 3, 2)
Else
Key(i + 0) = Mid(Pass, 1, 2)
Key(i + 1) = Mid(Pass, 3, 2)
Key(i + 2) = Mid(Pass, 5, 2)
Key(i + 3) = Mid(Pass, 7, 2)
Key(i + 4) = Mid(Pass, 9, 2)
Key(i + 5) = Mid(Pass, 11, 2)
Key(i + 6) = Mid(Pass, 13, 2)
Key(i + 7) = Mid(Pass, 15, 2)
Key(i + 8) = Mid(Pass, 17, 2)
Key(i + 9) = Mid(Pass, 19, 2)
End If
Next
End Sub

ameba

Mirkwood, it's Q.10145454 "NEED HELP WITH A PUZZLE!!!!"

mdougan

Bought this question.

I believe that I read about this person, Kelly Helfenstein, and if it's the one I'm thinking of, she is a young (15 year old?) girl who wrote an extremely good algorithm that cryptologists are still looking into. So, yes, it would be more than enough to secure private notes to one's brother.

Encryption and all of the various encryption schemes are just plain interesting to study, so have fun. But keep in mind that most of the complexity involved in Public/Private keys and the danger of brute force attacks exist because of the necessity for people that don't know each other to trade encrypted material. If you know someone, and if you have a way to pass them a "one time pad" then you can create an extremely secure message that is very easy to encode and decode.

A "one time pad" works this way. A series of letters and/or numbers is generated and used to substitute for the letters of your message. You and the person you are writing to have a "pad" of the same series of letters and/or numbers. After you code your message, you throw away that series and never use it again. Likewise, your correspondent will use the same series to decode the message and then throw away that series too. If you have a whole stack (like a pad of paper) of these random series, and you make sure you keep them in synch with the person you correspond with, then it is almost impossible to break this code. This is true because most attempts to crack such messages need several messages in order to find the solution. And, since you're throwing away the solution with each message, they'll never have more than one message to look at.

I wrote a sample "one time pad" in VB once and have the code around if anyone want's to play with it.