Find Code:
All Words
Any of the Words
Exact Phrase
Home
:
Code
:
Forums
:
Submit
:
Mailing List
:
About
:
Contact
Code
All
VB.NET
ASP.NET
C#
VB Classic
ASP Classic
Snippets
Popular
Resources
Submit Code
Forums
Articles
Tips
Links
Books
Contest
Link to us
Shackle Cipher 2048-bit
Author:
David M. Lewis
E-mail:
Click to e-mail author
Submitted:
1/25/2013
Version:
VB6
Compatibility:
VB6
Category:
Security
Views:
6371
Shackle is a 2048-bit cipher that employs plaintext chaining. The creation of new key blocks is seeded by previous blocks of plaintext. It also uses a transposition cipher (transpX) function to prevent known plaintext attacks. The speed is about 500KB per sec. For non-profit personal use only.
Declarations:
'none
Code:
'Shackle Encryption/Decryption Class '------------------------------------ ' 'Shackle is an asymetrical cipher that employs a block of plaintext as the password 'to generate a new 256 byte key via Transp256. Plaintext bytes are temporarily stored 'before they are encrypted with the current key. Once there are 256 pt bytes they 'are passed off to the transp256 function, with the previous key, which returns a new '256 byte key. Note the password is used to generate the first 256 byte key.' ' 'Cipher rate is approx 500KB per second. ' 'Change Log: '- Fixed error on large strings. Was running out of key bytes. '- Now uses transpX on all data too. ' '(c) 2013, David M. Lewis stmdk@hotmail.com 'For Personal Non-Profit Use Only. Contact author for details. Option Explicit '////SHACKLE Public Function Shackle_E(indata As String, password As String) As String Dim count As Integer Dim kval As Integer Dim pval As Integer 'pt Dim cval As Integer 'ct Dim holder As String 'hold 256 pt bytes for next key gen. Dim defkey As String Dim pcount As Integer Dim oldkey As String Dim ilen As Integer Dim ihash As String ilen = Len(indata) pcount = 0 holder = "" For count = 0 To 255 defkey = defkey & Chr(count) 'generate default plain key. Next count password = Transp256(defkey, password) 'create first key! ihash = password For count = 1 To ilen pcount = pcount + 1 If pcount > 256 Then pcount = 1 'reset counter 'Debug.Print "New Key" 'oldkey = password password = Transp256(password, holder) 'gen new key! holder = "" 'empty pt holder End If pval = Asc(Mid(indata, count, 1)) holder = holder & Chr(pval) 'Debug.Print pcount kval = Asc(Mid(password, pcount, 1)) cval = pval Xor kval Mid(indata, count, 1) = Chr(cval) Next count 'TranspX will run on the entire string, using the initial hash indata = TranspX(indata, ihash) Shackle_E = indata End Function Public Function Shackle_D(indata As String, password As String) As String 'Shackle decrypt Dim count As Integer Dim kval As Integer Dim pval As Integer 'pt Dim cval As Integer 'ct Dim holder As String 'hold 256 pt bytes for next key gen. Dim defkey As String Dim pcount As Integer Dim oldkey As String Dim ilen As Integer Dim ihash As String ilen = Len(indata) pcount = 0 holder = "" For count = 0 To 255 defkey = defkey & Chr(count) 'generate default plain key. Next count password = Transp256(defkey, password) 'create first key! ihash = password indata = TranspX(indata, ihash) ' for decryption we need to transpx here. For count = 1 To ilen pcount = pcount + 1 If pcount > 256 Then pcount = 1 'reset counter 'Debug.Print "New Key" 'oldkey = password password = Transp256(password, holder) 'gen new key! holder = "" 'empty pt holder End If pval = Asc(Mid(indata, count, 1)) 'Debug.Print pcount kval = Asc(Mid(password, pcount, 1)) cval = pval Xor kval holder = holder & Chr(cval) 'this is the only difference for decrypt!!! Mid(indata, count, 1) = Chr(cval) Next count Shackle_D = indata End Function Private Function Transp256(indata As String, password As String) As String Dim count As Integer Dim maptracker As String Dim Counter As Integer Dim plen As Integer Dim ilen As Integer Dim p1 As String Dim C1 As String Dim C2 As String Dim l1 As Integer Dim l2 As Integer ilen = Len(indata) Debug.Print "plen: " & plen plen = Len(password) If ilen > 256 Then MsgBox "Error: String too Large", vbCritical, "Function:Transp256": Exit Function If ilen < 1 Then MsgBox "Error: String too Small", vbCritical, "Function:Transp256": Exit Function If plen < 1 Then MsgBox "Error: Missing Password", vbCritical, "Function:Transp256": Exit Function maptracker = String(ilen, "0") 'empty the maptracker 'now we must make a transposition map2 using the password. 'we start off at byte 1 of the indata. We then trade it with a byte at the location 'determined by the byte value of the password + counter. If two bytes are traded, the 'maptracker is marked to prevent those bytes from being traded again. 'We go to the next untraded byte in the indata, move onto the next password byte, and see 'if we can perform another swap. If the byte has been used, we locate the next unused byte 'found after it. 'THIS IS TWO-WAY (Symetrical) For count = 1 To ilen If Mid(maptracker, count, 1) = "0" Then C1 = Mid(indata, count, 1) 'grab byte p1 = Mid(password, (count Mod plen) + 1, 1) 'grab pw byte l2 = Asc(p1) 'convert pw byte to location val. addagain: Counter = Counter + 1 'inc counter If Counter > 64 Then Counter = 1 'check counter max. l2 = l2 + Counter 'add counter val l2 = (l2 Mod ilen) + 1 'adjust for indata length If Mid(maptracker, l2, 1) = "1" Then GoTo addagain 'check if used.. C2 = Mid(indata, l2, 1) 'Good? Get the unused byte. Mid(indata, count, 1) = C2 'swap them! Mid(indata, l2, 1) = C1 Mid(maptracker, count, 1) = "1" 'mark used in tracker! Mid(maptracker, l2, 1) = "1" End If Next count Transp256 = indata End Function Private Function TranspX(indata As String, password As String) As String 'this function breaks up a long string into 256 byte chunks and sends it to transp256. Dim chunks As Integer Dim chunksize As Integer Dim remainder As Integer Dim output As String Dim ilen As Integer Dim count As Integer Dim chunkdata As String ilen = Len(indata) If ilen <= 256 Then TranspX = Transp256(indata, password): Exit Function chunksize = 256 chunks = Int(ilen / 256) remainder = ilen - (chunks * chunksize) For count = 1 To ilen Step chunksize chunkdata = Mid(ilen, count, chunksize) output = output & TranspX(chunkdata, password) Next count If remainder > 0 Then output = output & TranspX(Right(indata, remainder), password) End If TranspX = output End Function
Home
|
Forums
|
Submit
|
Books
|
Mailing List
|
Advertising
|
About
|
Contact
© 2024 A1VBCode. All rights reserved.
Legal disclaimer & terms of use
Privacy statement