View Code
1 unit Unit_Des_XE2; 2 3 { ********************************************************* } 4 { * DELPHI、PHP、C#通用DES编码解码单元 * } 5 { * 由TurboPower LockBox部分代码改写 * } 6 { * 滕州市东鸣软件工作室制作 ZWF 2011-12-27 * 7 * update by wh 2012-12-13 仅限英文及数字，中文不匹配 for delphi xe2 * } 8 { * EncryDes为编码函数，DecryDes为解码函数，keystr为密码，ivstr为偏移量， 9 一般设置keystr，ivstr相同，内容为八位字节长度的字符串,编码结果为十六进制字串 * } 10 { ********************************************************* } 11 // 附：测试代码如下 12 // uses dmdes_xe2, Soap.EncdDecd; 13 // 14 // procedure TForm1.Button1Click(Sender: TObject); 15 // var 16 // str1, str2: AnsiString; 17 // keyAnsiStr, ivAnsiStr: AnsiString; 18 // begin 19 // keyAnsiStr := '11111111'; 20 // ivAnsiStr := AnsiChar($12) + AnsiChar($34) + AnsiChar($56) + AnsiChar($78) + 21 // AnsiChar($90) + AnsiChar($AB) + AnsiChar($CD) + AnsiChar($EF); 22 // str1 := AnsiString(Edit1.Text); 23 // str2 := EncryDes(str1, keyAnsiStr, ivAnsiStr); 24 // Edit2.Text := EncodeString(string(str2)); 25 // end; 26 27 interface 28 29 uses 30 31 Windows, SysUtils, System.Math; 32 33 type 34 35 PKey64 = ^TKey64; 36 TKey64 = array [0 .. 7] of Byte; 37 38 type 39 40 TDESBlock = array [0 .. 7] of Byte; 41 42 TDESContext = packed record 43 TransformedKey: array [0 .. 31] of LongInt; 44 Encrypt: Boolean; 45 end; 46 47 function EncryDes(const str: AnsiString; const keystr: AnsiString; const ivstr: AnsiString) 48 : AnsiString; 49 50 function DecryDes(const str: AnsiString; const keystr: AnsiString; const ivstr: AnsiString) 51 : AnsiString; 52 53 function DecryDessec(const str: AnsiString; const keystr: AnsiString; const ivstr: AnsiString) 54 : AnsiString; 55 56 implementation 57 58 uses System.AnsiStrings; 59 60 procedure XorMemPrim(var Mem1; const Mem2; Count: Cardinal); register; 61 asm 62 push esi 63 push edi 64 mov esi, eax // esi = Mem1 65 mov edi, edx // edi = Mem2 66 push ecx // save byte count 67 shr ecx, 2 // convert to dwords 68 jz @Continue 69 cld 70 @Loop1: // xor dwords at a time 71 mov eax, [edi] 72 xor [esi], eax 73 add esi, 4 74 add edi, 4 75 dec ecx 76 jnz @Loop1 77 @Continue: // handle remaining bytes (3 or less) 78 pop ecx 79 and ecx, 3 80 jz @Done 81 @Loop2: // xor remaining bytes 82 mov al, [edi] 83 xor [esi], al 84 inc esi 85 inc edi 86 dec ecx 87 jnz @Loop2 88 @Done: 89 pop edi 90 pop esi 91 end; 92 93 { -------------------------------------------------------------------------- } 94 95 procedure XorMem(var Mem1; const Mem2; Count: Cardinal); 96 begin 97 XorMemPrim(Mem1, Mem2, Count); 98 end; 99 100 { -------------------------------------------------------------------------- } 101 102 procedure EncryptDES(const Context: TDESContext; var Block: TDESBlock); 103 const 104 SPBox: array [0 .. 7, 0 .. 63] of DWord = (($01010400, $00000000, $00010000, $01010404, $01010004, 105 $00010404, $00000004, $00010000, $00000400, $01010400, $01010404, $00000400, $01000404, 106 $01010004, $01000000, $00000004, $00000404, $01000400, $01000400, $00010400, $00010400, 107 $01010000, $01010000, $01000404, $00010004, $01000004, $01000004, $00010004, $00000000, 108 $00000404, $00010404, $01000000, $00010000, $01010404, $00000004, $01010000, $01010400, 109 $01000000, $01000000, $00000400, $01010004, $00010000, $00010400, $01000004, $00000400, 110 $00000004, $01000404, $00010404, $01010404, $00010004, $01010000, $01000404, $01000004, 111 $00000404, $00010404, $01010400, $00000404, $01000400, $01000400, $00000000, $00010004, 112 $00010400, $00000000, $01010004), 113 114 ($80108020, $80008000, $00008000, $00108020, $00100000, $00000020, $80100020, $80008020, 115 $80000020, $80108020, $80108000, $80000000, $80008000, $00100000, $00000020, $80100020, 116 $00108000, $00100020, $80008020, $00000000, $80000000, $00008000, $00108020, $80100000, 117 $00100020, $80000020, $00000000, $00108000, $00008020, $80108000, $80100000, $00008020, 118 $00000000, $00108020, $80100020, $00100000, $80008020, $80100000, $80108000, $00008000, 119 $80100000, $80008000, $00000020, $80108020, $00108020, $00000020, $00008000, $80000000, 120 $00008020, $80108000, $00100000, $80000020, $00100020, $80008020, $80000020, $00100020, 121 $00108000, $00000000, $80008000, $00008020, $80000000, $80100020, $80108020, $00108000), 122 123 ($00000208, $08020200, $00000000, $08020008, $08000200, $00000000, $00020208, $08000200, 124 $00020008, $08000008, $08000008, $00020000, $08020208, $00020008, $08020000, $00000208, 125 $08000000, $00000008, $08020200, $00000200, $00020200, $08020000, $08020008, $00020208, 126 $08000208, $00020200, $00020000, $08000208, $00000008, $08020208, $00000200, $08000000, 127 $08020200, $08000000, $00020008, $00000208, $00020000, $08020200, $08000200, $00000000, 128 $00000200, $00020008, $08020208, $08000200, $08000008, $00000200, $00000000, $08020008, 129 $08000208, $00020000, $08000000, $08020208, $00000008, $00020208, $00020200, $08000008, 130 $08020000, $08000208, $00000208, $08020000, $00020208, $00000008, $08020008, $00020200), 131 132 ($00802001, $00002081, $00002081, $00000080, $00802080, $00800081, $00800001, $00002001, 133 $00000000, $00802000, $00802000, $00802081, $00000081, $00000000, $00800080, $00800001, 134 $00000001, $00002000, $00800000, $00802001, $00000080, $00800000, $00002001, $00002080, 135 $00800081, $00000001, $00002080, $00800080, $00002000, $00802080, $00802081, $00000081, 136 $00800080, $00800001, $00802000, $00802081, $00000081, $00000000, $00000000, $00802000, 137 $00002080, $00800080, $00800081, $00000001, $00802001, $00002081, $00002081, $00000080, 138 $00802081, $00000081, $00000001, $00002000, $00800001, $00002001, $00802080, $00800081, 139 $00002001, $00002080, $00800000, $00802001, $00000080, $00800000, $00002000, $00802080), 140 141 ($00000100, $02080100, $02080000, $42000100, $00080000, $00000100, $40000000, $02080000, 142 $40080100, $00080000, $02000100, $40080100, $42000100, $42080000, $00080100, $40000000, 143 $02000000, $40080000, $40080000, $00000000, $40000100, $42080100, $42080100, $02000100, 144 $42080000, $40000100, $00000000, $42000000, $02080100, $02000000, $42000000, $00080100, 145 $00080000, $42000100, $00000100, $02000000, $40000000, $02080000, $42000100, $40080100, 146 $02000100, $40000000, $42080000, $02080100, $40080100, $00000100, $02000000, $42080000, 147 $42080100, $00080100, $42000000, $42080100, $02080000, $00000000, $40080000, $42000000, 148 $00080100, $02000100, $40000100, $00080000, $00000000, $40080000, $02080100, $40000100), 149 150 ($20000010, $20400000, $00004000, $20404010, $20400000, $00000010, $20404010, $00400000, 151 $20004000, $00404010, $00400000, $20000010, $00400010, $20004000, $20000000, $00004010, 152 $00000000, $00400010, $20004010, $00004000, $00404000, $20004010, $00000010, $20400010, 153 $20400010, $00000000, $00404010, $20404000, $00004010, $00404000, $20404000, $20000000, 154 $20004000, $00000010, $20400010, $00404000, $20404010, $00400000, $00004010, $20000010, 155 $00400000, $20004000, $20000000, $00004010, $20000010, $20404010, $00404000, $20400000, 156 $00404010, $20404000, $00000000, $20400010, $00000010, $00004000, $20400000, $00404010, 157 $00004000, $00400010, $20004010, $00000000, $20404000, $20000000, $00400010, $20004010), 158 159 ($00200000, $04200002, $04000802, $00000000, $00000800, $04000802, $00200802, $04200800, 160 $04200802, $00200000, $00000000, $04000002, $00000002, $04000000, $04200002, $00000802, 161 $04000800, $00200802, $00200002, $04000800, $04000002, $04200000, $04200800, $00200002, 162 $04200000, $00000800, $00000802, $04200802, $00200800, $00000002, $04000000, $00200800, 163 $04000000, $00200800, $00200000, $04000802, $04000802, $04200002, $04200002, $00000002, 164 $00200002, $04000000, $04000800, $00200000, $04200800, $00000802, $00200802, $04200800, 165 $00000802, $04000002, $04200802, $04200000, $00200800, $00000000, $00000002, $04200802, 166 $00000000, $00200802, $04200000, $00000800, $04000002, $04000800, $00000800, $00200002), 167 168 ($10001040, $00001000, $00040000, $10041040, $10000000, $10001040, $00000040, $10000000, 169 $00040040, $10040000, $10041040, $00041000, $10041000, $00041040, $00001000, $00000040, 170 $10040000, $10000040, $10001000, $00001040, $00041000, $00040040, $10040040, $10041000, 171 $00001040, $00000000, $00000000, $10040040, $10000040, $10001000, $00041040, $00040000, 172 $00041040, $00040000, $10041000, $00001000, $00000040, $10040040, $00001000, $00041040, 173 $10001000, $00000040, $10000040, $10040000, $10040040, $10000000, $00040000, $10001040, 174 $00000000, $10041040, $00040040, $10000040, $10040000, $10001000, $10001040, $00000000, 175 $10041040, $00041000, $00041000, $00001040, $00001040, $00040040, $10000000, $10041000)); 176 177 var 178 I, L, R, Work: DWord; 179 CPtr: PDWord; 180 procedure SplitBlock(const Block: TDESBlock; var L, R: DWord); register; 181 asm 182 push ebx 183 push eax 184 mov eax, [eax] 185 mov bh, al 186 mov bl, ah 187 rol ebx, 16 188 shr eax, 16 189 mov bh, al 190 mov bl, ah 191 mov [edx], ebx 192 pop eax 193 mov eax, [eax+4] 194 mov bh, al 195 mov bl, ah 196 rol ebx, 16 197 shr eax, 16 198 mov bh, al 199 mov bl, ah 200 mov [ecx], ebx 201 pop ebx 202 end; 203 204 procedure JoinBlock(const L, R: LongInt; var Block: TDESBlock); register; 205 asm 206 push ebx 207 mov bh, al 208 mov bl, ah 209 rol ebx, 16 210 shr eax, 16 211 mov bh, al 212 mov bl, ah 213 mov [ecx+4], ebx 214 mov bh, dl 215 mov bl, dh 216 rol ebx, 16 217 shr edx, 16 218 mov bh, dl 219 mov bl, dh 220 mov [ecx], ebx 221 pop ebx 222 end; 223 224 procedure IPerm(var L, R: DWord); 225 var 226 Work: DWord; 227 begin 228 Work := ((L shr 4) xor R) and $0F0F0F0F; 229 R := R xor Work; 230 L := L xor Work shl 4; 231 Work := ((L shr 16) xor R) and $0000FFFF; 232 R := R xor Work; 233 L := L xor Work shl 16; 234 Work := ((R shr 2) xor L) and $33333333; 235 L := L xor Work; 236 R := R xor Work shl 2; 237 Work := ((R shr 8) xor L) and $00FF00FF; 238 L := L xor Work; 239 R := R xor Work shl 8; 240 R := (R shl 1) or (R shr 31); 241 Work := (L xor R) and $AAAAAAAA; 242 L := L xor Work; 243 R := R xor Work; 244 L := (L shl 1) or (L shr 31); 245 end; 246 247 procedure FPerm(var L, R: DWord); 248 var 249 Work: DWord; 250 begin 251 L := L; 252 R := (R shl 31) or (R shr 1); 253 Work := (L xor R) and $AAAAAAAA; 254 L := L xor Work; 255 R := R xor Work; 256 L := (L shr 1) or (L shl 31); 257 Work := ((L shr 8) xor R) and $00FF00FF; 258 R := R xor Work; 259 L := L xor Work shl 8; 260 Work := ((L shr 2) xor R) and $33333333; 261 R := R xor Work; 262 L := L xor Work shl 2; 263 Work := ((R shr 16) xor L) and $0000FFFF; 264 L := L xor Work; 265 R := R xor Work shl 16; 266 Work := ((R shr 4) xor L) and $0F0F0F0F; 267 L := L xor Work; 268 R := R xor Work shl 4; 269 end; 270 271 begin 272 SplitBlock(Block, L, R); 273 IPerm(L, R); 274 CPtr := @Context; 275 for I := 0 to 7 do 276 begin 277 Work := (((R shr 4) or (R shl 28)) xor CPtr^); 278 inc(CPtr); 279 L := L xor SPBox[6, Work and $3F]; 280 L := L xor SPBox[4, Work shr 8 and $3F]; 281 L := L xor SPBox[2, Work shr 16 and $3F]; 282 L := L xor SPBox[0, Work shr 24 and $3F]; 283 Work := (R xor CPtr^); 284 inc(CPtr); 285 L := L xor SPBox[7, Work and $3F]; 286 L := L xor SPBox[5, Work shr 8 and $3F]; 287 L := L xor SPBox[3, Work shr 16 and $3F]; 288 L := L xor SPBox[1, Work shr 24 and $3F]; 289 Work := (((L shr 4) or (L shl 28)) xor CPtr^); 290 inc(CPtr); 291 R := R xor SPBox[6, Work and $3F]; 292 R := R xor SPBox[4, Work shr 8 and $3F]; 293 R := R xor SPBox[2, Work shr 16 and $3F]; 294 R := R xor SPBox[0, Work shr 24 and $3F]; 295 Work := (L xor CPtr^); 296 inc(CPtr); 297 R := R xor SPBox[7, Work and $3F]; 298 R := R xor SPBox[5, Work shr 8 and $3F]; 299 R := R xor SPBox[3, Work shr 16 and $3F]; 300 R := R xor SPBox[1, Work shr 24 and $3F]; 301 end; 302 FPerm(L, R); 303 JoinBlock(L, R, Block); 304 305 end; 306 307 procedure InitEncryptDES(const Key: TKey64; var Context: TDESContext; Encrypt: Boolean); 308 const 309 PC1: array [0 .. 55] of Byte = (56, 48, 40, 32, 24, 16, 8, 0, 57, 49, 41, 33, 25, 17, 9, 1, 58, 310 50, 42, 34, 26, 18, 10, 2, 59, 51, 43, 35, 62, 54, 46, 38, 30, 22, 14, 6, 61, 53, 45, 37, 29, 311 21, 13, 5, 60, 52, 44, 36, 28, 20, 12, 4, 27, 19, 11, 3); 312 313 PC2: array [0 .. 47] of Byte = (13, 16, 10, 23, 0, 4, 2, 27, 14, 5, 20, 9, 22, 18, 11, 3, 25, 7, 314 15, 6, 26, 19, 12, 1, 40, 51, 30, 36, 46, 54, 29, 39, 50, 44, 32, 47, 43, 48, 38, 55, 33, 52, 315 45, 41, 49, 35, 28, 31); 316 317 CTotRot: array [0 .. 15] of Byte = (1, 2, 4, 6, 8, 10, 12, 14, 15, 17, 19, 21, 23, 25, 27, 28); 318 319 CBitMask: array [0 .. 7] of Byte = (128, 64, 32, 16, 8, 4, 2, 1); 320 321 var 322 PC1M: array [0 .. 55] of Byte; 323 PC1R: array [0 .. 55] of Byte; 324 KS: array [0 .. 7] of Byte; 325 I, J, L, M: LongInt; 326 begin 327 328 { convert PC1 to bits of key } 329 for J := 0 to 55 do 330 begin 331 L := PC1[J]; 332 M := L mod 8; 333 PC1M[J] := Ord((Key[L div 8] and CBitMask[M]) <> 0); 334 end; 335 336 { key chunk for each iteration } 337 for I := 0 to 15 do 338 begin 339 { rotate PC1 the right amount } 340 for J := 0 to 27 do 341 begin 342 L := J + CTotRot[I]; 343 if (L < 28) then 344 begin 345 PC1R[J] := PC1M[L]; 346 PC1R[J + 28] := PC1M[L + 28]; 347 end 348 else 349 begin 350 PC1R[J] := PC1M[L - 28]; 351 PC1R[J + 28] := PC1M[L]; 352 end; 353 354 end; 355 356 { select bits individually } 357 358 FillChar(KS, SizeOf(KS), 0); 359 for J := 0 to 47 do 360 if Boolean(PC1R[PC2[J]]) then 361 begin 362 L := J div 6; 363 KS[L] := KS[L] or CBitMask[J mod 6] shr 2; 364 end; 365 366 { now convert to odd/even interleaved form for use in F } 367 368 if Encrypt then 369 begin 370 Context.TransformedKey[I * 2] := (LongInt(KS[0]) shl 24) or (LongInt(KS[2]) shl 16) or 371 (LongInt(KS[4]) shl 8) or (LongInt(KS[6])); 372 373 Context.TransformedKey[I * 2 + 1] := (LongInt(KS[1]) shl 24) or (LongInt(KS[3]) shl 16) or 374 (LongInt(KS[5]) shl 8) or (LongInt(KS[7])); 375 376 end 377 else 378 begin 379 Context.TransformedKey[31 - (I * 2 + 1)] := (LongInt(KS[0]) shl 24) or (LongInt(KS[2]) shl 16) 380 or (LongInt(KS[4]) shl 8) or (LongInt(KS[6])); 381 382 Context.TransformedKey[31 - (I * 2)] := (LongInt(KS[1]) shl 24) or (LongInt(KS[3]) shl 16) or 383 (LongInt(KS[5]) shl 8) or (LongInt(KS[7])); 384 385 end; 386 387 end; 388 Context.Encrypt := Encrypt; 389 390 end; 391 392 procedure EncryptDESCBC(const Context: TDESContext; const Prev: TDESBlock; var Block: TDESBlock); 393 394 begin 395 if Context.Encrypt then 396 begin 397 XorMem(Block, Prev, SizeOf(Block)); 398 EncryptDES(Context, Block); 399 end 400 else 401 begin 402 EncryptDES(Context, Block); 403 XorMem(Block, Prev, SizeOf(Block)); 404 end; 405 406 end; 407 408 function EncryDes(const str: AnsiString; const keystr: AnsiString; const ivstr: AnsiString) 409 : AnsiString; 410 var 411 Key: TKey64; 412 Context: TDESContext; 413 Block, iv: TDESBlock; 414 I, J, len, posnum: smallint; 415 poschar, xx: AnsiChar; 416 begin 417 for I := 0 to 7 do 418 begin 419 if I > (length(keystr) - 1) then 420 Key[I] := 0 421 else 422 Key[I] := Byte(keystr[I + 1]); 423 end; 424 for I := 0 to 7 do 425 begin 426 if I > (length(ivstr) - 1) then 427 iv[I] := 0 428 else 429 iv[I] := Byte(ivstr[I + 1]); 430 end; 431 InitEncryptDES(Key, Context, true); 432 len := length(AnsiString(str)); 433 xx := AnsiChar(8 - (len mod 8)); 434 435 { DELPHI下要实现相应的加密和解密，需要自己写DES代码，并加上CBC方式的异或 436 这里要说明一点，我发现C#下DES明文在加密前，有补足8的倍数的情况，即如果 437 如果是“11111”就会补成“11111＃3＃3＃3”，如果是“11111111”就会“11111111＃8＃8＃8＃8＃8＃8＃8＃8”， 438 然后在进行异或，最后加密！ } 439 for I := 0 to (len div 8) do 440 begin 441 for J := 0 to 7 do 442 begin 443 if ((I * 8 + J + 1) <= len) then // <= 444 begin 445 poschar := str[I * 8 + J + 1]; 446 Block[J] := Byte(poschar); 447 end 448 else 449 Block[J] := Byte(xx); 450 end; 451 EncryptDESCBC(Context, iv, Block); 452 for J := 0 to 7 do 453 begin 454 posnum := Block[J]; 455 result := result + AnsiChar(posnum); // inttohex(posnum,2); 456 end; 457 iv := Block; 458 end; 459 end; 460 461 function DecryDessec(const str: AnsiString; const keystr: AnsiString; const ivstr: AnsiString) 462 : AnsiString; 463 var 464 Key: TKey64; 465 Context: TDESContext; 466 bak, Block, iv: TDESBlock; 467 I, J, { len, } posnum: smallint; 468 { poschar,xx:char; } 469 res, { lss, } temp: AnsiString; 470 begin 471 temp := keystr; 472 res := ''; 473 for I := 0 to 7 do 474 begin 475 if I > (length(temp) - 1) then 476 Key[I] := 0 477 else 478 Key[I] := Byte(temp[I + 1]); 479 end; 480 temp := ivstr; 481 for I := 0 to 7 do 482 begin 483 if I > (length(temp) - 1) then 484 iv[I] := 0 485 else 486 iv[I] := Byte(temp[I + 1]); 487 end; 488 InitEncryptDES(Key, Context, False); 489 temp := str; 490 posnum := 0; 491 for I := 0 to length(temp) - 1 do 492 begin 493 Block[posnum] := Byte(temp[I + 1]); 494 posnum := posnum + 1; 495 if posnum = 8 then 496 begin 497 bak := Block; 498 EncryptDESCBC(Context, iv, Block); 499 for J := 0 to 7 do 500 begin 501 // temp := temp+inttostr(byte(block[i]))+' '; 502 res := res + AnsiChar(Block[J]); 503 end; 504 iv := bak; 505 posnum := 0; 506 end; 507 508 end; 509 if posnum <> 0 then 510 begin 511 // 512 end 513 else 514 begin 515 temp := ''; 516 for I := 1 to length(res) do 517 begin 518 temp := temp + AnsiChar(res[I]); 519 end; 520 result := Trim(temp); 521 end; 522 523 end; 524 525 function DecryDes(const str: AnsiString; const keystr: AnsiString; const ivstr: AnsiString) 526 : AnsiString; 527 var 528 Key: TKey64; 529 Context: TDESContext; 530 bak, Block, iv: TDESBlock; 531 I, J, len { ,posnum } : smallint; 532 poschar, xx: AnsiChar; 533 res, lss: AnsiString; 534 begin 535 for I := 0 to 7 do 536 begin 537 if I > (length(keystr) - 1) then 538 Key[I] := 0 539 else 540 Key[I] := Byte(keystr[I + 1]); 541 end; 542 for I := 0 to 15 do 543 begin 544 if I > (length(ivstr) - 1) then 545 iv[I] := 0 546 else 547 iv[I] := Byte(ivstr[I + 1]); 548 end; 549 InitEncryptDES(Key, Context, False); 550 res := ''; 551 for J := 0 to (length(str) div 2) - 1 do 552 begin 553 lss := copy(str, J * 2 + 1, 2); 554 res := res + AnsiChar(StrToInt('$' + lss)); 555 end; 556 len := length(AnsiString(res)); 557 for I := 0 to round(len / 8) - 1 do 558 begin 559 for J := 0 to 7 do 560 begin 561 if ((I * 7 + J + 1) <= len) then 562 begin 563 poschar := res[I * 8 + J + 1]; 564 Block[J] := Byte(poschar); 565 end 566 else 567 begin 568 Block[J] := Byte(xx); 569 end; 570 end; 571 bak := Block; 572 EncryptDESCBC(Context, iv, Block); 573 for J := 0 to 7 do 574 begin 575 result := result + AnsiChar(Block[J]); 576 end; 577 iv := bak; 578 end; 579 580 end; 581 582 end.
///不支持中文，暂时把中文用BASE64转换后加密