在线时间:8:00-16:00
迪恩网络APP
随时随地掌握行业动态
扫描二维码
关注迪恩网络微信公众号
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 = //初始值置IP (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 = //逆初始置IP-1 ( 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 = // 位选择函数E ( 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 = //置换函数P ( 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 = //S盒 ( ( 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, 15, 5, 1, 13, 12, 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, 8, 15, 3, 0, 11, 1, 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, 13, 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, 15, 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, 15, 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, 1, 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, 15, 14, 2, 3, 12 ), ( 13, 2, 8, 4, 6, 15, 11, 1, 10, 9, 3, 14, 5, 0, 12, 7, 1, 15, 13, 8, 10, 3, 7, 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 = //选择置换PC-1 ( 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 =//选择置换PC-2 ( 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 Form1: TForm1; subKey: array[0..15] of TKeyByte; implementation {$R *.dfm} procedure initPermutation(var inData: array of Byte); 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]; end; procedure conversePermutation(var inData: array of Byte); 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(inData: array of Byte; var outData: array of Byte); 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))); end; procedure permutation(var inData: array of Byte); 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]; end; function si(s,inByte: Byte): Byte; var c: Byte; begin c := (inByte and $20) or ((inByte and $1e) shr 1) or ((inByte and $01) shl 4); Result := (sBox[s][c] and $0f); end; procedure permutationChoose1(inData: array of Byte; var outData: array of Byte); var i: Integer; begin FillChar(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(inData: array of Byte; var outData: 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; procedure cycleMove(var inData: 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; end; procedure makeKey(inKey: array of Byte; var outKey: array of TKeyByte); 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; end; procedure encry(inData, subKey: array of Byte; var outData: array of Byte); 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]; buf[0] := outBuf[0] shr 2; buf[1] := ((outBuf[0] and $03) shl 4) or (outBuf[1] shr 4); buf[2] := ((outBuf[1] and $0f) shl 2) or (outBuf[2] shr 6); buf[3] := outBuf[2] and $3f; buf[4] := outBuf[3] shr 2; buf[5] := ((outBuf[3] and $03) shl 4) or (outBuf[4] shr 4); buf[6] := ((outBuf[4] and $0f) shl 2) or (outBuf[5] shr 6); buf[7] := outBuf[5] and $3f; 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; inData: array of Byte; var outData: array of Byte); // inData, outData 都为8Bytes,否则出错 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 begin for i := 0 to 15 do begin for j := 0 to 3 do temp[j] := outData[j]; //temp = Ln for j := 0 to 3 do outData[j] := outData[j + 4]; //Ln+1 = Rn encry(outData, subKey[i], buf); //Rn ==Kn==> buf for j := 0 to 3 do outData[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 outData[j] := temp[j]; end 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); for j := 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); end; ////////////////////////////////////////////////////////////// function EncryStr(Str, Key: String): String; var StrByte, OutByte, KeyByte: array[0..7] of Byte; StrResult: String; I, J: Integer; begin if (Length(Str) > 0) and (Ord(Str[Length(Str)]) = 0) then raise Exception.Create('Error: the last char is NULL char.'); if Length(Key) < 8 then while Length(Key) < 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]); end; Result := StrResult; end; function DecryStr(Str, Key: String): String; var StrByte, OutByte, KeyByte: array[0..7] of Byte; StrResult: String; I, J: Integer; begin if Length(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 (Ord(StrResult[Length(StrResult)]) = 0) do Delete(StrResult, Length(StrResult), 1); Result := StrResult; end; /////////////////////////////////////////////////////////// function EncryStrHex(Str, Key: String): String; var StrResult, TempResult, Temp: String; I: Integer; begin TempResult := EncryStr(Str, Key); StrResult := ''; for I := 0 to Length(TempResult) - 1 do begin Temp := Format('%x', [Ord(TempResult[I + 1])]); if Length(Temp) = 1 then Temp := '0' + Temp; StrResult := StrResult + Temp; end; Result := StrResult; end; function DecryStrHex(StrHex, Key: String): String; function HexToInt(Hex: String): 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 a Hex String'); end; 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(Temp)); end; Result := DecryStr(Str, Key); end; procedure TForm1.Button1Click(Sender: TObject); begin //function EncryStrHex(Str, Key: String): String; //这里的Str表示你要进行加密的字符串,Key表示密钥; //function DecryStrHex(StrHex, Key: String): String; //这里的Str表示你要进行解密的字符串,Key表示密钥; if EncryStrhex(Edit1.Text,'ksaiy')=Edit2.Text then //这里的ksaiy是密钥,你可以设置自己的密钥。 ShowMessage('注册成功!') else ShowMessage('注册失败!'); /////////////////////////////////////////////////////////////////////////////// //Des DEMO V1.0// //作者:ksaiy// //欢迎使用由ksaiy制作的DES加密算法演示程序,此算法为标准的DES算法,你可以根据的 //的自己需要进行变形。具体怎么操作可以登录我们的网站查询详细的资料。我们专门为软 //件开发者提供软件加密安全测试服务和软件加密解决方案,具体的可以参看我们的网站上 //的资料。我们的网站:http://www.ksaiy.com http://www.magicoa.com //技术支持:[email protected] 在线QQ:40188696 UC:934155 //End // //注意:转载请保留以上信息。// /////////////////////////////////////////////////////////////////////////////// end; procedure TForm1.Button2Click(Sender: TObject); begin Close; end;
|
2023-10-27
2022-08-15
2022-08-17
2022-09-23
2022-08-13
请发表评论