unit WNDES;<br><br>interface<br><br>uses<br> Windows, Messages, ShlObj, WinSock, IniFiles, ActiveX, SysUtils,<br> Classes, Graphics, Controls, Forms, Dialogs;<br><br>type<br> TKeyByte = array[0..5] of Byte;<br> TDesMode = (dmEncry, dmDESry);<br>const<br> BitIP: array[0..63] of Byte =<br> (57, 49, 41, 33, 25, 17, 9, 1,<br> 59, 51, 43, 35, 27, 19, 11, 3,<br> 61, 53, 45, 37, 29, 21, 13, 5,<br> 63, 55, 47, 39, 31, 23, 15, 7,<br> 56, 48, 40, 32, 24, 16, 8, 0,<br> 58, 50, 42, 34, 26, 18, 10, 2,<br> 60, 52, 44, 36, 28, 20, 12, 4,<br> 62, 54, 46, 38, 30, 22, 14, 6);<br><br> BitCP: array[0..63] of Byte =<br> (39, 7, 47, 15, 55, 23, 63, 31,<br> 38, 6, 46, 14, 54, 22, 62, 30,<br> 37, 5, 45, 13, 53, 21, 61, 29,<br> 36, 4, 44, 12, 52, 20, 60, 28,<br> 35, 3, 43, 11, 51, 19, 59, 27,<br> 34, 2, 42, 10, 50, 18, 58, 26,<br> 33, 1, 41, 9, 49, 17, 57, 25,<br> 32, 0, 40, 8, 48, 16, 56, 24);<br><br> BitExp: array[0..47] of Integer =<br> (31, 0, 1, 2, 3, 4, 3, 4, 5, 6, 7, 8, 7, 8, 9, 10,<br> 11, 12, 11, 12, 13, 14, 15, 16, 15, 16, 17, 18, 19, 20, 19, 20,<br> 21, 22, 23, 24, 23, 24, 25, 26, 27, 28, 27, 28, 29, 30, 31, 0);<br><br> BitPM: array[0..31] of Byte =<br> (15, 6, 19, 20, 28, 11, 27, 16, 0, 14, 22, 25, 4, 17, 30, 9,<br> 1, 7, 23, 13, 31, 26, 2, 8, 18, 12, 29, 5, 21, 10, 3, 24);<br><br> sBox: array[0..7] of array[0..63] of Byte =<br> ((14, 4, 13, 1, 2, 15, 11, 8, 3, 10, 6, 12, 5, 9, 0, 7,<br> 0, 15, 7, 4, 14, 2, 13, 1, 10, 6, 12, 11, 9, 5, 3, 8,<br> 4, 1, 14, 8, 13, 6, 2, 11, 15, 12, 9, 7, 3, 10, 5, 0,<br> 15, 12, 8, 2, 4, 9, 1, 7, 5, 11, 3, 14, 10, 0, 6, 13),<br><br> (15, 1, 8, 14, 6, 11, 3, 4, 9, 7, 2, 13, 12, 0, 5, 10,<br> 3, 13, 4, 7, 15, 2, 8, 14, 12, 0, 1, 10, 6, 9, 11, 5,<br> 0, 14, 7, 11, 10, 4, 13, 1, 5, 8, 12, 6, 9, 3, 2, 15,<br> 13, 8, 10, 1, 3, 15, 4, 2, 11, 6, 7, 12, 0, 5, 14, 9),<br><br> (10, 0, 9, 14, 6, 3, 15, 5, 1, 13, 12, 7, 11, 4, 2, 8,<br> 13, 7, 0, 9, 3, 4, 6, 10, 2, 8, 5, 14, 12, 11, 15, 1,<br> 13, 6, 4, 9, 8, 15, 3, 0, 11, 1, 2, 12, 5, 10, 14, 7,<br> 1, 10, 13, 0, 6, 9, 8, 7, 4, 15, 14, 3, 11, 5, 2, 12),<br><br> (7, 13, 14, 3, 0, 6, 9, 10, 1, 2, 8, 5, 11, 12, 4, 15,<br> 13, 8, 11, 5, 6, 15, 0, 3, 4, 7, 2, 12, 1, 10, 14, 9,<br> 10, 6, 9, 0, 12, 11, 7, 13, 15, 1, 3, 14, 5, 2, 8, 4,<br> 3, 15, 0, 6, 10, 1, 13, 8, 9, 4, 5, 11, 12, 7, 2, 14),<br><br> (2, 12, 4, 1, 7, 10, 11, 6, 8, 5, 3, 15, 13, 0, 14, 9,<br> 14, 11, 2, 12, 4, 7, 13, 1, 5, 0, 15, 10, 3, 9, 8, 6,<br> 4, 2, 1, 11, 10, 13, 7, 8, 15, 9, 12, 5, 6, 3, 0, 14,<br> 11, 8, 12, 7, 1, 14, 2, 13, 6, 15, 0, 9, 10, 4, 5, 3),<br><br> (12, 1, 10, 15, 9, 2, 6, 8, 0, 13, 3, 4, 14, 7, 5, 11,<br> 10, 15, 4, 2, 7, 12, 9, 5, 6, 1, 13, 14, 0, 11, 3, 8,<br> 9, 14, 15, 5, 2, 8, 12, 3, 7, 0, 4, 10, 1, 13, 11, 6,<br> 4, 3, 2, 12, 9, 5, 15, 10, 11, 14, 1, 7, 6, 0, 8, 13),<br><br> (4, 11, 2, 14, 15, 0, 8, 13, 3, 12, 9, 7, 5, 10, 6, 1,<br> 13, 0, 11, 7, 4, 9, 1, 10, 14, 3, 5, 12, 2, 15, 8, 6,<br> 1, 4, 11, 13, 12, 3, 7, 14, 10, 15, 6, 8, 0, 5, 9, 2,<br> 6, 11, 13, 8, 1, 4, 10, 7, 9, 5, 0, 15, 14, 2, 3, 12),<br><br> (13, 2, 8, 4, 6, 15, 11, 1, 10, 9, 3, 14, 5, 0, 12, 7,<br> 1, 15, 13, 8, 10, 3, 7, 4, 12, 5, 6, 11, 0, 14, 9, 2,<br> 7, 11, 4, 1, 9, 12, 14, 2, 0, 6, 10, 13, 15, 3, 5, 8,<br> 2, 1, 14, 7, 4, 10, 8, 13, 15, 12, 9, 0, 3, 5, 6, 11));<br><br> BitPMC1: array[0..55] of Byte =<br> (56, 48, 40, 32, 24, 16, 8,<br> 0, 57, 49, 41, 33, 25, 17,<br> 9, 1, 58, 50, 42, 34, 26,<br> 18, 10, 2, 59, 51, 43, 35,<br> 62, 54, 46, 38, 30, 22, 14,<br> 6, 61, 53, 45, 37, 29, 21,<br> 13, 5, 60, 52, 44, 36, 28,<br> 20, 12, 4, 27, 19, 11, 3);<br><br> BitPMC2: array[0..47] of Byte =<br> (13, 16, 10, 23, 0, 4,<br> 2, 27, 14, 5, 20, 9,<br> 22, 18, 11, 3, 25, 7,<br> 15, 6, 26, 19, 12, 1,<br> 40, 51, 30, 36, 46, 54,<br> 29, 39, 50, 44, 32, 47,<br> 43, 48, 38, 55, 33, 52,<br> 45, 41, 49, 35, 28, 31);<br>//////////////////DES加密算法//////////////////////////// <br>function EncryStr(Str, Key: string): string; //加密<br>function EncryStrHex(Str, Key: string): string; //以十六进制加密(有些时侯加密的密文含有特殊字符文本框不能显示、数据库文本字段也不能存储。以十六进制形式表示可保证绝对不会出现该种情况)<br>function DESryStr(Str, Key: string): string; //解密<br>function DESryStrHex(StrHex, Key: string): string; //解密十六进制加密的密文<br><br>var<br> subKey: array[0..15] of TKeyByte;<br>implementation<br><br><br><br>procedure initPermutation(var inData: array of Byte);<br>var<br> newData: array[0..7] of Byte;<br> i: Integer;<br>begin<br> FillChar(newData, 8, 0);<br> for i := 0 to 63 do<br> if (inData[BitIP shr 3] and (1 shl (7 - (BitIP and $07)))) <> 0 then<br> newData[i shr 3] := newData[i shr 3] or (1 shl (7 - (i and $07)));<br> for i := 0 to 7 do inData := newData;<br>end;<br><br>procedure conversePermutation(var inData: array of Byte);<br>var<br> newData: array[0..7] of Byte;<br> i: Integer;<br>begin<br> FillChar(newData, 8, 0);<br> for i := 0 to 63 do<br> if (inData[BitCP shr 3] and (1 shl (7 - (BitCP and $07)))) <> 0 then<br> newData[i shr 3] := newData[i shr 3] or (1 shl (7 - (i and $07)));<br> for i := 0 to 7 do inData := newData;<br>end;<br><br>procedure expand(inData: array of Byte; var outData: array of Byte);<br>var<br> i: Integer;<br>begin<br> FillChar(outData, 6, 0);<br> for i := 0 to 47 do<br> if (inData[BitExp shr 3] and (1 shl (7 - (BitExp and $07)))) <> 0 then<br> outData[i shr 3] := outData[i shr 3] or (1 shl (7 - (i and $07)));<br>end;<br><br>procedure permutation(var inData: array of Byte);<br>var<br> newData: array[0..3] of Byte;<br> i: Integer;<br>begin<br> FillChar(newData, 4, 0);<br> for i := 0 to 31 do<br> if (inData[BitPM shr 3] and (1 shl (7 - (BitPM and $07)))) <> 0 then<br> newData[i shr 3] := newData[i shr 3] or (1 shl (7 - (i and $07)));<br> for i := 0 to 3 do inData := newData;<br>end;<br><br>function si(s, inByte: Byte): Byte;<br>var<br> c: Byte;<br>begin<br> c := (inByte and $20) or ((inByte and $1E) shr 1) or<br> ((inByte and $01) shl 4);<br> Result := (sBox[c] and $0F);<br>end;<br><br>procedure permutationChoose1(inData: array of Byte;<br> var outData: array of Byte);<br>var<br> i: Integer;<br>begin<br> FillChar(outData, 7, 0);<br> for i := 0 to 55 do<br> if (inData[BitPMC1 shr 3] and (1 shl (7 - (BitPMC1 and $07)))) <> 0 then<br> outData[i shr 3] := outData[i shr 3] or (1 shl (7 - (i and $07)));<br>end;<br><br>procedure permutationChoose2(inData: array of Byte;<br> var outData: array of Byte);<br>var<br> i: Integer;<br>begin<br> FillChar(outData, 6, 0);<br> for i := 0 to 47 do<br> if (inData[BitPMC2 shr 3] and (1 shl (7 - (BitPMC2 and $07)))) <> 0 then<br> outData[i shr 3] := outData[i shr 3] or (1 shl (7 - (i and $07)));<br>end;<br><br> <br>procedure cycleMove(var inData: array of Byte; bitMove: Byte);<br>var<br> i: Integer;<br>begin<br> for i := 0 to bitMove - 1 do<br> begin<br> inData[0] := (inData[0] shl 1) or (inData[1] shr 7);<br> inData[1] := (inData[1] shl 1) or (inData[2] shr 7);<br> inData[2] := (inData[2] shl 1) or (inData[3] shr 7);<br> inData[3] := (inData[3] shl 1) or ((inData[0] and $10) shr 4);<br> inData[0] := (inData[0] and $0F);<br> end;<br>end;<br><br>procedure makeKey(inKey: array of Byte; var outKey: array of TKeyByte);<br>const<br> bitDisplace: array[0..15] of Byte =<br> (1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 1);<br>var<br> outData56: array[0..6] of Byte;<br> key28l: array[0..3] of Byte;<br> key28r: array[0..3] of Byte;<br> key56o: array[0..6] of Byte;<br> i: Integer;<br>begin<br> permutationChoose1(inKey, outData56);<br><br> key28l[0] := outData56[0] shr 4;<br> key28l[1] := (outData56[0] shl 4) or (outData56[1] shr 4);<br> key28l[2] := (outData56[1] shl 4) or (outData56[2] shr 4);<br> key28l[3] := (outData56[2] shl 4) or (outData56[3] shr 4);<br> key28r[0] := outData56[3] and $0F;<br> key28r[1] := outData56[4];<br> key28r[2] := outData56[5];<br> key28r[3] := outData56[6];<br><br> for i := 0 to 15 do<br> begin<br> cycleMove(key28l, bitDisplace);<br> cycleMove(key28r, bitDisplace);<br> key56o[0] := (key28l[0] shl 4) or (key28l[1] shr 4);<br> key56o[1] := (key28l[1] shl 4) or (key28l[2] shr 4);<br> key56o[2] := (key28l[2] shl 4) or (key28l[3] shr 4);<br> key56o[3] := (key28l[3] shl 4) or (key28r[0]);<br> key56o[4] := key28r[1];<br> key56o[5] := key28r[2];<br> key56o[6] := key28r[3];<br> permutationChoose2(key56o, outKey);<br> end;<br>end;<br><br>procedure encry(inData, subKey: array of Byte;<br> var outData: array of Byte);<br>var<br> outBuf: array[0..5] of Byte;<br> buf: array[0..7] of Byte;<br> i: Integer;<br>begin<br> expand(inData, outBuf);<br> for i := 0 to 5 do outBuf := outBuf xor subKey;<br> // outBuf xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx xxxxxxxx<br> buf[0] := outBuf[0] shr 2; //xxxxxx -> 2<br> buf[1] := ((outBuf[0] and $03) shl 4) or (outBuf[1] shr 4); // 4 <- xx xxxx -> 4<br> buf[2] := ((outBuf[1] and $0F) shl 2) or (outBuf[2] shr 6); // 2 <- xxxx xx -> 6<br> buf[3] := outBuf[2] and $3F; // xxxxxx<br> buf[4] := outBuf[3] shr 2; // xxxxxx<br> buf[5] := ((outBuf[3] and $03) shl 4) or (outBuf[4] shr 4); // xx xxxx<br> buf[6] := ((outBuf[4] and $0F) shl 2) or (outBuf[5] shr 6); // xxxx xx<br> buf[7] := outBuf[5] and $3F; // xxxxxx<br> for i := 0 to 7 do buf := si(i, buf);<br> for i := 0 to 3 do outBuf := (buf[i * 2] shl 4) or buf[i * 2 + 1];<br> permutation(outBuf);<br> for i := 0 to 3 do outData := outBuf;<br>end;<br><br>procedure desData(desMode: TDesMode;<br> inData: array of Byte; var outData: array of Byte);<br>// inData, outData 都为8Bytes,否则出错<br>var<br> i, j: Integer;<br> temp, buf: array[0..3] of Byte;<br>begin<br> for i := 0 to 7 do outData := inData;<br> initPermutation(outData);<br> if desMode = dmEncry then<br> begin<br> for i := 0 to 15 do<br> begin<br> for j := 0 to 3 do temp[j] := outData[j]; //temp = Ln<br> for j := 0 to 3 do outData[j] := outData[j + 4]; //Ln+1 = Rn<br> encry(outData, subKey, buf); //Rn ==Kn==> buf<br> for j := 0 to 3 do outData[j + 4] := temp[j] xor buf[j]; //Rn+1 = Ln^buf<br> end;<br><br> for j := 0 to 3 do temp[j] := outData[j + 4];<br> for j := 0 to 3 do outData[j + 4] := outData[j];<br> for j := 0 to 3 do outData[j] := temp[j];<br> end<br> else if desMode = dmDESry then<br> begin<br> for i := 15 downto 0 do<br> begin<br> for j := 0 to 3 do temp[j] := outData[j];<br> for j := 0 to 3 do outData[j] := outData[j + 4];<br> encry(outData, subKey, buf);<br> for j := 0 to 3 do outData[j + 4] := temp[j] xor buf[j];<br> end;<br> for j := 0 to 3 do temp[j] := outData[j + 4];<br> for j := 0 to 3 do outData[j + 4] := outData[j];<br> for j := 0 to 3 do outData[j] := temp[j];<br> end;<br> conversePermutation(outData);<br>end;<br><br>function EncryStr(Str, Key: string): string;<br>var<br> StrByte, OutByte, KeyByte: array[0..7] of Byte;<br> StrResult: string;<br> I, J: Integer;<br>begin<br> if (Length(Str) > 0) and (Ord(Str[Length(Str)]) = 0) then<br> raise Exception.Create('Error: the last char is NULL char.');<br> if Length(Key) < 8 then<br> while Length(Key) < 8 do Key := Key + Chr(0);<br> while Length(Str) mod 8 <> 0 do Str := Str + Chr(0);<br><br> for J := 0 to 7 do KeyByte[J] := Ord(Key[J + 1]);<br> makeKey(keyByte, subKey);<br><br> StrResult := '';<br><br> for I := 0 to Length(Str) div 8 - 1 do<br> begin<br> for J := 0 to 7 do<br> StrByte[J] := Ord(Str[I * 8 + J + 1]);<br> desData(dmEncry, StrByte, OutByte);<br> for J := 0 to 7 do<br> StrResult := StrResult + Chr(OutByte[J]);<br> end;<br><br> Result := StrResult;<br>end;<br><br>function DESryStr(Str, Key: string): string;<br>var<br> StrByte, OutByte, KeyByte: array[0..7] of Byte;<br> StrResult: string;<br> I, J: Integer;<br>begin<br> if Length(Key) < 8 then<br> while Length(Key) < 8 do Key := Key + Chr(0);<br><br> for J := 0 to 7 do KeyByte[J] := Ord(Key[J + 1]);<br> makeKey(keyByte, subKey);<br><br> StrResult := '';<br><br> for I := 0 to Length(Str) div 8 - 1 do<br> begin<br> for J := 0 to 7 do StrByte[J] := Ord(Str[I * 8 + J + 1]);<br> desData(dmDESry, StrByte, OutByte);<br> for J := 0 to 7 do<br> StrResult := StrResult + Chr(OutByte[J]);<br> end;<br> while (Length(StrResult) > 0) and<br> (Ord(StrResult[Length(StrResult)]) = 0) do<br> Delete(StrResult, Length(StrResult), 1);<br> Result := StrResult;<br>end;<br><br>///////////////////////////////////////////////////////////<br><br>function EncryStrHex(Str, Key: string): string;<br>var<br> StrResult, TempResult, Temp: string;<br> I: Integer;<br>begin<br> TempResult := EncryStr(Str, Key);<br> StrResult := '';<br> for I := 0 to Length(TempResult) - 1 do<br> begin<br> Temp := Format('%x', [Ord(TempResult[I + 1])]);<br> if Length(Temp) = 1 then Temp := '0' + Temp;<br> StrResult := StrResult + Temp;<br> end;<br> Result := StrResult;<br>end;<br><br>function DESryStrHex(StrHex, Key: string): string;<br> function HexToInt(Hex: string): Integer;<br> var<br> I, Res: Integer;<br> ch: Char;<br> begin<br> Res := 0;<br> for I := 0 to Length(Hex) - 1 do<br> begin<br> ch := Hex[I + 1];<br> if (ch >= '0') and (ch <= '9') then<br> Res := Res * 16 + Ord(ch) - Ord('0')<br> else if (ch >= 'A') and (ch <= 'F') then<br> Res := Res * 16 + Ord(ch) - Ord('A') + 10<br> else if (ch >= 'a') and (ch <= 'f') then<br> Res := Res * 16 + Ord(ch) - Ord('a') + 10<br> else raise Exception.Create('Error: not a Hex String');<br> end;<br> Result := Res;<br> end;<br><br>var<br> Str, Temp: string;<br> I: Integer;<br>begin<br> Str := '';<br> for I := 0 to Length(StrHex) div 2 - 1 do<br> begin<br> Temp := Copy(StrHex, I * 2 + 1, 2);<br> Str := Str + Chr(HexToInt(Temp));<br> end;<br> Result := DESryStr(Str, Key);<br>end;<br><br><br>end.<br>用十六进制的方法进行加密和解密,把结果存在数据库中。<br>不过你也要清楚如果别人把用户2的口令字段内容复制到用<br>户1上,是不是就可以用用户2的口令在用户1上登录了呢?<br>所以我建议把用户名和口令加在一起再加密。登陆时验证用<br>户名和口令然后记住用户名或口令在进入模块时也要验证用户名或口令。<br><br>