Any of the Words
Link to us
A Crypt/Decrypt function using a method developed ...
Click to e-mail author
A Crypt/Decrypt function using a method developed by an italian bishop around 1300.
' 'Crypt algoritm created by an italian bishop around 1300. It's a kind of transposed multi-alphabet method 'The Base Alphabet to be used is not written in a string (so you cannot find it while looking into the 'EXE file) but defined through the first and last ASCII code to be used (A_Min and A_Max, see below). ' 'Method works as follow (CryptKey = DonaldDuck): ' ' This is the text to be encoded with the Key (OrigTxt) ' DonaldDuckDonaldDuckDonaldDuckDonaldDuckDon (CryptKey) ' Epobme ' Fqpcnf <<<<<<<< READ THIS VERTICALLY Alphabets... ' Grqdog ' ...... ' ...... ' ...... 'For every character of CryptKey is built an alphabet starting from that character and looping 'through the Base Alphabet, so every character of the OrigTxt is coded with a different alphabet. ' Function Crypt(OrigTxt As String, CryptKey As String, Optional Action As Byte = 0) As String 'OrigTxt --> text to be crypted (I've tried to load into OrigTxt a 3Mb binary file and it worked fine) 'CryptKey --> key to be used to crypt OrigTxt 'Action (Optional with deafult=0) --> 0:Code Any other number:Decode Dim I, J, CT As String, Codif As String Dim A_Max As Integer, A_Min As Integer, A_Key As Integer, A_Char As Integer, Num As Long, Pos As Long I = 1 Codif = "" ' A_Min and A_Max specify the first and last ASCII code to be used for the Base Alphabet A_Min = 0 A_Max = 255 For J = 1 To Len(OrigTxt) DoEvents 'Adjust I value so it can correctly loop through characters of CryptKey I = ((I - 1) Mod Len(CryptKey)) + 1 'Find the ascii code of the current character of CryptKey A_Key = Asc(Mid(CryptKey, I, 1)) 'Extract the character to be coded from OrigTxt (based on J value) CT = Mid(OrigTxt, J, 1) 'Obtain the ascii code of the character just extracted A_Char = Asc(CT) If A_Char > A_Max Then Num = A_Char Else Select Case Action ' 0=Code AnyOther=Decode Case 0 'Coding phase Pos = A_Char - A_Min + 1 Num = A_Key - 1 + Pos If Num > A_Max Then Num = A_Min - 1 + Num - A_Max End If Case Else 'Decoding phase Pos = A_Char - A_Key + 1 If Pos < 0 Then Pos = (A_Max - A_Key + 1) + (A_Char - A_Min + 1) End If Num = A_Min + Pos - 1 End Select End If Mid(OrigTxt, J, 1) = Chr(Num) 'Move to the next character of CryptKey I = I + 1 Next Crypt = OrigTxt End Function
© 2022 A1VBCode. All rights reserved.