DES/LUCIFER Encryption/Decryption

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
Zamaster
Posts: 1025
Joined: Jun 20, 2005 21:40
Contact:
Contact Zamaster

DES/LUCIFER Encryption/Decryption

Post by Zamaster »

This was possibly one of the most fun things Ive coded recently. It was quick and easy but most enjoyable for some unknown reason... accept for copying all those permutation tables down and re-formatting them.

Go encrypt thine hearts out!

Update:
Now works for latest CVS and decrypts

DESEncrypt.bi

Code: Select all

' DES Encryption Implementation by: Chris Brown(2007) aka Zamaster
' Compiles latest CVS in .17 with modification by cha0s
'
' -Takes plain text and DES encrypts it
' -Keys must be 64 bits in size, or 16 hex places/8 char places
' -Set ed in DES_Encrypt to 2 for decryption, 1 for encryption
'

Declare Function DES_Encrypt  (byref mtext As String, Byval mkey As Ulongint, byval ed as uinteger) As String
Declare Function DES_BitCopy  (Byval tonum As Uinteger, Byval toval As Ulongint, Byval tobits As Uinteger, Byval fromnum As Uinteger, Byval fromval As Ulongint, Byval frombits As Uinteger) As Ulongint   
Declare Sub      DES_Split56  (Byval mk As Ulongint, Byref lh As Ulongint, Byref rh As Ulongint)
Declare Sub      DES_Split64  (Byval mk As Ulongint, Byref lh As Ulongint, Byref rh As Ulongint)
Declare Function DES_RotateL56(Byval wkey As Ulongint, Byval plcs As Uinteger) As Ulongint
Declare Function DES_StrToHex (Byref convstr As String) As String
Declare Function DES_HexToStr (Byref convstr As String) As String

Function DES_Encrypt(Byref mtext As String, Byval mkey As Ulongint, byval ed as uinteger) As String
    Dim As String pt
    pt = DES_StrToHex(mtext)
    Dim As Uinteger mtmod = Len(pt) Mod 16
    Dim As Uinteger i, a, t, z, div8
    If mtmod > 0 Then
        For i = 1 To (16-mtmod)
            pt += "0"
        Next i
    Endif
    div8 = Len(pt) \ 16
    Dim As Uinteger b
    Dim As Ulongint Kpi
    Static As Uinteger PC1(1 To 56) = _
    { 57, 49, 41, 33, 25, 17,  9, _
       1, 58, 50, 42, 34, 26, 18, _
      10,  2, 59, 51, 43, 35, 27, _
      19, 11,  3, 60, 52, 44, 36, _
      63, 55, 47, 39, 31, 23, 15, _
       7, 62, 54, 46, 38, 30, 22, _
      14,  6, 61, 53, 45, 37, 29, _
      21, 13,  5, 28, 20, 12,  4 }
    For i = 1 To 56
        Kpi = DES_BitCopy(i,Kpi,56,PC1(i),mkey,64)
    Next i
    
    Dim As Ulongint LKpi(0 To 16), RKpi(0 To 16), FKpi(1 To 16, 1 To 2)
    DES_Split56 Kpi, LKpi(0), RKpi(0)

    Static As Integer ShiftSchedule(1 To 16) = { 1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 1 }
    For i = 1 To 16
        Read b
        LKpi(i) = DES_RotateL56(LKpi(i-1),ShiftSchedule(i))
        RKpi(i) = DES_RotateL56(RKpi(i-1),ShiftSchedule(i))
    Next i
    For i = 1 To 16
        FKpi(i,1) = (LKpi(i) Shl 28) Or RKpi(i)
    Next i

    Static As Integer PC2(1 To 48) = _
    { 14, 17, 11, 24,  1,  5, _
       3, 28, 15,  6, 21, 10, _
      23, 19, 12,  4, 26,  8, _
      16,  7, 27, 20, 13,  2, _
      41, 52, 31, 37, 47, 55, _
      30, 40, 51, 45, 33, 48, _
      44, 49, 39, 56, 34, 53, _
      46, 42, 50, 36, 29, 32 }
    For a = 1 To 16
        For i = 1 To 48
            FKpi(a,2) = DES_BitCopy(i,FKpi(a,2),48,PC2(i),FKpi(a,1),56)
        Next i
    Next a
    Dim As String   CypherText
    Dim As Ulongint LMpi(1 To 2), RMpi(1 To 2), expr(1 To 2), bitgrab, xbit, ybit, nbit, fbit
    Dim As Uinteger shiftbits
    
    Static As Uinteger SBox(1 To 8, 0 To 15, 0 To 3) = _
    { { { 14,  0,  4, 15 }, {  4, 15,  1, 12 }, { 13,  7, 14,  8 }, {  1,  4,  8,  2 }, {  2, 14, 13,  4 }, { 15,  2,  6,  9 }, { 11, 13,  2,  1 }, {  8,  1, 11,  7 }, {  3, 10, 15,  5 }, { 10,  6, 12, 11 }, {  6, 12,  9,  3 }, { 12, 11,  7, 14 }, {  5,  9,  3, 10 }, {  9,  5, 10,  0 }, {  0,  3,  5,  6 }, {  7,  8,  0, 13 } }, _
      { { 15,  3,  0, 13 }, {  1, 13, 14,  8 }, {  8,  4,  7, 10 }, { 14,  7, 11,  1 }, {  6, 15, 10,  3 }, { 11,  2,  4, 15 }, {  3,  8, 13,  4 }, {  4, 14,  1,  2 }, {  9, 12,  5, 11 }, {  7,  0,  8,  6 }, {  2,  1, 12,  7 }, { 13, 10,  6, 12 }, { 12,  6,  9,  0 }, {  0,  9,  3,  5 }, {  5, 11,  2, 14 }, { 10,  5, 15,  9 } }, _
      { { 10, 13, 13,  1 }, {  0,  7,  6, 10 }, {  9,  0,  4, 13 }, { 14,  9,  9,  0 }, {  6,  3,  8,  6 }, {  3,  4, 15,  9 }, { 15,  6,  3,  8 }, {  5, 10,  0,  7 }, {  1,  2, 11,  4 }, { 13,  8,  1, 15 }, { 12,  5,  2, 14 }, {  7, 14, 12,  3 }, { 11, 12,  5, 11 }, {  4, 11, 10,  5 }, {  2, 15, 14,  2 }, {  8,  1,  7, 12 } }, _
      { {  7, 13, 10,  3 }, { 13,  8,  6, 15 }, { 14, 11,  9,  0 }, {  3,  5,  0,  6 }, {  0,  6, 12, 10 }, {  6, 15, 11,  1 }, {  9,  0,  7, 13 }, { 10,  3, 13,  8 }, {  1,  4, 15,  9 }, {  2,  7,  1,  4 }, {  8,  2,  3,  5 }, {  5, 12, 14, 11 }, { 11,  1,  5, 12 }, { 12, 10,  2,  7 }, {  4, 14,  8,  2 }, { 15,  9,  4, 14 } }, _
      { {  2, 14,  4, 11 }, { 12, 11,  2,  8 }, {  4,  2,  1, 12 }, {  1, 12, 11,  7 }, {  7,  4, 10,  1 }, { 10,  7, 13, 14 }, { 11, 13,  7,  2 }, {  6,  1,  8, 13 }, {  8,  5, 15,  6 }, {  5,  0,  9, 15 }, {  3, 15, 12,  0 }, { 15, 10,  5,  9 }, { 13,  3,  6, 10 }, {  0,  9,  3,  4 }, { 14,  8,  0,  5 }, {  9,  6, 14,  3 } }, _
      { { 12, 10,  9,  4 }, {  1, 15, 14,  3 }, { 10,  4, 15,  2 }, { 15,  2,  5, 12 }, {  9,  7,  2,  9 }, {  2, 12,  8,  5 }, {  6,  9, 12, 15 }, {  8,  5,  3, 10 }, {  0,  6,  7, 11 }, { 13,  1,  0, 14 }, {  3, 13,  4,  1 }, {  4, 14, 10,  7 }, { 14,  0,  1,  6 }, {  7, 11, 13,  0 }, {  5,  3, 11,  8 }, { 11,  8,  6, 13 } }, _
      { {  4, 13,  1,  6 }, { 11,  0,  4, 11 }, {  2, 11, 11, 13 }, { 14,  7, 13,  8 }, { 15,  4, 12,  1 }, {  0,  9,  3,  4 }, {  8,  1,  7, 10 }, { 13, 10, 14,  7 }, {  3, 14, 10,  9 }, { 12,  3, 15,  5 }, {  9,  5,  6,  0 }, {  7, 12,  8, 15 }, {  5,  2,  0, 14 }, { 10, 15,  5,  2 }, {  6,  8,  9,  3 }, {  1,  6,  2, 12 } }, _
      { { 13,  1,  7,  2 }, {  2, 15, 11,  1 }, {  8, 13,  4, 14 }, {  4,  8,  1,  7 }, {  6, 10,  9,  4 }, { 15,  3, 12, 10 }, { 11,  7, 14,  8 }, {  1,  4,  2, 13 }, { 10, 12,  0, 15 }, {  9,  5,  6, 12 }, {  3,  6, 10,  9 }, { 14, 11, 13,  0 }, {  5,  0, 15,  3 }, {  0, 14,  3,  5 }, { 12,  9,  5,  6 }, {  7,  2,  8, 11 } } }
    CypherText = ""
    Dim As Ulongint mpc, mpi
    For z = 0 To div8-1
        
        mpc = VALLng("&H" + Mid$(pt,z*16+1,16))
        mpi = 0
        
        Static As Uinteger IP(1 To 64) = { 58, 50, 42, 34, 26, 18, 10,  2, _
                                           60, 52, 44, 36, 28, 20, 12,  4, _
                                           62, 54, 46, 38, 30, 22, 14,  6, _
                                           64, 56, 48, 40, 32, 24, 16,  8, _
                                           57, 49, 41, 33, 25, 17,  9,  1, _
                                           59, 51, 43, 35, 27, 19, 11,  3, _
                                           61, 53, 45, 37, 29, 21, 13,  5, _
                                           63, 55, 47, 39, 31, 23, 15,  7 } 

        For i = 1 To 64
            mpi = DES_BitCopy(i,mpi,64,IP(i),mpc,64)
        Next i
        DES_Split64 mpi, LMpi(1), RMpi(1)
       
        For i = 1 To 16
            LMpi(2) = RMpi(1)   
   
            expr(1) = RMpi(1)

            Static As Uinteger ExpansionSet(1 To 48) = { 32,  1,  2,  3,  4,  5, _
                                                          4,  5,  6,  7,  8,  9, _
                                                          8,  9, 10, 11, 12, 13, _
                                                         12, 13, 14, 15, 16, 17, _
                                                         16, 17, 18, 19, 20, 21, _
                                                         20, 21, 22, 23, 24, 25, _
                                                         24, 25, 26, 27, 28, 29, _
                                                         28, 29, 30, 31, 32,  1 } 


            expr(2) = 0
            For t = 1 To 48
                expr(2) = DES_BitCopy(t,expr(2),48,ExpansionSet(t),expr(1),32)
            Next t
            Select Case ed
            Case 1
                expr(2) = expr(2) Xor FKpi(i,2)
            Case 2
                expr(2) = expr(2) Xor FKpi(17-i,2)
            End Select
            nbit = 0
            bitgrab = 0
            shiftbits = 0
            xbit = 0
            ybit = 0
            For t = 1 To 8
                shiftbits = (8-t)
                bitgrab = (expr(2) Shr (shiftbits*6)) And &H3F
                ybit = ((bitgrab Shr 5) Shl 1) Or (bitgrab And &H1)
                xbit = (bitgrab Shr 1) And &HF
                nbit = nbit Or (SBox(t,xbit,ybit) Shl (shiftbits*4))
            Next t

            Static As Uinteger P(1 To 32) = { 16,  7, 20, 21, _
                                              29, 12, 28, 17, _
                                               1, 15, 23, 26, _
                                               5, 18, 31, 10, _
                                               2,  8, 24, 14, _
                                              32, 27,  3,  9, _
                                              19, 13, 30,  6, _
                                              22, 11,  4, 25 } 
            fbit = 0
            For t = 1 To 32
                fbit = DES_BitCopy(t,fbit,32,P(t),nbit,32)
            Next t
            RMpi(2) = LMpi(1) Xor fbit
       
            LMpi(1) = LMpi(2)
            RMpi(1) = RMpi(2)
        Next i
        fbit = (RMpi(1) Shl 32) Or LMpi(1)
        nbit = 0

        Static As Uinteger FinalP(1 To 64) = { 40,  8, 48, 16, 56, 24, 64, 32, _
                                               39,  7, 47, 15, 55, 23, 63, 31, _ 
                                               38,  6, 46, 14, 54, 22, 62, 30, _ 
                                               37,  5, 45, 13, 53, 21, 61, 29, _ 
                                               36,  4, 44, 12, 52, 20, 60, 28, _ 
                                               35,  3, 43, 11, 51, 19, 59, 27, _ 
                                               34,  2, 42, 10, 50, 18, 58, 26, _ 
                                               33,  1, 41,  9, 49, 17, 57, 25 }  
        For i = 1 To 64
            nbit = DES_BitCopy(i,nbit,64,FinalP(i),fbit,64)
        Next i
        
        
        CypherText += Hex(nbit,16)
    Next z   

    Return Des_HexToStr(CypherText)
   
End Function

Function DES_StrToHex (Byref convstr As String) As String
    Dim as string c
    c = convstr
    Dim As Uinteger i
    Dim As String ftext
    For i = 1 To Len(c)
        ftext += Hex(Asc(Mid$(c,i,1)),2)
    Next i
    Return ftext
End Function

Function DES_HexToStr (Byref convstr As String) As String
    Dim as string c
    c = convstr
    If Len(c) Mod 2 = 1 Then c += "0"
    Dim As Uinteger i
    Dim As String   f
    For i = 1 To Len(c) Step 2
        f += Chr$(Val("&H"+Mid$(c,i,2)))
    Next i
    Return f
End Function

Function DES_BitCopy(Byval tonum As Uinteger, Byval toval As Ulongint, Byval tobits As Uinteger, Byval fromnum As Uinteger, Byval fromval As Ulongint, Byval frombits As Uinteger) As Ulongint   
    tonum = tobits-tonum
    fromnum = frombits-fromnum     
    Dim As Ulongint aval = (toval Shr tonum) And &H1
    fromval = (fromval Shr fromnum) And &H1
    Return ((aval Xor fromval) Shl tonum) Xor toval
End Function

Sub DES_Split56 (Byval mk As Ulongint, Byref lh As Ulongint, Byref rh As Ulongint)
    lh = mk Shr 28
    rh = mk Shl 28 Shr 28
End Sub

Sub DES_Split64(Byval mk As Ulongint, Byref lh As Ulongint, Byref rh As Ulongint)
    lh = mk Shr 32
    rh = mk Shl 32 Shr 32
End Sub
Function DES_RotateL56(Byval wkey As Ulongint, Byval plcs As Uinteger) As Ulongint
    Select Case plcs
    Case 1
        wkey = wkey Shl 1
        wkey = DES_BitCopy(64,wkey,64,36,wkey,64) And &HFFFFFFF
    Case 2
        wkey = wkey Shl 2
        wkey = DES_BitCopy(64,wkey,64,36,wkey,64)
        wkey = DES_BitCopy(63,wkey,64,35,wkey,64) And &HFFFFFFF
    End Select
    Return wkey
End Function
...
...

DESTest.bas

Code: Select all

Option Explicit

#Include "DESEncrypt.bi"

Randomize Timer
Dim as string cypher1, cypher2, c
Dim as ulongint KEY
Dim as string   Message = "Do the math, watch your sig figs!"


KEY = INT(RND * 18446744073709551615)

cypher1 = DES_Encrypt(Message, KEY, 1)
cypher2 = DES_Encrypt(cypher1, KEY, 2)

Print cypher2


sleep
end
Last edited by Zamaster on Jan 28, 2007 2:25, edited 2 times in total.
Top
acetoline
Posts: 228
Joined: Oct 27, 2006 6:50
Contact:
Contact acetoline

Post by acetoline »

That has got to be one of the most usable and well done encryption progs I have seen in a long time. Looks great!
Top
cha0s
Site Admin
Posts: 5319
Joined: May 27, 2005 6:42
Location: USA
Contact:
Contact cha0s

Post by cha0s »

Your code will not compile in latest CVS due to having DATA in functions. It's wiser (and faster, and smaller) to use array initializers, that 3d array was a $#@$&. :)

Here it is:

Code: Select all

' DES Encryption Implementation by: Chris Brown(2007) aka Zamaster
' Compiles latest CVS in .17 with modification by cha0s
'
' -Takes plain text and converts it to encrypted HEX
' -Keys must be 64 bits in size, or 16 hex places/8 char places
'
'

Declare Function DES_Encrypt  (Byval mtext As String, Byval mkey As Ulongint) As String
Declare Function DES_BitCopy  (Byval tonum As Uinteger, Byval toval As Ulongint, Byval tobits As Uinteger, Byval fromnum As Uinteger, Byval fromval As Ulongint, Byval frombits As Uinteger) As Ulongint   
Declare Sub      DES_Split56  (Byval mk As Ulongint, Byref lh As Ulongint, Byref rh As Ulongint)
Declare Sub      DES_Split64  (Byval mk As Ulongint, Byref lh As Ulongint, Byref rh As Ulongint)
Declare Function DES_RotateL56(Byval wkey As Ulongint, Byval plcs As Uinteger) As Ulongint
Declare Function DES_StrToHex (Byval convstr As String) As String
Declare Function DES_HexToStr (Byval convstr As String) As String

Function DES_Encrypt(Byval mtext As String, Byval mkey As Ulongint) As String
    Dim As String pt
    pt = DES_StrToHex(mtext)
    Dim As Uinteger mtmod = Len(pt) Mod 16
    Dim As Uinteger i, a, t, z, div8
    If mtmod <> 0 Then
        For i = 1 To mtmod
            pt += "0"
        Next i
    Endif
    div8 = Len(pt) \ 16
    Dim As Uinteger b
    Dim As Ulongint Kpi

    Static As UInteger PC1(1 to 56) = _
    { 57, 49, 41, 33, 25, 17,  9, _
       1, 58, 50, 42, 34, 26, 18, _
      10,  2, 59, 51, 43, 35, 27, _
      19, 11,  3, 60, 52, 44, 36, _
      63, 55, 47, 39, 31, 23, 15, _
       7, 62, 54, 46, 38, 30, 22, _
      14,  6, 61, 53, 45, 37, 29, _
      21, 13,  5, 28, 20, 12,  4 }
    For i = 1 To 56
        Kpi = DES_BitCopy(i,Kpi,56,PC1(i),mkey,64)
    Next i
    
    Dim As Ulongint LKpi(0 To 16), RKpi(0 To 16), FKpi(1 To 16, 1 To 2)
    DES_Split56 Kpi, LKpi(0), RKpi(0)

    Static As Integer ShiftSchedule(1 to 16) = { 1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 1 }
    For i = 1 To 16
        Read b
        LKpi(i) = DES_RotateL56(LKpi(i-1),ShiftSchedule(i))
        RKpi(i) = DES_RotateL56(RKpi(i-1),ShiftSchedule(i))
    Next i
    For i = 1 To 16
        FKpi(i,1) = (LKpi(i) Shl 28) Or RKpi(i)
    Next i

    Static As Integer PC2(1 to 48) = _
    { 14, 17, 11, 24,  1,  5, _
       3, 28, 15,  6, 21, 10, _
      23, 19, 12,  4, 26,  8, _
      16,  7, 27, 20, 13,  2, _
      41, 52, 31, 37, 47, 55, _
      30, 40, 51, 45, 33, 48, _
      44, 49, 39, 56, 34, 53, _
      46, 42, 50, 36, 29, 32 }
    For a = 1 To 16
        For i = 1 To 48
            FKpi(a,2) = DES_BitCopy(i,FKpi(a,2),48,PC2(i),FKpi(a,1),56)
        Next i
    Next a
    Dim As String   CypherText
    Dim As Ulongint LMpi(1 To 2), RMpi(1 To 2), expr(1 To 2), bitgrab, xbit, ybit, nbit, fbit
    Dim As Uinteger shiftbits
    
    Static As UInteger SBox(1 To 8, 0 To 15, 0 To 3) = _
    { { { 14,  0,  4, 15 }, {  4, 15,  1, 12 }, { 13,  7, 14,  8 }, {  1,  4,  8,  2 }, {  2, 14, 13,  4 }, { 15,  2,  6,  9 }, { 11, 13,  2,  1 }, {  8,  1, 11,  7 }, {  3, 10, 15,  5 }, { 10,  6, 12, 11 }, {  6, 12,  9,  3 }, { 12, 11,  7, 14 }, {  5,  9,  3, 10 }, {  9,  5, 10,  0 }, {  0,  3,  5,  6 }, {  7,  8,  0, 13 } }, _
      { { 15,  3,  0, 13 }, {  1, 13, 14,  8 }, {  8,  4,  7, 10 }, { 14,  7, 11,  1 }, {  6, 15, 10,  3 }, { 11,  2,  4, 15 }, {  3,  8, 13,  4 }, {  4, 14,  1,  2 }, {  9, 12,  5, 11 }, {  7,  0,  8,  6 }, {  2,  1, 12,  7 }, { 13, 10,  6, 12 }, { 12,  6,  9,  0 }, {  0,  9,  3,  5 }, {  5, 11,  2, 14 }, { 10,  5, 15,  9 } }, _
      { { 10, 13, 13,  1 }, {  0,  7,  6, 10 }, {  9,  0,  4, 13 }, { 14,  9,  9,  0 }, {  6,  3,  8,  6 }, {  3,  4, 15,  9 }, { 15,  6,  3,  8 }, {  5, 10,  0,  7 }, {  1,  2, 11,  4 }, { 13,  8,  1, 15 }, { 12,  5,  2, 14 }, {  7, 14, 12,  3 }, { 11, 12,  5, 11 }, {  4, 11, 10,  5 }, {  2, 15, 14,  2 }, {  8,  1,  7, 12 } }, _
      { {  7, 13, 10,  3 }, { 13,  8,  6, 15 }, { 14, 11,  9,  0 }, {  3,  5,  0,  6 }, {  0,  6, 12, 10 }, {  6, 15, 11,  1 }, {  9,  0,  7, 13 }, { 10,  3, 13,  8 }, {  1,  4, 15,  9 }, {  2,  7,  1,  4 }, {  8,  2,  3,  5 }, {  5, 12, 14, 11 }, { 11,  1,  5, 12 }, { 12, 10,  2,  7 }, {  4, 14,  8,  2 }, { 15,  9,  4, 14 } }, _
      { {  2, 14,  4, 11 }, { 12, 11,  2,  8 }, {  4,  2,  1, 12 }, {  1, 12, 11,  7 }, {  7,  4, 10,  1 }, { 10,  7, 13, 14 }, { 11, 13,  7,  2 }, {  6,  1,  8, 13 }, {  8,  5, 15,  6 }, {  5,  0,  9, 15 }, {  3, 15, 12,  0 }, { 15, 10,  5,  9 }, { 13,  3,  6, 10 }, {  0,  9,  3,  4 }, { 14,  8,  0,  5 }, {  9,  6, 14,  3 } }, _
      { { 12, 10,  9,  4 }, {  1, 15, 14,  3 }, { 10,  4, 15,  2 }, { 15,  2,  5, 12 }, {  9,  7,  2,  9 }, {  2, 12,  8,  5 }, {  6,  9, 12, 15 }, {  8,  5,  3, 10 }, {  0,  6,  7, 11 }, { 13,  1,  0, 14 }, {  3, 13,  4,  1 }, {  4, 14, 10,  7 }, { 14,  0,  1,  6 }, {  7, 11, 13,  0 }, {  5,  3, 11,  8 }, { 11,  8,  6, 13 } }, _
      { {  4, 13,  1,  6 }, { 11,  0,  4, 11 }, {  2, 11, 11, 13 }, { 14,  7, 13,  8 }, { 15,  4, 12,  1 }, {  0,  9,  3,  4 }, {  8,  1,  7, 10 }, { 13, 10, 14,  7 }, {  3, 14, 10,  9 }, { 12,  3, 15,  5 }, {  9,  5,  6,  0 }, {  7, 12,  8, 15 }, {  5,  2,  0, 14 }, { 10, 15,  5,  2 }, {  6,  8,  9,  3 }, {  1,  6,  2, 12 } }, _
      { { 13,  1,  7,  2 }, {  2, 15, 11,  1 }, {  8, 13,  4, 14 }, {  4,  8,  1,  7 }, {  6, 10,  9,  4 }, { 15,  3, 12, 10 }, { 11,  7, 14,  8 }, {  1,  4,  2, 13 }, { 10, 12,  0, 15 }, {  9,  5,  6, 12 }, {  3,  6, 10,  9 }, { 14, 11, 13,  0 }, {  5,  0, 15,  3 }, {  0, 14,  3,  5 }, { 12,  9,  5,  6 }, {  7,  2,  8, 11 } } }

    CypherText = ""
    Dim As Ulongint mpc, mpi
    For z = 1 To div8
        mpc = VALLng("&H" + Mid$(pt,(z-1)*16+1,16))
        mpi = 0
        
        Static As UInteger IP(1 to 64) = { 58, 50, 42, 34, 26, 18, 10,  2, _
                                           60, 52, 44, 36, 28, 20, 12,  4, _
                                           62, 54, 46, 38, 30, 22, 14,  6, _
                                           64, 56, 48, 40, 32, 24, 16,  8, _
                                           57, 49, 41, 33, 25, 17,  9,  1, _
                                           59, 51, 43, 35, 27, 19, 11,  3, _
                                           61, 53, 45, 37, 29, 21, 13,  5, _
                                           63, 55, 47, 39, 31, 23, 15,  7 } 

        For i = 1 To 64
            mpi = DES_BitCopy(i,mpi,64,IP(i),mpc,64)
        Next i
        DES_Split64 mpi, LMpi(1), RMpi(1)
       
        For i = 1 To 16
            LMpi(2) = RMpi(1)   
   
            expr(1) = RMpi(1)

            Static As UInteger ExpansionSet(1 to 48) = { 32,  1,  2,  3,  4,  5, _
                                                          4,  5,  6,  7,  8,  9, _
                                                          8,  9, 10, 11, 12, 13, _
                                                         12, 13, 14, 15, 16, 17, _
                                                         16, 17, 18, 19, 20, 21, _
                                                         20, 21, 22, 23, 24, 25, _
                                                         24, 25, 26, 27, 28, 29, _
                                                         28, 29, 30, 31, 32,  1 } 


            expr(2) = 0
            For t = 1 To 48
                expr(2) = DES_BitCopy(t,expr(2),48,ExpansionSet(t),expr(1),32)
            Next t
            expr(2) = expr(2) Xor FKpi(i,2)
            nbit = 0
            For t = 1 To 8
                shiftbits = (8-t)
                bitgrab = (expr(2) Shr (shiftbits*6)) And &H3F
                ybit = ((bitgrab Shr 5) Shl 1) Or (bitgrab And &H1)
                xbit = (bitgrab Shr 1) And &HF
                nbit = nbit Or (SBox(t,xbit,ybit) Shl (shiftbits*4))
            Next t

            Static As UInteger P(1 to 32) = { 16,  7, 20, 21, _
                                              29, 12, 28, 17, _
                                               1, 15, 23, 26, _
                                               5, 18, 31, 10, _
                                               2,  8, 24, 14, _
                                              32, 27,  3,  9, _
                                              19, 13, 30,  6, _
                                              22, 11,  4, 25 } 
            fbit = 0
            For t = 1 To 32
                fbit = DES_BitCopy(t,fbit,32,P(t),nbit,32)
            Next t
            RMpi(2) = LMpi(1) Xor fbit
       
            LMpi(1) = LMpi(2)
            RMpi(1) = RMpi(2)
        Next i
        fbit = (RMpi(1) Shl 32) Or LMpi(1)
        nbit = 0

        Static As UInteger FinalP(1 to 64) = { 40,  8, 48, 16, 56, 24, 64, 32, _
                                               39,  7, 47, 15, 55, 23, 63, 31, _ 
                                               38,  6, 46, 14, 54, 22, 62, 30, _ 
                                               37,  5, 45, 13, 53, 21, 61, 29, _ 
                                               36,  4, 44, 12, 52, 20, 60, 28, _ 
                                               35,  3, 43, 11, 51, 19, 59, 27, _ 
                                               34,  2, 42, 10, 50, 18, 58, 26, _ 
                                               33,  1, 41,  9, 49, 17, 57, 25 }  
         
        For i = 1 to 64
            nbit = DES_BitCopy(i,nbit,64,FinalP(i),fbit,64)
        Next i
        CypherText += Hex(nbit)
    Next z
   
    Return CypherText
   
End Function

Function DES_StrToHex (Byval convstr As String) As String
    Dim As Uinteger i
    Dim As String ftext
    For i = 1 To Len(convstr)
        ftext += Hex(Asc(Mid$(convstr,i,1)))
    Next i
    Return ftext
End Function

Function DES_HexToStr (Byval convstr As String) As String
    If convstr Mod 2 = 1 Then convstr += "0"
    Dim As Uinteger i
    Dim As String   f
    For i = 1 To Len(convstr) Step 2
        f += Chr$(Val("&H"+Mid$(convstr,i,2)))
    Next i
    Return f
End Function

Function DES_BitCopy(Byval tonum As Uinteger, Byval toval As Ulongint, Byval tobits As Uinteger, Byval fromnum As Uinteger, Byval fromval As Ulongint, Byval frombits As Uinteger) As Ulongint   
    tonum = tobits-tonum
    fromnum = frombits-fromnum     
    Dim As Ulongint aval = (toval Shr tonum) And &H1
    fromval = (fromval Shr fromnum) And &H1
    Return ((aval Xor fromval) Shl tonum) Xor toval
End Function

Sub DES_Split56 (Byval mk As Ulongint, Byref lh As Ulongint, Byref rh As Ulongint)
    lh = mk Shr 28
    rh = mk Shl 28 Shr 28
End Sub

Sub DES_Split64(Byval mk As Ulongint, Byref lh As Ulongint, Byref rh As Ulongint)
    lh = mk Shr 32
    rh = mk Shl 32 Shr 32
End Sub
Function DES_RotateL56(Byval wkey As Ulongint, Byval plcs As Uinteger) As Ulongint
    Select Case plcs
    Case 1
        wkey = wkey Shl 1
        wkey = DES_BitCopy(64,wkey,64,36,wkey,64) And &HFFFFFFF
    Case 2
        wkey = wkey Shl 2
        wkey = DES_BitCopy(64,wkey,64,36,wkey,64)
        wkey = DES_BitCopy(63,wkey,64,35,wkey,64) And &HFFFFFFF
    End Select
    Return wkey
End Function

Dim As String cypher
cypher = DES_Encrypt("Do the math watch, your sig figs!", &H0123456789ABCDEF)
Print cypher
Top
lindomar
Posts: 201
Joined: Feb 21, 2006 21:37

Post by lindomar »

And Decrypt?
...
Lindomar
Top
anonymous1337
Posts: 5494
Joined: Sep 12, 2005 20:06
Location: California

Post by anonymous1337 »

lindomar wrote:And Decrypt?
...
Lindomar
You realize some algorithms *can't* be decrypted, right? :D I haven't even looked these up, but the only way to get certain ones back are through brute force testing (ex: only if you get a result if you're right). This is a "block cypher", but I haven't been able to find if it's reversable.
Top
lindomar
Posts: 201
Joined: Feb 21, 2006 21:37

Post by lindomar »

OK.

Lindomar
Top
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:
Contact D.J.Peters

Post by D.J.Peters »

Do you mean Lucifer, 1974 from IBM and DES standard since 1976 ?

Joshy
Top
maddogg6
Posts: 824
Joined: Dec 07, 2005 22:58
Contact:
Contact maddogg6

Post by maddogg6 »

Quoted from:
http://www.tropsoft.com/strongenc/des.htm
Encryption and Decryption

The same algorithm can be used for encryption or decryption. The method described above will encrypt a block of plaintext and return a block of ciphertext. In order to decrypt the ciphertext and get the original plaintext again, the procedure is simply repeated but the subkeys are applied in reverse order, from K[16]-K[1]. That is, stage 2 of the Core Function as outlined above changes from R[I-1] XOR K to R[I-1] XOR K[17-I]. Other than that, decryption is performed exactly the same as encryption.


Im thinking those complex data/arrays need modification to decrypt.
You realize some algorithms *can't* be decrypted, right?

MD5 is such a function - but I always hear the word 'hash' with such a function.. ??
Top
Zamaster
Posts: 1025
Joined: Jun 20, 2005 21:40
Contact:
Contact Zamaster

Post by Zamaster »

Hi! Yes, it can now decrypt, but it doesnt work sometimes because of something I think is an FB bug, or maybe its an FB feature... I dunno. Now before I post the decryption code, please look at my bug in the general forum. Its the only thing between me and my code being flawless.
Top
Zamaster
Posts: 1025
Joined: Jun 20, 2005 21:40
Contact:
Contact Zamaster

Post by Zamaster »

now its fine... enjoy.
Top
anonymous1337
Posts: 5494
Joined: Sep 12, 2005 20:06
Location: California

Post by anonymous1337 »

Zamaster wrote:now its fine... enjoy.
Guud :D
Top
777suppe
Posts: 3
Joined: Jul 23, 2008 12:13

Post by 777suppe »

I don't understand these two lines:

Code: Select all

Read b
and

Code: Select all

CypherText += Hex(nbit,16)
The var b is not used in the whole function. Why read some unit of data in it?

The Hex() function - what does it do with two parameters?
Top
Imortis
Moderator
Posts: 1924
Joined: Jun 02, 2005 15:10
Location: USA
Contact:
Contact Imortis

Post by Imortis »

777suppe wrote:The Hex() function - what does it do with two parameters?
The first is the number that you wish to display as hex, the second it the number of Hex Digits to output.

This one would display the number nbit in 16 hex digits.
Top
777suppe
Posts: 3
Joined: Jul 23, 2008 12:13

Post by 777suppe »

So Hex(163,3) would output "A3A3A3"?

Sorry, I don't have any FreeBasic Compiler.
Just translating the source code.
Top
Imortis
Moderator
Posts: 1924
Joined: Jun 02, 2005 15:10
Location: USA
Contact:
Contact Imortis

Post by Imortis »

It would output:

Code: Select all

0A3
A3 being 163, you want 3 digits, so ad a 0 to the front.
Top
Post Reply

Return to “Sources, Examples, Tips and Tricks”