by Mainye (1 Submission)
Category: Encryption
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Mon 4th January 2010
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Encyption/Decryption of password.
VBcoders
'/* Created:10/03/2010 Last Modified:30/03/2010 */'
'/* Mainye M. Kevin */'
Dim Ciphered As String, AscString, fAscString
Dim croppedNoPos As String, croppedString As String
Dim tempCiphered As String, tempCropped As String, tempCroppedNoPos As String
Dim oneBlock As String, twoBlock As String, twistedBlock As String
Dim x As Long, SelText As String, Decrypt As String, fReverse As Boolean
Const Three = 3, Two = 2, One = 1, Zero = 0, HyPhen = "-", Star = "*", DblQuotes = ""
Public Sub Cipher(theText As String)
fReverse = False
'Make string Variables empty
EmptyStrings
'Split the password into 2 parts.Not necessarily equal
Split2Two theText
'Concatenate the two parts
twistedBlock = twoBlock & oneBlock
'Loop through the length of the concatenated block,ciphering each letter or numeral using the algorith provided
'at the bottom of this module
For x = One To Len(twistedBlock)
SelText = Mid(twistedBlock, x, One)
AscString = Asc(SelText)
If Len(AscString) > Two Then
fAscString = Right(AscString, Two)
croppedString = Mid(AscString, One, Len(AscString) - Two)
tempCroppedNoPos = x
If x = Len(twistedBlock) Then
tempCroppedNoPos = x
Else
tempCroppedNoPos = x & HyPhen
End If
Else
fAscString = Mid(AscString, One, Len(AscString))
croppedString = ""
End If
tempCiphered = tempCiphered & fAscString
If croppedString <> DblQuotes Then
tempCropped = croppedString
tempCroppedNoPos = tempCropped & Star & tempCroppedNoPos
croppedNoPos = croppedNoPos & tempCroppedNoPos
Else
croppedNoPos = croppedNoPos
End If
Next
'Result=The ciphered text
Ciphered = tempCiphered & croppedNoPos
'CheckIfAllNumerals Ciphered
'Form1.Text2 = CStr(Ciphered)
End Sub
Public Function CheckIfAllNumerals(theText As String) As Boolean
CheckIfAllNumerals = False
For x = One To Len(theText)
SelText = Mid(theText, x, One)
If Not IsNumeric(CInt(SelText)) Then
CheckIfAllNumerals = False
Exit Sub
Else
End If
Next
End Function
Public Sub Decipher(theText As String)
Reverse theText
'Form1.Text2.Text = CStr(Decrypt)
End Sub
Public Sub Split2Two(theText As String)
Dim Length As Long, DivByTwo As Boolean, ResDivByTwo
Length = Len(theText)
If Not Length = 0 Then
If fnDivByTwo(CInt(Length)) = True Then
DivByTwo = True
ResDivByTwo = Length / Two
oneBlock = Mid(theText, One, ResDivByTwo)
twoBlock = Mid(theText, ResDivByTwo + One, ResDivByTwo)
Else
DivByTwo = False
ResDivByTwo = (Length - One) / Two
If fReverse = True Then
oneBlock = Mid(theText, One, ResDivByTwo + One)
twoBlock = Mid(theText, ResDivByTwo + Two, ResDivByTwo)
Else
oneBlock = Mid(theText, One, ResDivByTwo)
twoBlock = Mid(theText, ResDivByTwo + One, ResDivByTwo + One)
End If
End If
Else
Exit Sub
End If
End Sub
Public Function fnDivByTwo(Num As Integer) As Boolean
If Num Mod 2 = 0 Then
fnDivByTwo = True
Else
fnDivByTwo = False
End If
End Function
Private Sub EmptyStrings()
Ciphered = DblQuotes
AscString = DblQuotes
fAscString = DblQuotes
croppedNoPos = DblQuotes
croppedString = DblQuotes
tempCiphered = DblQuotes
tempCropped = DblQuotes
End Sub
Public Sub Reverse(theText As String)
Dim theCiph As String, theCrop As String, Pos As Integer, theArray() As String
Dim Count As Integer, Point As Long, tempDecrypt As String, xDescrypt As String
Dim selCrop As String, ArrLen As Long, cropArray() As String, Prefix As String, Suffix As String
Dim PassedPrev As Boolean, PassedTimes As Long, PassedTimesArray As Long
Count = One
Point = One
PassedTimes = Zero
If InStr(One, theText, Star) Then
Pos = InStr(One, theText, Star)
theCiph = Mid(theText, One, Pos - Two)
theCrop = Right(theText, Len(theText) - Len(theCiph))
theArray = Split(theCrop, HyPhen, , vbTextCompare)
ArrLen = UBound(theArray) + One
For x = One To Len(theCiph)
If Count = One Then
SelText = Mid(theCiph, One, Two)
selCrop = theArray(Count - One)
cropArray = Split(selCrop, Star, , vbTextCompare)
Prefix = cropArray(Zero)
Suffix = cropArray(One)
If x = Suffix Then
xDescrypt = Prefix & SelText
PassedPrev = False
PassedTimes = Zero
Else
xDescrypt = SelText
PassedPrev = True
PassedTimes = PassedTimes + One
PassedTimesArray = PassedTimesArray + One
End If
tempDecrypt = Chr(xDescrypt)
Else
SelText = Mid(theCiph, Point, Two)
If Not SelText = DblQuotes Then
If (ArrLen < Zero And SelText <> DblQuotes) Then
ArrLen = ArrLen + PassedTimesArray
End If
If ArrLen >= Zero Then
selCrop = theArray(Count - (One + PassedTimesArray))
cropArray = Split(selCrop, Star, , vbTextCompare)
Prefix = cropArray(Zero)
Suffix = cropArray(One)
If x = Suffix Then
xDescrypt = Prefix & SelText
PassedPrev = False
PassedTimes = Zero
Else
xDescrypt = SelText
PassedPrev = True
PassedTimes = PassedTimes + One
PassedTimesArray = PassedTimesArray + One
End If
tempDecrypt = tempDecrypt & Chr(xDescrypt)
End If
End If
End If
Point = Point + Two
Count = Count + One
ArrLen = ArrLen - One
Next
End If
fReverse = True
Split2Two tempDecrypt
Decrypt = twoBlock & oneBlock
End Sub
'*******************************************************************************
' CIPHERING ALGORITHM
'*******************************************************************************
'1.Pick the password provided.Empty string passwords do not qualify.
'2.Split the password to two parts as follows.
' 2.1 If the length of the password is an even number split into two equal blocks.
' 2.2 If the length of the password is an odd number,pick the first block as a length
' a number less than the length of the second block.
'3.Twist the blocks and concatenate the result.E.g 'myn' and 'ames' becomes 'amesmyn'
'4.Loop through the length of the concatenated block by no. of times equivalent to the length of the block
' ciphering each character by converting it into its ascii character equivalent.
'5.If the length of the character ascii equivalent is greater than 2
' Cut the characters on the left of the word,leaving only the two on the right,holding the cut ones in a variable.
'6.Take the cut characters and concatenate them with a multiplication sign and also concatenate with the
' position of the character which was converted to ascii on the full block which is being ciphered.
'7.Loop through all characters appending the succeeding ciphered characters on the preceding ciphered characters
' and the succeeding cut characters on the preceding cut characters.
' Note.Before appending a succeeding cut character to the preceding one,a hyphen should separate the two.
'8.The end result is the ciphered equivalent of the original password.
'*******************************************************************************
' DECIPHERING ALGORITHM
'*******************************************************************************
'The deciphering algorithm is a reversal[*Not Quite Straight Forward*] of the CIPHERING algorithm
'With the end result being the original password.
