Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
IDEA-File-Crypto CBC-Mode mit IV / Password-Gen in MD5
| Uploader: |  Neo7530 |
| Datum/Zeit: | 08.12.2011 18:29:14 |
'###################################################################
'######## 1D34 file-cryptor v0.1b based on IDEA-Algorithm ########
'######## for FreeBasic (C) 2011-12 by Neo7530 ########
'######## - 11-12-06 VECTOR - TEST passed ########
'######## To do: ########
'######## -password-check (check-string) (Header) ########
'######## -OFB-Mode (IDEA as Stream-cipher) ########
'###################################################################
'last modified 2011-12-07 2100
Declare function mulinv(x As uinteger) As UInteger 'find multiplicative inverse
Declare Function addinv(x As UShort) As UShort 'find additive inverse
declare function ideamul(x as uinteger,y as uinteger) as UShort 'multiplication mod 2^16+1
declare function ideaadd(x as uinteger,y as uinteger) as UShort 'addition mod 2^16
Declare Function conv(value As UShort) As UShort ' converts MSB-first <> LSB-First in get- and put-command
Declare Sub putblock 'write 64-bit-block to file
Declare Sub getblock 'get 64-bit-block from file
Declare sub kiRol 'roll key 25bits to left
declare sub keysched 'key expansion function
declare sub dekeysched 'decrypt-key expansion function
declare sub idearound 'uhhhh it's magic ;)
declare sub keyselect (s as byte) 'select right keyset for en- or de-cryption
Declare Sub passwd 'Generate MD5-Hash for password
Declare sub seed_nxt 'ct to next seed
Declare sub seed_nxt_c 'pt to next seed
Declare sub seed_cur 'nxt to current
Declare sub iv_gen
Declare sub iv_get
declare sub xor_iv_p 'XOR PT with seed
declare sub xor_iv_c 'XOR CT with seed
Declare Sub final_e
Declare Sub final_d
Dim Shared As Ushort rd, wr , ki(0 to 7), ke(0 to 51), pt(0 to 3), ct(0 To 3), kd(0 to 51), kt(0 to 51)
Dim Shared As UShort nxtseed(0 To 3), curseed(0 To 3)
dim shared as UByte s , l , m , pb(0 To 7)
Dim Shared As Integer pc
#Include "md5.bas"
passwd
keysched
dekeysched
Open Command(1) For Binary Access Read As #1
If Mid(Command(1),Len(Command(1))-3,4) = ".ida" Then
Open Mid(Command(1),1,Len(Command(1))-4) For Binary Access write As #2 : s = 1
Else
Open Command(1) + ".ida" For Binary Access write As #2: s = 0
EndIf
keyselect s 's=1 for decryption ; s=0 for encryption
If s = 0 Then 'in encrypt
iv_gen
seed_nxt
putblock
EndIf
If s = 1 Then
iv_get
seed_nxt
EndIf
do until eof(1) 'do it
pc = Lof(1) - Loc(1)
If pc < 8 And s = 0 Then final_e Else getblock
seed_cur
If s=1 Then seed_nxt_c
If s=0 Then xor_iv_p
idearound
If s=0 Then seed_nxt
If s=1 Then xor_iv_c
If pc = 8 And s = 1 Then final_d
putblock
If LOC(1) = Lof(1) Then pc = 0 : final_e
Loop
?
? "ready..." 'i am ready...
Close #1, #2
End 'bye ;)
Sub final_e
getblock
pt(3) Or= (8-pc)
seed_cur
xor_iv_p
idearound
putblock
Close #1, #2
? "ready...."
End
End Sub
Sub final_d
For i As Integer = 0 To 3
pb(i*2) = ct(i) Shr 8
pb(i*2+1) Or= ct(i) and &hFF
Next
For i As Integer = 0 To 7-pb(7)
Put #2, ,pb(i)
Next
Close #1, #2
? "ready...": end
End Sub
Sub iv_gen
randomize (-1,0)
For i As integer = 0 to 3
ct(i) = Int(rnd(1)*&hffff)
Next
End Sub
Sub xor_iv_c
For i As Integer = 0 To 3
ct(i) Xor= curseed(i)
Next
End Sub
Sub xor_iv_p
For i As Integer = 0 To 3
pt(i) Xor= curseed(i)
Next
End Sub
Sub seed_nxt
For i As Integer = 0 To 3
nxtseed(i) = ct(i)
Next
End Sub
Sub seed_nxt_c
For i As Integer = 0 To 3
nxtseed(i) = pt(i)
Next
End Sub
Sub seed_cur
For i As Integer = 0 To 3
curseed(i) = nxtseed(i)
Next
End Sub
Sub passwd:
If Command$(2) ="" Then
Dim As String test, x
? "password: ";
Do:
x = InKey$: IF x = CHR$(13) THEN EXIT DO 'Exit with Enter Key
If x <> "" THEN test = test + x: PRINT "*";
Loop
Dim As String result = createHash(test)
Else
Dim As String result = createFileHash(Command$(2))
End If
For i As Integer = 0 TO 7
ki(i) = (ki(i) + lpszMD5(i*2)) Shl 8 + lpszMD5(i*2+1)
Next
?
?
End Sub
Function conv(value As UShort) As UShort 'conversion msb <> lsb first
return ((value Shr 8) And &hff)+((value shl 8) And &hff00)
End Function
Sub getblock 'get it
for i as Integer = 0 to 3
Get #1, ,pt(i)
pt(i) = conv(pt(i)) 'MSB-first <> LSB-First
Next
End Sub
Sub iv_get
For i As Integer = 0 To 3
Get #1, ,ct(i)
ct(i) = conv(ct(i)) 'MSB-first <> LSB-First
Next
End Sub
Sub putblock 'put it
for i as integer = 0 to 3
ct(i) = conv(ct(i)) 'MSB-first <> LSB-First
put #2, ,ct(i)
Next
End Sub
sub keyselect (s as byte) 'witch keyset to use ?
if s = 0 then
for i as integer = 0 to 51
kt(i) = ke(i)
next
end if
if s = 1 then
for i as integer = 0 to 51
kt(i) = kd(i)
next
end if
end sub
Sub idearound 'do the magic
Dim as uinteger x0, x1, x2, x3, kk, t1 , t2
For runde as integer = 0 To 7
x0 =ideaMul(pt(0),kt(runde*6))
x1 =ideaAdd(pt(1),kt(runde*6+1))
x2 =ideaadd(pt(2),kt(runde*6+2))
x3 =ideaMul(pt(3),kt(runde*6+3))
kk =ideaMul(kt(runde*6+4),(x0 XOR x2))
t1 =ideaMul(kt(runde*6+5),ideaAdd(kk,(x1 XOR x3)))
t2 =ideaAdd(kk,t1)
pt(0) =x0 XOR t1
pt(3) =x3 XOR t2
pt(1) =x2 XOR t1
pt(2) =x1 XOR t2
Next
ct(0) = ideamul(pt(0),kt(48))
ct(1) = ideaadd(pt(2),kt(49))
ct(2) = ideaadd(pt(1),kt(50))
ct(3) = ideamul(pt(3),kt(51))
end Sub
sub dekeysched 'calculate the decryption-keys in right order...
For i As integer = 0 To 8
kd(0+(i*6)) = mulinv(ke(51-(i*6)-3))
kd(3+(i*6)) = mulinv(ke(51-(i*6)))
If (i <> 0) And (i <> 8) Then
kd(1+(i*6)) = addinv(ke(51-(i*6)-1))
kd(2+(i*6)) = addinv(ke(51-(i*6)-2))
kd(4+(i*6)) = ke(45-(i*6)+1)
kd(5+(i*6)) = ke(45-(i*6)+2)
end if
if i = 0 Then
kd(2+(i*6)) = addinv(ke(51-(i*6)-1))
kd(1+(i*6)) = addinv(ke(51-(i*6)-2))
kd(4+(i*6)) = ke(45-(i*6)+1)
kd(5+(i*6)) = ke(45-(i*6)+2)
end if
If i = 8 Then
kd(2+(i*6)) = addinv(ke(51-(i*6)-1))
kd(1+(i*6)) = addinv(ke(51-(i*6)-2))
End If
Next
End sub
Function mulinv (value As UInteger) As Uinteger 'x = 1/x ; multiplicative inverse in try and count-method
Dim As UInteger modul
Dim As UShort y , x
modul = 65537
if value < 2 then return value
While y <> 1
x +=1
y = value * x Mod modul
Wend
Return x
End Function
Function addinv (value As Ushort) As UShort 'x = -x ; additive inverse
Return -(value)
End Function
FUNCTION ideaMul(a As UInteger ,b As uinteger) As UShort 'mul mod 2^16+1
Dim As UInteger p,x,y
p = a * b
IF p = 0 Then Return 65537 - a - b
x = p SHR 16
y = p MOD 65536
x = y - x
IF (y < x) THEN x+= 65537
Return x MOD 65536
End Function
function ideaadd(x as uinteger,y as uinteger) as UShort ' addition mod 2^16
return x + y Mod 65536
end Function
Sub kiRol: 'rotate 25 bits to the left
dim as ushort k, s , temp
For i As Integer = 0 To 24
temp = Ki(0)
For K = 0 To 6
Ki(k) = Ki(k) And &H7FFF
Ki(k) = Ki(k) * 2
S = Ki(k + 1) And &H8000
S = S / &H8000
Ki(k) = Ki(k) Or S
Next K
Ki(7) = Ki(7) And &H7FFF
Ki(7) = Ki(7) * 2
S = temp And &H8000
S = S / &H8000
Ki(7) = Ki(7) Or S
Next
end sub
sub keysched 'calculate encryption keys
dim as ushort y, z, q, x
for y = 0 to 6
for z = 0 to 7
ki(z) xor= &h0dae 'improved IDEA against weak keys.
ke(q) = ki(z)
x += 1 : q += 1
if z = 7 then kiRol
if q = 52 then exit for
Next
next
end sub