Maybe everyone needs it, I am too lazy to tell what principles (you can't tell ^ _ ^).
As for the code, it is someone else. If you involve copyright issues, you can contact me. as follows:
Unit des;
Interface
Uses sysutils;
TYPE TKEYBYTE = Array [0..5] of byte; tdesmode = (dMencry, dmdecry);
function EncryStr (Str, Key: String): String; function DecryStr (Str, Key: String): String; function EncryStrHex (Str, Key: String): String; function DecryStrHex (StrHex, Key: String): String;
Const Bitip: array [0..63] of byte = (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, 56, 48, 40, 32, 24, 16, 8, 0, 58, 50, 42, 34, 26, 18, 10, 2, 60, 52, 44, 36, 28, 20, 12, 4, 62, 54, 46, 38, 30, 22, 14, 6);
Bitcp: array [0..63] of byte = (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, 32, 0, 40, 8, 48, 16, 56, 24);
BITEXP: ARRAY [0..47] of integer = (31, 0, 1, 2, 3, 4, 3, 4, 5, 6, 7, 8, 7, 8, 9, 10, 11, 12 ,11 12, 13, 14, 15, 16, 15, 16, 17, 18, 19, 20, 19, 20, 21, 22, 23, 24, 23, 24, 25, 26, 27, 28, 27, 28 , 29, 30, 31, 0);
Bitpm: array [0..31] of byte = (15, 6, 19, 20, 28, 11, 27, 16, 0, 14, 22, 25, 4, 17, 30, 9, 1, 7, 23) , 13, 31, 26, 2, 8, 18, 12, 29, 5, 21, 10, 3, 24);
Sbox: array [0..7] of array [0..63] of byte = ((14, 4, 13, 1, 2, 15, 11, 8, 3, 10, 6, 12, 5, 9, 0, 7, 0, 15, 7, 4, 14, 2, 13, 1, 10, 6, 12, 11, 9, 5, 3, 8, 4, 1, 14, 8, 13, 6, 2, 11, 15, 12, 9, 7, 3, 10, 5, 0, 15, 12, 8, 2, 4, 9, 1, 7, 5, 11, 3, 14, 10, 0, 6, 13) (15, 1, 8, 14, 6, 11, 3, 4, 9, 7, 2, 13, 12, 0, 5, 10, 3, 13, 4, 7, 15, 2, 8, 14, 12, 0, 1, 10, 6, 9, 11, 5, 0, 14, 7, 11, 10, 4, 13, 1, 5, 8, 12, 6, 9, 3, 2, 15, 13, 8, 10, 1, 3, 15, 4, 2, 11, 6, 7, 12, 0, 5, 14, 9),
(10, 0, 9, 14, 6, 3, 9, 5, 1, 13, 7, 11, 4, 2, 8, 13, 7, 0, 9, 3, 4, 6, 10, 2 , 8, 5, 14, 12, 11, 15, 1, 13, 6, 4, 9, 2, 12, 5, 10, 14, 7, 1, 10 , 13, 0, 6, 9, 8, 7, 4, 15, 14, 3, 11, 5, 2, 12),
(7, 13, 14, 3, 0, 6, 9, 10, 1, 2, 8, 5, 11, 12, 4, 15, 13, 8, 11, 5, 6, 15, 0, 3, 4 , 7, 2, 12, 1, 10, 14, 9, 10, 6, 9, 0, 12, 11, 7, 13, 15, 1, 3, 14, 5, 2, 8, 4, 3, 15 , 0, 6, 10, 1, 13, 8, 9, 4, 5, 11, 12, 7, 2, 14),
(2, 12, 4, 1, 7, 10, 11, 6, 8, 5, 3, 15, 11, 0, 14, 9, 14, 11, 2, 12, 4, 7, 13, 1, 5 , 0, 15, 10, 3, 9, 8, 6, 4, 2, 1, 11, 10, 13, 7, 8, 9, 12, 5, 6, 3, 0, 14, 11, 8 , 12, 7, 1, 14, 2, 13, 6, 15, 0, 9, 10, 4, 5, 3),
(12, 1, 10, 15, 9, 2, 6, 8, 0, 13, 3, 4, 14, 7, 5, 11, 10, 15, 4, 2, 7, 12, 9, 5, 6 , 1, 13, 14, 0, 11, 3, 8, 9, 14, 5, 5, 2, 8, 12, 3, 7, 0, 4, 10, 1, 13, 11, 6, 4, 3 , 2, 12, 9, 5, 15, 10, 11, 14, 1, 7, 6, 0, 8, 13),
(4, 11, 2, 14, 15, 0, 8, 13, 3, 12, 9, 7, 5, 10, 6, 1, 13, 0, 11, 7, 4, 9, 1, 10, 14 , 3, 5, 12, 2, 15, 8, 6, 4, 4, 11, 13, 12, 3, 7, 14, 10, 15, 6, 8, 0, 5, 9, 2, 6, 11 , 13, 8, 1, 4, 10, 7, 9, 5, 0, 12), (13, 2, 8, 4, 6, 15, 11, 1, 10, 9) , 3, 14, 5, 0, 12, 7, 1, 4, 12, 5, 6, 11, 0, 14, 9, 2, 7, 11, 4 , 1, 9, 12, 14, 2, 0, 6, 10, 13, 15, 3, 5, 8, 2, 1, 14, 7, 4, 10, 8, 13, 15, 12, 9, 0 , 3, 5, 6, 11));
Bitpmc1: array [0..55] of byte = (56, 48, 40, 32, 24, 16, 8, 0, 57, 49, 41, 33, 25, 17, 9, 1, 58, 50, 42 , 34, 26, 18, 10, 2, 59, 51, 43, 35, 62, 54, 46, 38, 30, 22, 14, 6, 61, 53, 45, 37, 29, 21, 13, 5 , 60, 52, 44, 36, 28, 20, 12, 4, 27, 19, 11, 3);
Bitpmc2: array [0..47] of byte = (13, 16, 10, 23, 0, 4, 2, 27, 14, 5, 20, 9, 22, 18, 11, 3, 25, 7, 15) , 6, 26, 19, 12, 1, 40, 51, 30, 36, 46, 54, 29, 39, 50, 44, 32, 47, 43, 48, 38, 55, 33, 52, 45, 41 , 49, 35, 28, 31);
Var Subkey: array [0..15] of tkeybyte; importation
Procedure InitPermutation (VAR NEWDATA: ARRAY [0..7] of byte; i: integer; begin Fillchar (NewData, 8, 0); for i: = 0 to 63 DO if (Indata [ Bitip [i] shr 3] and (1 shl (7- (Bitip [i] and $ 07)))) <> 0 Then NewData [I Shr 3]: = NewData [i shr 3] or (1 shl (7- (i and $ 07))))); for i: = 0 to 7 do indata [i]: = newdata [i];
Procedure ConversePermutation (var newdata: array [0..7] of byte; i: integer; begin Fillchar (NewData, 8, 0); for i: = 0 to 63 DO if (Indata [ Bitcp [i] shr 3] and (1 shl (7- (Bitcp [i] and $ 07))))) <> 0 Then NewData [I Shr 3]: = NewData [I Shr 3] OR (1 shl (7- (i and $ 07))); for i: = 0 to 7 do indata [i]: = newdata [i]; end; procedure expand (contata: array of byte; var i: integer); var i: integer Begin Fillchar (Outdata, 6, 0); for i: = 0 to 47 DO if (Indata [Bitexp [i] SHR 3] and (1 shl (7- (Bitexp [i] and $ 07))) <> 0 THEN OUTDATA [I Shr 3]: = Outdata [I Shr 3] OR (1 shl (7- (i and $ 07)));
Procedure Permutation (VAR INDATA: ARRAY); VAR NewData: Array [0..3] of byte; i: integer; begin Fillchar (NewData, 4, 0); for i: = 0 to 31 DO if (Indata [ Bitpm [i] shr 3] and (1 shl (7- (Bitpm [i] and $ 07))) <> 0 Then NewData [I Shr 3]: = NewData [I Shr 3] OR (1 shl (7- (i and $ 07)))); for i: = 0 to 3 do indata [i]: = newdata [i];
Function Si (S, Inbyte: Byte): Byte; Var C: Byte; Begin C: = (Inbyte and $ 20) OR 1) OR 1) OR 1) OR 1) OR ((Inbyte and $ 01) SHL 4); Result: = (SBOX [S] [C] and $ 0f);
Procedure Permutationchoose1 (contata: array of byte; var i: integer; begin Fillcha (Outdata, 7, 0); for i: = 0 to 55 DO if (Indata [bitpmc1 [i] shr 3 ] and (1 shl (7- (bitpmc1 [i] and $ 07))))))) <> 0 Then Outdata [I Shr 3]: = Outdata [I Shr 3] OR (1 shl (7- (i and $ 07)) END;
Procedure permutationchoose2 (contata: array of byte; var i: integer; begin Fillchar (Outdata, 6, 0); for i: = 0 to 47 do if (Indata [Bitpmc2 [i] SHR 3 ] and (1 shl (7- (bitpmc2 [i] and $ 07)))))))) <> 0 Then Outdata [I Shr 3]: = Outdata [I Shr 3] OR (1 shl (7- (i and $ 07)) End; procedata: array of byte; bitmove: Byte); var i: integer; begin for i: = 0 to bitmove - 1 do begin indata [0]: = (InData [0] SHL 1) OR (InData [1] Shr 7); Indata [1]: = (InData [1] SHL 1) OR (InData [2] SHR 7); Indata [2]: = (InData [2] SHL 1) OR Indata [3] SHR 7); Indata [3]: = (InData [3] SHL 1) OR ((InData [0] and $ 10) Shr 4); Indata [0]: = (InData [0] and $ 0f END;
Procedure makeKey (Inkey: array of byte; var outkey); const bitdisplace: array [0..15] of byte = (1, 1, 2, 2, 2, 2, 2, 2, 1, 2 , 2, 2, 2, 2, 2, 1); var outdata56: array [0..6] of byte; key28l: array [0..3] of byte; key28r: array [0..3] of Byte Key56o: array [0..6] of byte; i: integer; begin permutationchoose1 (inkey, outdata56);
Key28L [0]: = Outdata56 [0] SHR 4; Key28L [1]: = (Outdata56 [0] SHL 4) or (Outdata56 [1] SHR 4); key28l [2]: = (Outdata56 [1] SHL 4 ) or (Outdata56 [2] SHR 4); key28l [3]: = (Outdata56 [2] shl 4) or (Outdata56 [3] SHR 4); key28r [0]: = Outdata56 [3] and $ 0f; key28r [1]: = Outdata56 [4]; key28r [2]: = Outdata56 [5]; key28r [3]: = Outdata56 [6];
For i: = 0 to 15 do begin cyclemove (key28l, bitdisplace [i]); cyclemove (key28r, bitdisplace [i]); key56o [0]: = (Key28L [0] shl 4) or (key28l [1] SHR 4); key56o [1]: = (Key28L [1] SHL 4) or (Key28L [2] SHR 4); key56o [2]: = (key28l [2] shl 4) or (key28l [3] shr 4) Key56o [3]: = (Key28L [3] SHL 4) or (key28r [0]); key56o [4]: = key28r [1]; key56o [5]: = key28r [2]; key56o [6]: = Key28R [3]; Permutationchoose2 (Key56o, Outkey [I]); end;
Procedure Encry (InData); var outbuf: array; var outbuf: array [0..5] of byte; buf: array [0..7] of byte; i: integer; begin expand (InData, Outbuf); for i: = 0 to 5 do Outbuf [i]: = Outbuf [i] xor Subkey [i]; // outbuf xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx buf [0]: = Outbuf [0] SHR 2; // xxxxxx -> 2 BUF [1]: = ((Outbuf [0] and $ 03) SHL 4) or (Outbuf [1] SHR 4); // 4 <- xx xxxx -> 4 buf [2] : = ((Outbuf [1] and $ 0f) SHL 2) or (Outbuf [2] SHR 6); // 2 <- xxxx xx -> 6 buf [3]: = Outbuf [2] and $ 3F; / / Xxxxxx buf [4]: = Outbuf [3] shr 2; // xxxxxx buf [5]: = ((outbuf [3] and $ 03) SHL 4) or (Outbuf [4] shr 4); // xx xxxx BUF [6]: = ((Outbuf [4] and $ 0f) SHL 2) or (Outbuf [5] SHR 6); // xxxx XX BUF [7]: = Outbuf [5] and $ 3F; // xxxxxx for i: = 0 to 7 do buf [i]: = Si (i, buf [i]); for i: = 0 to 3 do Outbuf [I]: = (BUF [i * 2] SHL 4) or BUF [i * 2 1]; Permutation (Outbuf); for i: = 0 to 3 do Outdata [i]: = Outbuf [i]; END;
Procedure Desdata (Desmode: TDesmode; "VAR OUTDATA: Array Of Byte); // Indata, Outdata is 8Bytes, otherwise Var i, J: Integer; Temp, BUF: Array [0..3] Of Byte; Begin for i: = 0 to 7 do Outdata [I]: = Indata [i]; INITPERMUTATION (OUTDATA); if DESMODE = DMENCRY THEN for i: = 0 to 15 do begin for i: = 0 To 3 Do Temp [J]: = OUTDATA [J]; // Temp = ln for j: = 0 to 3 do outputa [J]: = OUTDATA [J 4]; // ln 1 = RN Encry (Outdata, Subkey [i], buf); // rn == kN ==> buf for j: = 0 to 3 do outputa [j 4]: = TEMP [J] xor BUF [J]; // RN 1 = Ln ^ buf end; for j: = 0 to 3 DO TEMP [J]: = Outdata [J 4]; for j: = 0 to 3 do Outdata [J 4]: = Outdata [J]; for J: = 0 to 3 do outputa [J]: = Temp [J]; ELSE IF DESMODE = DMDECRY THEN BEGIN FOR i: = 15 DOWNTO 0 DO Begin for J: = 0 to 3 do temp [J]: = Outdata [J] For J: = 0 to 3 do Outdata [J]: = Outdata [J 4]; Encry (Outdata, Subkey [i], buf); fo RJ: = 0 to 3 do Outdata [J 4]: = TEMP [J] xor BUF [J]; End; for J: = 0 to 3 do temp [J]: = Outdata [J 4]; for J : = 0 to 3 do Outdata [J 4]: = OUTDATA [J]; For J: = 0 to 3 do Outdata [J]: = TEMP [J]; End; ConversePermutation (Outdata);
//
Function EncryStr (STR, Key: String): String; Var strbyte, Outbyte, Keybyte: Array [0..7] of byte; strRRRESULT: STRING; I, J: Inteder; Begin IF (Length (STR)> 0) and (ORD (STR [Length (Str)]) = 0) The Raise Exception.create ('Error: The Last Char is Null Char.'); If Length (KEY) <8 Then While Length <8 DO Key : = KEY CHR (0); While Length (STR) MOD 8 <> 0 do str: = Str Chr (0); for J: = 0 to 7 do keybyte [J]: = ORD (Key [J 1]); makeKey (Keybyte, Subkey);
Strresult: = '';
For i: = 0 to Length (STR) DIV 8 - 1 Do Begin for J: = 0 to 7 do strbyte [J]: = ORD (STR [I * 8 J 1]); Desdata (DMencry, Strbyte, Outbyte); for j: = 0 to 7 do strresult: = Strresult chr (Outbyte [J]);
RESULT: = Strresult;
Function DecryStr (Str, Key: String): String; Var strbyte, Outbyte, Keybyte: Array [0..7] of byte; strRRRESULT: STRING; I, J: Integer; Begin if longth (key) <8 Then While Length (KEY) <8 DO Key: = KEY CHR (0);
For j: = 0 to 7 do keybyte [j]: = ORD (Key [J 1]); Makekey (Keybyte, Subkey);
Strresult: = '';
For i: = 0 to Length (STR) DIV 8 - 1 Do Begin for J: = 0 to 7 do strbyte [J]: = ORD (STR [I * 8 J 1]); Desdata (DMDecry, Strbyte, Outbyte); for j: = 0 to 7 do strresult: = strresult chr (Outbyte [J]); end; while (length (strresult)> 0) and (Strresult [length (strRRRESULT)]) = 0) Do Delete (Strresult, Length), 1); Result: = strRRESULT; END;
///
Function EncryStrhex (Str, Key: String): String; Var Strresult, TempResult, Temp: String; I: Integer; Begin Tempresult: = EncryStr (Str, Key); strRRESULT: = '; for i: = 0 to Length TempResult) - 1 Do Begin Temp: = Format ('% x', [ORD (Tempresult [i 1])]); if longth (TEMP) = 1 Tens: = '0' Temp; strRRRESULT: = Strresult Temp; End; Result: = strRRRESULT; End; Function DecryStrhex (strhex, key: string): string; function hextoint: integer; var i, res: integer; ch: char; begin res: = 0 For i: = 0 to Length (HEX) - 1 Do Begin CH: = HEX [i 1]; if (CH> = '0') AND (CH <= '9') THEN Res: = Res * 16 ORD (CH) - ORD ('0') ELSE IF (CH> = 'a') and (cH <= 'f') Then Res: = Res * 16 ORD (CH) - ORD ('A') 10 else if (ch> = 'a') and (ch <= 'f') Then res: = res * 16 ORD (CH) - ORD ('A') 10 else raise exception.create ('error : NOT; RESULT: = Res; end;
Var Str, Temp: String; I: Integer; Begin Str: = '; for i: = 0 to Length (strhex) Div 2 - 1 Do Begin Temp: = Copy (Strhex, i * 2 1, 2); Str: = Str Chr (HextOint); end; result: = DecryStr (str, key); end;
End.
