• Home
 · 
• Encryption
 · 
• Encyption/Decryption of password.

Encyption/Decryption of password.

Encyption/Decryption of password.

Rate Encyption/Decryption of password.

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

'/* 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.