Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

PC1 encryption - 128-bit key implementation

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • PC1 encryption - 128-bit key implementation

    'PC1 encryption - 128-bit key implementation
    'More info on this algo can be found at http://membres.lycos.fr/pc1/
    'Ported from VB to PB by Wayne Diamond
    'This can be cranked up a lot - there is _no_ assembly optimisation

    Code:
    #COMPILE EXE
    
    GLOBAL x1a0() AS LONG
    GLOBAL cle() AS LONG
    GLOBAL x1a2 AS LONG
    GLOBAL inter AS LONG, res AS LONG, ax AS LONG, bx AS LONG
    GLOBAL cx AS LONG, dx AS LONG, si AS LONG, tmp AS LONG
    GLOBAL I AS LONG, c AS BYTE
    
    #INCLUDE "WIN32API.INC"
    
    SUB code()
    ON ERROR RESUME NEXT
    dx = (x1a2 + I) MOD 65536
    ax = x1a0(I)
    cx = &H15A
    bx = &H4E35
    tmp = ax
    ax = si
    si = tmp
    tmp = ax
    ax = dx
    dx = tmp
    IF (ax <> 0) THEN
    ax = (ax * bx) MOD 65536
    END IF
    tmp = ax
    ax = cx
    cx = tmp
    IF (ax <> 0) THEN
    ax = (ax * si) MOD 65536
    cx = (ax + cx) MOD 65536
    END IF
    tmp = ax
    ax = si
    si = tmp
    ax = (ax * bx) MOD 65536
    dx = (cx + dx) MOD 65536
    ax = ax + 1
    x1a2 = dx
    x1a0(I) = ax
    res = ax XOR dx
    I = I + 1
    END SUB
    
    
    SUB Assemble()
    ON ERROR RESUME NEXT
    x1a0(0) = ((cle(1) * 256) + cle(2)) MOD 65536
    code
    inter = res
    x1a0(1) = x1a0(0) XOR ((cle(3) * 256) + cle(4))
    code
    inter = inter XOR res
    x1a0(2) = x1a0(1) XOR ((cle(5) * 256) + cle(6))
    code
    inter = inter XOR res
    x1a0(3) = x1a0(2) XOR ((cle(7) * 256) + cle(8))
    code
    inter = inter XOR res
    x1a0(4) = x1a0(3) XOR ((cle(9) * 256) + cle(10))
    code
    inter = inter XOR res
    x1a0(5) = x1a0(4) XOR ((cle(11) * 256) + cle(12))
    code
    inter = inter XOR res
    x1a0(6) = x1a0(5) XOR ((cle(13) * 256) + cle(14))
    code
    inter = inter XOR res
    x1a0(7) = x1a0(6) XOR ((cle(15) * 256) + cle(16))
    code
    inter = inter XOR res
    I = 0
    END SUB
    
    
    FUNCTION PC1ENC(encPassword AS STRING, encStringOut AS STRING) EXPORT AS STRING
    ON ERROR RESUME NEXT
    DIM encStringIn AS STRING
    DIM fois AS LONG
    DIM champ1 AS STRING
    DIM lngchamp1 AS LONG
    DIM cfc AS LONG, cfd AS LONG
    DIM compte AS LONG
    DIM c AS LONG, D AS LONG, E AS LONG
    REDIM x1a0(9) AS LONG
    REDIM cle(17) AS LONG
    encStringIn = ""
    si = 0
    x1a2 = 0
    I = 0
    FOR fois = 1 TO 16
    cle(fois) = 0
    NEXT fois
    champ1 = encPassword
    lngchamp1 = LEN(champ1)
    FOR fois = 1 TO lngchamp1
    cle(fois) = ASC(MID$(champ1, fois, 1))
    NEXT fois
    champ1 = encStringOut
    lngchamp1 = LEN(champ1)
    FOR fois = 1 TO lngchamp1
    c = ASC(MID$(champ1, fois, 1))
    Assemble
    cfc = (((inter / 256) * 256) - (inter MOD 256)) / 256
    cfd = inter MOD 256
    FOR compte = 1 TO 16
    cle(compte) = cle(compte) XOR c
    NEXT compte
    c = c XOR (cfc XOR cfd)
    D = (((c / 16) * 16) - (c MOD 16)) / 16
    E = c MOD 16
    encStringIn = encStringIn + CHR$(&H61 + D) ' d+&h61 give one letter range from a to p for the 4 high bits of c
    encStringIn = encStringIn + CHR$(&H61 + E) ' e+&h61 give one letter range from a to p for the 4 low bits of c
    NEXT fois
    PC1ENC = encStringIn
    END FUNCTION
    
    
    FUNCTION PC1DEC(encPassword AS STRING, encStringIn AS STRING) EXPORT AS STRING
    ON ERROR RESUME NEXT
    DIM encStringOut AS STRING
    DIM fois AS LONG
    DIM champ1 AS STRING
    DIM lngchamp1 AS LONG
    DIM cfc AS LONG, cfd AS LONG
    DIM compte AS LONG
    DIM c AS LONG, D AS LONG, E AS LONG
    REDIM x1a0(9) AS LONG
    REDIM cle(17) AS LONG
    encStringOut = ""
    si = 0
    x1a2 = 0
    I = 0
    FOR fois = 1 TO 16
    cle(fois) = 0
    NEXT fois
    champ1 = encPassword
    lngchamp1 = LEN(champ1)
    FOR fois = 1 TO lngchamp1
    cle(fois) = ASC(MID$(champ1, fois, 1))
    NEXT fois
    champ1 = encStringIn
    lngchamp1 = LEN(champ1)
    FOR fois = 1 TO lngchamp1
    D = ASC(MID$(champ1, fois, 1))
    IF (D - &H61) >= 0 THEN
    D = D - &H61  ' to transform the letter to the 4 high bits of c
    IF (D >= 0) AND (D <= 15) THEN
    D = D * 16
    END IF
    END IF
    IF (fois <> lngchamp1) THEN
    fois = fois + 1
    END IF
    E = ASC(MID$(champ1, fois, 1))
    IF (E - &H61) >= 0 THEN
    E = E - &H61 ' to transform the letter to the 4 low bits of c
    IF (E >= 0) AND (E <= 15) THEN
    c = D + E
    END IF
    END IF
    Assemble
    cfc = (((inter / 256) * 256) - (inter MOD 256)) / 256
    cfd = inter MOD 256
    c = c XOR (cfc XOR cfd)
    FOR compte = 1 TO 16
    cle(compte) = cle(compte) XOR c
    NEXT compte
    encStringOut = encStringOut + CHR$(c)
    NEXT fois
    PC1DEC = encStringOut
    END FUNCTION
    
    FUNCTION PBMAIN()
     Orig$ = "Original unencrypted string"
     Enc$ = PC1ENC("password",Orig$)
     Dec$ = PC1DEC("password",Enc$)
     MSGBOX " Original=" & Orig$ & Chr$(13) & Chr$(10) & _
            "Encrypted=" & Enc$ & Chr$(13) & Chr$(10) & _
            "Decrypted=" & Dec$
    END FUNCTION
    ------------------
    -

  • #2
    Hi,

    Actually i am trying to use this alogarithom for both encrypt and decrypt.
    but encypt is working fine. i will convert the string to 16 bit.
    but when i try to decrypt the encrypted string, i didn't get the exact
    original string. now i am having little doubt whether is this decrypt
    function is working fine? Pl reply me.

    ------------------

    Comment


    • #3
      Before anyone spends time with this particular algorithm, please read the following:
      http://groups.google.com/groups?q=PC...msec.se&rnum=1

      http://groups.google.com/groups?q=PC...lia.net&rnum=2

      PB implementations of widely tested, reputable algorithms (unlike PC1) are readily available. Anyone serious about security should stick with them.


      ------------------
      -- gturgeon at compuserve dot com --

      Comment


      • #4
        Works fine for me once I removed the

        #include "win32api.inc"

        Code() was clashing with something there it seems

        ------------------
        Paul Dwyer
        Network Engineer
        Aussie in Tokyo

        Comment


        • #5
          Hi paul,

          is that decrypt function working for you?

          because i also didn't include that include file. but it is not working till.

          Senthil Viswanthan

          ------------------

          Comment


          • #6
            This works for me. I added the indenting so I could ready it.
            Other than that all I did was add declares and remove the inc

            Code:
            #Compile Exe
            Global x1a0() As Long
            Global cle() As Long
            Global x1a2 As Long
            Global inter As Long, res As Long, ax As Long, bx As Long
            Global cx As Long, dx As Long, si As Long, tmp As Long
            Global I As Long, c As Byte
            '#Include "WIN32API.INC"
            
            Declare Sub code() 
            Declare Sub Assemble()         
            Declare Function PC1ENC(encPassword As String, encStringOut As String)  As String    
            Declare Function PC1DEC(encPassword As String, encStringIn As String)  As String
            '===============================================================
            
            Sub code()
                On Error Resume Next
                dx = (x1a2 + I) Mod 65536
                ax = x1a0(I)
                cx = &H15A
                bx = &H4E35
                tmp = ax
                ax = si
                si = tmp
                tmp = ax
                ax = dx
                dx = tmp 
                
                If (ax <> 0) Then
                    ax = (ax * bx) Mod 65536
                End If  
                
                tmp = ax
                ax = cx
                cx = tmp   
                
                If (ax <> 0) Then
                    ax = (ax * si) Mod 65536
                    cx = (ax + cx) Mod 65536
                End If   
                
                tmp = ax
                ax = si
                si = tmp
                ax = (ax * bx) Mod 65536
                dx = (cx + dx) Mod 65536
                ax = ax + 1
                x1a2 = dx
                x1a0(I) = ax
                res = ax Xor dx
                I = I + 1
            End Sub
            
            '===============================================================
             
            Sub Assemble()
                On Error Resume Next
                x1a0(0) = ((cle(1) * 256) + cle(2)) Mod 65536
                Call code()
                inter = res
                x1a0(1) = x1a0(0) Xor ((cle(3) * 256) + cle(4))
                Call code()
                inter = inter Xor res
                x1a0(2) = x1a0(1) Xor ((cle(5) * 256) + cle(6))
                Call code()
                inter = inter Xor res
                x1a0(3) = x1a0(2) Xor ((cle(7) * 256) + cle(8))
                Call code()
                inter = inter Xor res
                x1a0(4) = x1a0(3) Xor ((cle(9) * 256) + cle(10))
                Call code()
                inter = inter Xor res
                x1a0(5) = x1a0(4) Xor ((cle(11) * 256) + cle(12))
                Call code()
                inter = inter Xor res
                x1a0(6) = x1a0(5) Xor ((cle(13) * 256) + cle(14))
                Call code()
                inter = inter Xor res
                x1a0(7) = x1a0(6) Xor ((cle(15) * 256) + cle(16))
                Call code()
                inter = inter Xor res
                I = 0
            End Sub
            
            '===============================================================
             
            Function PC1ENC(encPassword As String, encStringOut As String) Export As String
                On Error Resume Next
                Dim encStringIn As String
                Dim fois As Long
                Dim champ1 As String
                Dim lngchamp1 As Long
                Dim cfc As Long, cfd As Long
                Dim compte As Long
                Dim c As Long, D As Long, E As Long
                ReDim x1a0(9) As Long
                ReDim cle(17) As Long
                encStringIn = ""
                si = 0
                x1a2 = 0
                I = 0  
                
                For fois = 1 To 16
                    cle(fois) = 0
                Next fois    
            
                champ1 = encPassword
                lngchamp1 = Len(champ1) 
                
                For fois = 1 To lngchamp1
                    cle(fois) = Asc(Mid$(champ1, fois, 1))
                Next fois  
                
                champ1 = encStringOut
                lngchamp1 = Len(champ1)
                
                For fois = 1 To lngchamp1
                    c = Asc(Mid$(champ1, fois, 1))
                    Assemble
                    cfc = (((inter / 256) * 256) - (inter Mod 256)) / 256
                    cfd = inter Mod 256 
                    
                    For compte = 1 To 16
                        cle(compte) = cle(compte) Xor c
                    Next compte     
                    
                    c = c Xor (cfc Xor cfd)
                    D = (((c / 16) * 16) - (c Mod 16)) / 16
                    E = c Mod 16
                    encStringIn = encStringIn + Chr$(&H61 + D) ' d+&h61 give one letter range from a to p for the 4 high bits of c
                    encStringIn = encStringIn + Chr$(&H61 + E) ' e+&h61 give one letter range from a to p for the 4 low bits of c
                Next fois 
                
                PC1ENC = encStringIn
            End Function
            
            '===============================================================
             
            Function PC1DEC(encPassword As String, encStringIn As String) Export As String
                On Error Resume Next
                Dim encStringOut As String
                Dim fois As Long
                Dim champ1 As String
                Dim lngchamp1 As Long
                Dim cfc As Long, cfd As Long
                Dim compte As Long
                Dim c As Long, D As Long, E As Long
                ReDim x1a0(9) As Long
                ReDim cle(17) As Long
                encStringOut = ""
                si = 0
                x1a2 = 0
                I = 0  
                
                For fois = 1 To 16
                    cle(fois) = 0
                Next fois
                
                champ1 = encPassword
                lngchamp1 = Len(champ1)  
                
                For fois = 1 To lngchamp1
                    cle(fois) = Asc(Mid$(champ1, fois, 1))
                Next fois
                
                champ1 = encStringIn
                lngchamp1 = Len(champ1)
                
                For fois = 1 To lngchamp1
                    D = Asc(Mid$(champ1, fois, 1)) 
                    
                    If (D - &H61) >= 0 Then
                        D = D - &H61  ' to transform the letter to the 4 high bits of c
                        If (D >= 0) And (D <= 15) Then
                            D = D * 16
                        End If
                    End If 
                    
                    If (fois <> lngchamp1) Then
                        fois = fois + 1
                    End If
                    
                    E = Asc(Mid$(champ1, fois, 1))  
                    
                    If (E - &H61) >= 0 Then
                        E = E - &H61 ' to transform the letter to the 4 low bits of c   
                        
                        If (E >= 0) And (E <= 15) Then
                            c = D + E
                        End If  
                        
                    End If  
                    
                    Assemble
                    cfc = (((inter / 256) * 256) - (inter Mod 256)) / 256
                    cfd = inter Mod 256
                    c = c Xor (cfc Xor cfd)
                    
                    For compte = 1 To 16
                        cle(compte) = cle(compte) Xor c
                    Next compte  
                    
                    encStringOut = encStringOut + Chr$(c) 
                    
                Next fois
                PC1DEC = encStringOut
            End Function
            
            '===============================================================
            
            Function PbMain()
                 Orig$ = "Original unencrypted string of all sorts for data used"
                 Enc$ = PC1ENC("@BetterPassw0rd4Me",Orig$)
                 Dec$ = PC1DEC("@BetterPassw0rd4Me",Enc$)
                 MsgBox " Original=" & Orig$ & Chr$(13) & Chr$(10) & _
                        "Encrypted='" & Enc$ & "'" & Chr$(13) & Chr$(10) & _
                        "Decrypted='" & Dec$ & "'"
            End Function
            ------------------
            Paul Dwyer
            Network Engineer
            Aussie in Tokyo

            Comment

            Working...
            X