请高手，将这个ASP代码翻译成PASCAL代码，或者写一个ASP和PASCAL产生结果相同的DES加解密代码。在线等，特急 300分！ ( 积分: 300 )

linchhero · 2007-11-06

<%
Class Cls_DES
Private IPRule, CPRule, EPRule, PRule, SBox(7), PCRule(1), MvRule
Private K(16), L(16), R(16)
Private FillCode, DesStatus

Private Sub Class_Initialize()
DesStatus = -1
FillCode = "0001101"
IPRule = "58,50,42,34,26,18,10,2,&quot
&_
"60,52,44,36,28,20,12,4,&quot
&_
"62,54,46,38,30,22,14,6,&quot
&_
"64,56,48,40,32,24,16,8,&quot
&_
"57,49,41,33,25,17, 9,1,&quot
&_
"59,51,43,35,27,19,11,3,&quot
&_
"61,53,45,37,29,21,13,5,&quot
&_
"63,55,47,39,31,23,15,7,"
CPRule = "40, 8,48,16,56,24,64,32,&quot
&_
"39, 7,47,15,55,23,63,31,&quot
&_
"38, 6,46,14,54,22,62,30,&quot
&_
"37, 5,45,13,53,21,61,29,&quot
&_
"36, 4,44,12,52,20,60,28,&quot
&_
"35, 3,43,11,51,19,59,27,&quot
&_
"34, 2,42,10,50,18,58,26,&quot
&_
"33, 1,41, 9,49,17,57,25,"
EPRule = "32, 1, 2, 3, 4, 5,&quot
&_
&quot
4, 5, 6, 7, 8, 9,&quot
&_
&quot
8, 9,10,11,12,13,&quot
&_
"12,13,14,15,16,17,&quot
&_
"16,17,18,19,20,21,&quot
&_
"20,21,22,23,24,25,&quot
&_
"24,25,26,27,28,29,&quot
&_
"28,29,30,31,32, 1,"
PRule = "16, 7,20,21,29,12,28,17,&quot
&_
&quot
1,15,23,26, 5,18,31,10,&quot
&_
&quot
2, 8,24,14,32,27, 3, 9,&quot
&_
"19,13,30, 6,22,11, 4,25,"
SBox(0) = "14, 4,13, 1, 2,15,11, 8, 3,10, 6,12, 5, 9, 0, 7,&quot
&_
&quot
0,15, 7, 4,14, 2,13, 1,10, 6,12,11, 9, 5, 3, 8,&quot
&_
&quot
4, 1,14, 8,13, 6, 2,11,15,12, 9, 7, 3,10, 5, 0,&quot
&_
"15,12, 8, 2, 4, 9, 1, 7, 5,11, 3,14,10, 0, 6,13,"
SBox(1) = "15, 1, 8,14, 6,11, 3, 4, 9, 7, 2,13,12, 0, 5,10,&quot
&_
&quot
3,13, 4, 7,15, 2, 8,14,12, 0, 1,10, 6, 9,11, 5,&quot
&_
&quot
0,14, 7,11,10, 4,13, 1, 5, 8,12, 6, 9, 3, 2,15,&quot
&_
"13, 8,10, 1, 3,15, 4, 2,11, 6, 7,12, 0, 5,14, 9,"
SBox(2) = "10, 0, 9,14, 6, 3,15, 5, 1,13,12, 7,11, 4, 2, 8,&quot
&_
"13, 7, 0, 9, 3, 4, 6,10, 2, 8, 5,14,12,11,15, 1,&quot
&_
"13, 6, 4, 9, 8,15, 3, 0,11, 1, 2,12, 5,10,14, 7,&quot
&_
&quot
1,10,13, 0, 6, 9, 8, 7, 4,15,14, 3,11, 5, 2,12,"
SBox(3) = &quot
7,13,14, 3, 0, 6, 9,10, 1, 2, 8, 5,11,12, 4,15,&quot
&_
"13, 8,11, 5, 6,15, 0, 3, 4, 7, 2,12, 1,10,14, 9,&quot
&_
"10, 6, 9, 0,12,11, 7,13,15, 1, 3,14, 5, 2, 8, 4,&quot
&_
&quot
3,15, 0, 6,10, 1,13, 8, 9, 4, 5,11,12, 7, 2,14,"
SBox(4) = &quot
2,12, 4, 1, 7,10,11, 6, 8, 5, 3,15,13, 0,14, 9,&quot
&_
"14,11, 2,12, 4, 7,13, 1, 5, 0,15,10, 3, 9, 8, 6,&quot
&_
&quot
4, 2, 1,11,10,13, 7, 8,15, 9,12, 5, 6, 3, 0,14,&quot
&_
"11, 8,12, 7, 1,14, 2,13, 6,15, 0, 9,10, 4, 5, 3,"
SBox(5) = "12, 1,10,15, 9, 2, 6, 8, 0,13, 3, 4,14, 7, 5,11,&quot
&_
"10,15, 4, 2, 7,12, 9, 5, 6, 1,13,14, 0,11, 3, 8,&quot
&_
&quot
9,14,15, 5, 2, 8,12, 3, 7, 0, 4,10, 1,13,11, 6,&quot
&_
&quot
4, 3, 2,12, 9, 5,15,10,11,14, 1, 7, 6, 0, 8,13,"
SBox(6) = &quot
4,11, 2,14,15, 0, 8,13, 3,12, 9, 7, 5,10, 6, 1,&quot
&_
"13, 0,11, 7, 4, 9, 1,10,14, 3, 5,12, 2,15, 8, 6,&quot
&_
&quot
1, 4,11,13,12, 3, 7,14,10,15, 6, 8, 0, 5, 9, 2,&quot
&_
&quot
6,11,13, 8, 1, 4,10, 7, 9, 5, 0,15,14, 2, 3,12,"
SBox(7) = "13, 2, 8, 4, 6,15,11, 1,10, 9, 3,14, 5, 0,12, 7,&quot
&_
&quot
1,15,13, 8,10, 3, 7, 4,12, 5, 6,11, 0,14, 9, 2,&quot
&_
&quot
7,11, 4, 1, 9,12,14, 2, 0, 6,10,13,15, 3, 5, 8,&quot
&_
&quot
2, 1,14, 7, 4,10, 8,13,15,12, 9, 0, 3, 5, 6,11,"
PCRule(0) = "57,49,41,33,25,17, 9,&quot
&_
&quot
1,58,50,42,34,26,18,&quot
&_
"10, 2,59,51,43,35,27,&quot
&_
"19,11, 3,60,52,44,36,&quot
&_
"63,55,47,39,31,23,15,&quot
&_
&quot
7,62,54,46,38,30,22,&quot
&_
"14, 6,61,53,45,37,29,&quot
&_
"21,13, 5,28,20,12, 4,"
PCRule(1) = "14,17,11,24, 1, 5, 3,28,&quot
&_
"15, 6,21,10,23,19,12, 4,&quot
&_
"26, 8,16, 7,27,20,13, 2,&quot
&_
"41,52,31,37,47,55,30,40,&quot
&_
"51,45,33,48,44,49,39,56,&quot
&_
"34,53,46,42,50,36,29,32,"
MvRule = "1,1,2,2,2,2,2,2,1,2,2,2,2,2,2,1"
End Sub

Private Function Permute(ByVal Rule, ByVal Text)
Dim P_Rule, Num, PText
PText = ""
P_Rule = Split(Rule, ",&quot

For Each Num In P_Rule
Num = Trim(Num) &amp
""
If Num <> "&quot
Then
Num = CLng(Num)
PText = PText &amp
Mid(Text, Num, 1)
End If
Next
Erase P_Rule
Permute = PText
End Function

Private Function CreateKey()
Dim IPKey, C(16), D(16), i, Mv_Rule, MvLen
IPKey = Permute(PCRule(0), K(0))
C(0) = Left(IPKey, 28)
D(0) = Right(IPKey, 28)
Mv_Rule = Split(MvRule, ",&quot

For i = 1 To 16
MvLen = CLng(Trim(Mv_Rule(i - 1)))
C(i) = Right(C(i -1), Len(C(i -1)) - MvLen) &amp
Left(C(i -1), MvLen)
D(i) = Right(D(i -1), Len(D(i -1)) - MvLen) &amp
Left(D(i -1), MvLen)
K(i) = Permute(PCRule(1), C(i) &amp
D(i))
Next
End Function

Private Function IP(ByVal Text)
Dim IPText
IPText = Permute(IPRule, Text)
L(0) = Left(IPText, 32)
R(0) = Right(IPText, 32)
IP = IPText
End Function

Private Function IterativeLR()
Dim i
For i = 1 To 16
L(i) = R(i - 1)
R(i) = B_XOR(L(i - 1), F(R(i - 1), K(i)))
Next
End Function

Private Function F(ByVal RText, ByVal Keys)
Dim EPText, XORText, Result, SKey(7), i, x, y
Result = ""
EPText = Permute(EPRule, RText)
XORText = B_XOR(EPText, Keys)
For i = 1 To Len(XORText) / 6
SKey(i - 1) = Mid(XORText, (i - 1) * 6 + 1, 6)
x = BinaryToDecimal(Left(SKey(i - 1), 1) &amp
Right(SKey(i - 1), 1))
y = BinaryToDecimal(Mid(SKey(i - 1), 2, 4))
SKey(i - 1) = DecimalToBinary(Trim(Split(SBox(i -1), ",&quot

(x * 16 + y)))
If Len(SKey(i - 1)) < 4 Then
Select Case (4 - Len(SKey(i - 1)))
Case 1
SKey(i - 1) = "0&quot
&amp
SKey(i - 1)
Case 2
SKey(i - 1) = "00&quot
&amp
SKey(i - 1)
Case 3
SKey(i - 1) = "000&quot
&amp
SKey(i - 1)
End Select
End If
Result = Result &amp
SKey(i - 1)
Next
Result = Permute(PRule, Result)
F = Result
End Function

Private Function B_XOR(ByVal Expression1, ByVal Expression2)
Dim E, K, i, XORText
XORText = ""
E = Trim(Expression1) &amp
""
K = Trim(Expression2) &amp
""
For i = 1 To Len(K)
XORText = XORText &amp
CStr(CInt(Mid(E, i, 1)) Xor CInt(Mid(K, i, 1)))
Next
B_XOR = XORText
End Function

Private Function BinaryToDecimal(ByVal binNum)
Dim Binary, Decimal, i, Length
Decimal = 0
Binary = Trim(binNum) &amp
""
If Binary <> "&quot
Then
While Left(Binary, 1) = "0"
Binary = Right(Binary, Len(Binary) - 1)
Wend
Length = Len(Binary)
For i = 1 To Length
Decimal = Decimal + CInt(Mid(Binary, i, 1)) * 2^(Length - i)
Next
End If
BinaryToDecimal = Decimal
End Function

Private Function DecimalToBinary(ByVal decNum)
Dim Decimal, Binary, division
Binary = ""
Decimal = Trim(decNum) &amp
""
If Decimal <> "&quot
Then
Decimal = CLng(Decimal)
While Decimal > 1
Binary = Binary &amp
CStr(Decimal Mod 2)
Decimal = Decimal / 2
Wend
Binary = StrReverse(Binary &amp
Decimal)
End If
DecimalToBinary = Binary
End Function

Private Function StrToBinary(ByVal Str)
Dim Data, Binary, Text, TextLen, i
Text = ""
Data = Str
For i = 1 To Len(Data)
Binary = CStr(DecimalToBinary(Asc(Mid(Data, i, 1))))
If Len(Binary) < 7 Then
Select Case (7 - Len(Binary))
Case 1
Binary = "0&quot
&amp
Binary
Case 2
Binary = "00&quot
&amp
Binary
Case 3
Binary = "000&quot
&amp
Binary
Case 4
Binary = "0000&quot
&amp
Binary
Case 5
Binary = "00000&quot
&amp
Binary
Case 6
Binary = "000000&quot
&amp
Binary
End Select
End If
Text = Text &amp
Binary
Next
TextLen = Len(Text)
If TextLen >= 63 Then
If (TextLen Mod 63) <> 0 Then
For i = 1 To ((TextLen - TextLen Mod 63) / 7)
Text = Text &amp
FillCode
Next
End If
Else
For i = 1 To ((63 - TextLen) / 7)
Text = Text &amp
FillCode
Next
End If

Binary = Text
Text = ""
For i = 0 To (Len(Binary) / 63 - 1)
Text = Text &amp
Mid(Binary, i * 63 + 1, 63) &amp
"0"
Next
StrToBinary = Text
End Function

Private Function BinaryToStr(ByVal binNum)
Dim Text, binText, Length, Group, i, j
Text = ""
binText = Trim(binNum) &amp
""
If binText <> "&quot
Then
Length = Len(binText) / 64 - 1
ReDim Group(Length)
For i = 0 To Length
Group(i) = Left(Mid(binText, i * 64 + 1, 64), 63)
Next
While Right(Group(Length), 7) = FillCode
Group(Length) = Left(Group(Length), Len(Group(Length)) - 7)
Wend
For i = 0 To Length
For j = 1 To Len(Group(i)) / 7
Text = Text &amp
Chr(BinaryToDecimal(Mid(Group(i), (j - 1) * 7 + 1, 7)))
Next
Next
Erase Group
End If
BinaryToStr = Text
End Function

Private Function BinaryToHex(ByVal binNum)
Dim binText, Text, Length, FillLen, Temp, i
Text = ""
binText = Trim(binNum) &amp
""
If binText <> "&quot
Then
Length = Len(binText)
If Length >= 4 Then
FillLen = Length Mod 4
Else
FillLen = 4 - Length
End If
Select Case FillLen
Case 1
binText = "0&quot
&amp
binText
Case 2
binText = "00&quot
&amp
binText
Case 3
binText = "000&quot
&amp
binText
End Select
For i = 0 To (Len(binText) / 4 - 1)
Temp = Mid(binText, i * 4 + 1, 4)
Select Case Temp
Case "0000"
Text = Text &amp
"0"
Case "0001"
Text = Text &amp
"1"
Case "0010"
Text = Text &amp
"2"
Case "0011"
Text = Text &amp
"3"
Case "0100"
Text = Text &amp
"4"
Case "0101"
Text = Text &amp
"5"
Case "0110"
Text = Text &amp
"6"
Case "0111"
Text = Text &amp
"7"
Case "1000"
Text = Text &amp
"8"
Case "1001"
Text = Text &amp
"9"
Case "1010"
Text = Text &amp
"A"
Case "1011"
Text = Text &amp
"B"
Case "1100"
Text = Text &amp
"C"
Case "1101"
Text = Text &amp
"D"
Case "1110"
Text = Text &amp
"E"
Case "1111"
Text = Text &amp
"F"
End Select
Next
End If
BinaryToHex = Text
End Function

Private Function HexToBinary(ByVal hexNum)
Dim hexText, Text, Temp, i
Text = ""
hexText = Trim(hexNum) &amp
""
For i = 1 To Len(hexText)
Temp = UCase(Mid(hexText, i, 1))
Select Case Temp
Case "0"
Text = Text &amp
"0000"
Case "1"
Text = Text &amp
"0001"
Case "2"
Text = Text &amp
"0010"
Case "3"
Text = Text &amp
"0011"
Case "4"
Text = Text &amp
"0100"
Case "5"
Text = Text &amp
"0101"
Case "6"
Text = Text &amp
"0110"
Case "7"
Text = Text &amp
"0111"
Case "8"
Text = Text &amp
"1000"
Case "9"
Text = Text &amp
"1001"
Case "A"
Text = Text &amp
"1010"
Case "B"
Text = Text &amp
"1011"
Case "C"
Text = Text &amp
"1100"
Case "D"
Text = Text &amp
"1101"
Case "E"
Text = Text &amp
"1110"
Case "F"
Text = Text &amp
"1111"
End Select
Next
HexToBinary = Text
End Function

Private Function KeyReverse()
Dim Temp, i
For i = 1 To 8
Temp = K(i)
K(i) = K(16 - i + 1)
K(16 - i + 1) = Temp
Next
End Function

Public Function DES(ByVal Data, ByVal Keys, ByVal Work)
Dim Text, i, Group, GroupLen
Text = Data
K(0) = HexToBinary(Keys)
If Work = 0 Then
Text = StrToBinary(Text)
Else
Text = HexToBinary(Text)
End If
GroupLen = Len(Text) / 64 - 1
ReDim Group(GroupLen)
For i = 0 To GroupLen
Group(i) = Mid(Text, i * 64 + 1, 64)
Next
Text = ""
CreateKey()
For i = 0 To GroupLen
IP(Group(i))
If Work <> 0 And DesStatus <> 1 Then
KeyReverse()
DesStatus = 1
ElseIf Work = 0 And DesStatus = 1 Then
KeyReverse()
DesStatus = 0
End If
IterativeLR()
Text = Text &amp
Permute(CPRule, R(16) &amp
L(16))
Next
Erase Group
If Work = 0 Then
Text = BinaryToHex(Text)
Else
Text = BinaryToStr(Text)
End If

DES = Text
End Function
End Class
%>

使用说明：

本程序只对ASCII码在000—127范围的字符加密，如果不是这个范围的，加密会出错或者不正确。即在正常在键盘上输入的字符都可以加密（非中文）。因为程序中我使用了ASCII码为013的字符（回车符）作为分组填充字符，所以要加密的字符串记得末尾不能有回车符（回车符和换行符是不同的字符）。

密钥和加密后的字符串都用十六进制数，需要加密的字符串就是原明文字符串。密钥是14位十六进制数（0—9,A,B,C,D,E,F）。下面是加密解密例子：

加密：
key = "F7F741E99D0137"
data = "Qiuyi Studio,OK!"
Set DesCrypt = New Cls_DES
Response.Write(DesCrypt.DES(data,key,0))
Set DesCrypt = Nothing
结果：9E9E1DC1CF117A936DCA399A26C47946

解密：
key = "F7F741E99D0137"
data = "9E9E1DC1CF117A936DCA399A26C47946"
Set DesCrypt = New Cls_DES
Response.Write(DesCrypt.DES(data,key,1))
Set DesCrypt = Nothing
结果：Qiuyi Studio,OK!

cxz9 · 2007-11-06

{******************************************************************************}
{* DCPcrypt v2.0 written by David Barton (crypto@cityinthesky.co.uk) **********}
{******************************************************************************}
{* A binary compatible implementation of DES and Triple DES *******************}
{* Based on C source code by Eric Young ***************************************}
{******************************************************************************}
{* Copyright (c) 1999-2002 David Barton *}
{* Permission is hereby granted, free of charge, to any person obtaining a *}
{* copy of this software and associated documentation files (the "Software&quot

, *}
{* to deal in the Software without restriction, including without limitation *}
{* the rights to use, copy, modify, merge, publish, distribute, sublicense, *}
{* and/or sell copies of the Software, and to permit persons to whom the *}
{* Software is furnished to do so, subject to the following conditions: *}
{* *}
{* The above copyright notice and this permission notice shall be included in *}
{* all copies or substantial portions of the Software. *}
{* *}
{* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR *}
{* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *}
{* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *}
{* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *}
{* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *}
{* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *}
{* DEALINGS IN THE SOFTWARE. *}
{******************************************************************************}
{******************************************************************************}
{* This implementation of DES is based on the C implementation by *}
{* Eric Young (eay@mincom.oz.au) *}
{******************************************************************************}
{* DES takes a 64bit key and discards every 8th bit (56bit effectively) *}
{* 3DES takes either a <= 128bit key and uses one key twice or takes a *}
{* <= 192bit key and uses each once (again discarding every 8th bit) *}
{******************************************************************************}
unit DCPdes;

interface
uses
Classes, Sysutils, DCPcrypt2, DCPconst, DCPblockciphers;

type
TDCP_customdes= class(TDCP_blockcipher64)
protected
procedure DoInit(KeyB: PByteArray
KeyData: PDWordArray);
procedure EncryptBlock(const InData
var OutData
KeyData: PDWordArray);
procedure DecryptBlock(const InData
var OutData
KeyData: PDWordArray);
end;

type
TDCP_des= class(TDCP_customdes)
protected
KeyData: array[0..31] of dword;
procedure InitKey(const Key
Size: longword)
override;
public
class function GetId: integer
override;
class function GetAlgorithm: string
override;
class function GetMaxKeySize: integer
override;
class function SelfTest: boolean
override;
procedure Burn
override;
procedure EncryptECB(const InData
var OutData)
override;
procedure DecryptECB(const InData
var OutData)
override;
end;

TDCP_3des= class(TDCP_customdes)
protected
KeyData: array[0..2,0..31] of dword;
procedure InitKey(const Key
Size: longword)
override;
public
class function GetId: integer
override;
class function GetAlgorithm: string
override;
class function GetMaxKeySize: integer
override;
class function SelfTest: boolean
override;
procedure Burn
override;
procedure EncryptECB(const InData
var OutData)
override;
procedure DecryptECB(const InData
var OutData)
override;
end;

{******************************************************************************}
{******************************************************************************}
implementation
{$R-}{$Q-}

{$I DCPdes.inc}

procedure hperm_op(var a, t: dword
n, m: dword);
begin
t:= ((a shl (16 - n)) xor a) and m;
a:= a xor t xor (t shr (16 - n));
end;

procedure perm_op(var a, b, t: dword
n, m: dword);
begin
t:= ((a shr n) xor b) and m;
b:= b xor t;
a:= a xor (t shl n);
end;

procedure TDCP_customdes.DoInit(KeyB: PByteArray
KeyData: PDwordArray);
var
c, d, t, s, t2, i: dword;
begin
c:= KeyB^[0] or (KeyB^[1] shl 8) or (KeyB^[2] shl 16) or (KeyB^[3] shl 24);
d:= KeyB^[4] or (KeyB^[5] shl 8) or (KeyB^[6] shl 16) or (KeyB^[7] shl 24);
perm_op(d,c,t,4,$0f0f0f0f);
hperm_op(c,t,dword(-2),$cccc0000);
hperm_op(d,t,dword(-2),$cccc0000);
perm_op(d,c,t,1,$55555555);
perm_op(c,d,t,8,$00ff00ff);
perm_op(d,c,t,1,$55555555);
d:= ((d and $ff) shl 16) or (d and $ff00) or ((d and $ff0000) shr 16) or
((c and $f0000000) shr 4);
c:= c and $fffffff;
for i:= 0 to 15 do
begin
if shifts2<> 0 then
begin
c:= ((c shr 2) or (c shl 26));
d:= ((d shr 2) or (d shl 26));
end
else
begin
c:= ((c shr 1) or (c shl 27));
d:= ((d shr 1) or (d shl 27));
end;
c:= c and $fffffff;
d:= d and $fffffff;
s:= des_skb[0,c and $3f] or
des_skb[1,((c shr 6) and $03) or ((c shr 7) and $3c)] or
des_skb[2,((c shr 13) and $0f) or ((c shr 14) and $30)] or
des_skb[3,((c shr 20) and $01) or ((c shr 21) and $06) or ((c shr 22) and $38)];
t:= des_skb[4,d and $3f] or
des_skb[5,((d shr 7) and $03) or ((d shr 8) and $3c)] or
des_skb[6, (d shr 15) and $3f ] or
des_skb[7,((d shr 21) and $0f) or ((d shr 22) and $30)];
t2:= ((t shl 16) or (s and $ffff));
KeyData^[(i shl 1)]:= ((t2 shl 2) or (t2 shr 30));
t2:= ((s shr 16) or (t and $ffff0000));
KeyData^[(i shl 1)+1]:= ((t2 shl 6) or (t2 shr 26));
end;
end;

procedure TDCP_customdes.EncryptBlock(const InData
var OutData
KeyData: PDWordArray);
var
l, r, t, u: dword;
i: longint;
begin
r:= PDword(@InData)^;
l:= PDword(dword(@InData)+4)^;
t:= ((l shr 4) xor r) and $0f0f0f0f;
r:= r xor t;
l:= l xor (t shl 4);
t:= ((r shr 16) xor l) and $0000ffff;
l:= l xor t;
r:= r xor (t shl 16);
t:= ((l shr 2) xor r) and $33333333;
r:= r xor t;
l:= l xor (t shl 2);
t:= ((r shr 8) xor l) and $00ff00ff;
l:= l xor t;
r:= r xor (t shl 8);
t:= ((l shr 1) xor r) and $55555555;
r:= r xor t;
l:= l xor (t shl 1);
r:= (r shr 29) or (r shl 3);
l:= (l shr 29) or (l shl 3);
i:= 0;
while i< 32 do
begin
u:= r xor KeyData^[i ];
t:= r xor KeyData^[i+1];
t:= (t shr 4) or (t shl 28);
l:= l xor des_SPtrans[0,(u shr 2) and $3f] xor
des_SPtrans[2,(u shr 10) and $3f] xor
des_SPtrans[4,(u shr 18) and $3f] xor
des_SPtrans[6,(u shr 26) and $3f] xor
des_SPtrans[1,(t shr 2) and $3f] xor
des_SPtrans[3,(t shr 10) and $3f] xor
des_SPtrans[5,(t shr 18) and $3f] xor
des_SPtrans[7,(t shr 26) and $3f];
u:= l xor KeyData^[i+2];
t:= l xor KeyData^[i+3];
t:= (t shr 4) or (t shl 28);
r:= r xor des_SPtrans[0,(u shr 2) and $3f] xor
des_SPtrans[2,(u shr 10) and $3f] xor
des_SPtrans[4,(u shr 18) and $3f] xor
des_SPtrans[6,(u shr 26) and $3f] xor
des_SPtrans[1,(t shr 2) and $3f] xor
des_SPtrans[3,(t shr 10) and $3f] xor
des_SPtrans[5,(t shr 18) and $3f] xor
des_SPtrans[7,(t shr 26) and $3f];
u:= r xor KeyData^[i+4];
t:= r xor KeyData^[i+5];
t:= (t shr 4) or (t shl 28);
l:= l xor des_SPtrans[0,(u shr 2) and $3f] xor
des_SPtrans[2,(u shr 10) and $3f] xor
des_SPtrans[4,(u shr 18) and $3f] xor
des_SPtrans[6,(u shr 26) and $3f] xor
des_SPtrans[1,(t shr 2) and $3f] xor
des_SPtrans[3,(t shr 10) and $3f] xor
des_SPtrans[5,(t shr 18) and $3f] xor
des_SPtrans[7,(t shr 26) and $3f];
u:= l xor KeyData^[i+6];
t:= l xor KeyData^[i+7];
t:= (t shr 4) or (t shl 28);
r:= r xor des_SPtrans[0,(u shr 2) and $3f] xor
des_SPtrans[2,(u shr 10) and $3f] xor
des_SPtrans[4,(u shr 18) and $3f] xor
des_SPtrans[6,(u shr 26) and $3f] xor
des_SPtrans[1,(t shr 2) and $3f] xor
des_SPtrans[3,(t shr 10) and $3f] xor
des_SPtrans[5,(t shr 18) and $3f] xor
des_SPtrans[7,(t shr 26) and $3f];
Inc(i,8);
end;
r:= (r shr 3) or (r shl 29);
l:= (l shr 3) or (l shl 29);
t:= ((r shr 1) xor l) and $55555555;
l:= l xor t;
r:= r xor (t shl 1);
t:= ((l shr 8) xor r) and $00ff00ff;
r:= r xor t;
l:= l xor (t shl 8);
t:= ((r shr 2) xor l) and $33333333;
l:= l xor t;
r:= r xor (t shl 2);
t:= ((l shr 16) xor r) and $0000ffff;
r:= r xor t;
l:= l xor (t shl 16);
t:= ((r shr 4) xor l) and $0f0f0f0f;
l:= l xor t;
r:= r xor (t shl 4);
PDword(@OutData)^:= l;
PDword(dword(@OutData)+4)^:= r;
end;

procedure TDCP_customdes.DecryptBlock(const InData
var OutData
KeyData: PDWordArray);
var
l, r, t, u: dword;
i: longint;
begin
r:= PDword(@InData)^;
l:= PDword(dword(@InData)+4)^;
t:= ((l shr 4) xor r) and $0f0f0f0f;
r:= r xor t;
l:= l xor (t shl 4);
t:= ((r shr 16) xor l) and $0000ffff;
l:= l xor t;
r:= r xor (t shl 16);
t:= ((l shr 2) xor r) and $33333333;
r:= r xor t;
l:= l xor (t shl 2);
t:= ((r shr 8) xor l) and $00ff00ff;
l:= l xor t;
r:= r xor (t shl 8);
t:= ((l shr 1) xor r) and $55555555;
r:= r xor t;
l:= l xor (t shl 1);
r:= (r shr 29) or (r shl 3);
l:= (l shr 29) or (l shl 3);
i:= 30;
while i> 0 do
begin
u:= r xor KeyData^[i ];
t:= r xor KeyData^[i+1];
t:= (t shr 4) or (t shl 28);
l:= l xor des_SPtrans[0,(u shr 2) and $3f] xor
des_SPtrans[2,(u shr 10) and $3f] xor
des_SPtrans[4,(u shr 18) and $3f] xor
des_SPtrans[6,(u shr 26) and $3f] xor
des_SPtrans[1,(t shr 2) and $3f] xor
des_SPtrans[3,(t shr 10) and $3f] xor
des_SPtrans[5,(t shr 18) and $3f] xor
des_SPtrans[7,(t shr 26) and $3f];
u:= l xor KeyData^[i-2];
t:= l xor KeyData^[i-1];
t:= (t shr 4) or (t shl 28);
r:= r xor des_SPtrans[0,(u shr 2) and $3f] xor
des_SPtrans[2,(u shr 10) and $3f] xor
des_SPtrans[4,(u shr 18) and $3f] xor
des_SPtrans[6,(u shr 26) and $3f] xor
des_SPtrans[1,(t shr 2) and $3f] xor
des_SPtrans[3,(t shr 10) and $3f] xor
des_SPtrans[5,(t shr 18) and $3f] xor
des_SPtrans[7,(t shr 26) and $3f];
u:= r xor KeyData^[i-4];
t:= r xor KeyData^[i-3];
t:= (t shr 4) or (t shl 28);
l:= l xor des_SPtrans[0,(u shr 2) and $3f] xor
des_SPtrans[2,(u shr 10) and $3f] xor
des_SPtrans[4,(u shr 18) and $3f] xor
des_SPtrans[6,(u shr 26) and $3f] xor
des_SPtrans[1,(t shr 2) and $3f] xor
des_SPtrans[3,(t shr 10) and $3f] xor
des_SPtrans[5,(t shr 18) and $3f] xor
des_SPtrans[7,(t shr 26) and $3f];
u:= l xor KeyData^[i-6];
t:= l xor KeyData^[i-5];
t:= (t shr 4) or (t shl 28);
r:= r xor des_SPtrans[0,(u shr 2) and $3f] xor
des_SPtrans[2,(u shr 10) and $3f] xor
des_SPtrans[4,(u shr 18) and $3f] xor
des_SPtrans[6,(u shr 26) and $3f] xor
des_SPtrans[1,(t shr 2) and $3f] xor
des_SPtrans[3,(t shr 10) and $3f] xor
des_SPtrans[5,(t shr 18) and $3f] xor
des_SPtrans[7,(t shr 26) and $3f];
Dec(i,8);
end;
r:= (r shr 3) or (r shl 29);
l:= (l shr 3) or (l shl 29);
t:= ((r shr 1) xor l) and $55555555;
l:= l xor t;
r:= r xor (t shl 1);
t:= ((l shr 8) xor r) and $00ff00ff;
r:= r xor t;
l:= l xor (t shl 8);
t:= ((r shr 2) xor l) and $33333333;
l:= l xor t;
r:= r xor (t shl 2);
t:= ((l shr 16) xor r) and $0000ffff;
r:= r xor t;
l:= l xor (t shl 16);
t:= ((r shr 4) xor l) and $0f0f0f0f;
l:= l xor t;
r:= r xor (t shl 4);
PDword(@OutData)^:= l;
PDword(dword(@OutData)+4)^:= r;
end;

class function TDCP_des.GetMaxKeySize: integer;
begin
Result:= 64;
end;

class function TDCP_des.GetID: integer;
begin
Result:= DCP_des;
end;

class function TDCP_des.GetAlgorithm: string;
begin
Result:= 'DES';
end;

class function TDCP_des.SelfTest: boolean;
const
InData1: array[0..7] of byte=
($07,$56,$D8,$E0,$77,$47,$61,$D2);
OutData1: array[0..7] of byte=
($0C,$D3,$DA,$02,$00,$21,$DC,$09);
Key1: array[0..7] of byte=
($01,$70,$F1,$75,$46,$8F,$B5,$E6);
InData2: array[0..7] of byte=
($48,$0D,$39,$00,$6E,$E7,$62,$F2);
OutData2: array[0..7] of byte=
($A1,$F9,$91,$55,$41,$02,$0B,$56);
Key2: array[0..7] of byte=
($02,$58,$16,$16,$46,$29,$B0,$07);
var
Cipher: TDCP_des;
Data: array[0..7] of byte;
begin
Cipher:= TDCP_des.Create(nil);
Cipher.Init(Key1,Sizeof(Key1)*8,nil);
Cipher.EncryptECB(InData1,Data);
Result:= boolean(CompareMem(@Data,@OutData1,Sizeof(Data)));
Cipher.DecryptECB(Data,Data);
Result:= Result and boolean(CompareMem(@Data,@InData1,Sizeof(Data)));
Cipher.Burn;
Cipher.Init(Key2,Sizeof(Key2)*8,nil);
Cipher.EncryptECB(InData2,Data);
Result:= Result and boolean(CompareMem(@Data,@OutData2,Sizeof(Data)));
Cipher.DecryptECB(Data,Data);
Result:= Result and boolean(CompareMem(@Data,@InData2,Sizeof(Data)));
Cipher.Burn;
Cipher.Free;
end;

procedure TDCP_des.InitKey(const Key
Size: longword);
var
KeyB: array[0..7] of byte;
begin
FillChar(KeyB,Sizeof(KeyB),0);
Move(Key,KeyB,Size div 8);
DoInit(@KeyB,@KeyData);
end;

procedure TDCP_des.Burn;
begin
FillChar(KeyData,Sizeof(KeyData),0);
inherited Burn;
end;

procedure TDCP_des.EncryptECB(const InData
var OutData);
begin
if not fInitialized then
raise EDCP_blockcipher.Create('Cipher not initialized');
EncryptBlock(InData,OutData,@KeyData);
end;

procedure TDCP_des.DecryptECB(const InData
var OutData);
begin
if not fInitialized then
raise EDCP_blockcipher.Create('Cipher not initialized');
DecryptBlock(InData,OutData,@KeyData);
end;

{******************************************************************************}
class function TDCP_3des.GetMaxKeySize: integer;
begin
Result:= 192;
end;

class function TDCP_3des.GetID: integer;
begin
Result:= DCP_3des;
end;

class function TDCP_3des.GetAlgorithm: string;
begin
Result:= '3DES';
end;

class function TDCP_3des.SelfTest: boolean;
const
Key: array[0..23] of byte=
($01,$23,$45,$67,$89,$ab,$cd,$ef,$fe,$dc,$ba,$98,
$76,$54,$32,$10,$89,$ab,$cd,$ef,$01,$23,$45,$67);
PlainText: array[0..7] of byte=
($01,$23,$45,$67,$89,$ab,$cd,$e7);
CipherText: array[0..7] of byte=
($de,$0b,$7c,$06,$ae,$5e,$0e,$d5);
var
Cipher: TDCP_3des;
Block: array[0..7] of byte;
begin
Cipher:= TDCP_3des.Create(nil);
Cipher.Init(Key,Sizeof(Key)*8,nil);
Cipher.EncryptECB(PlainText,Block);
Result:= CompareMem(@Block,@CipherText,Sizeof(CipherText));
Cipher.DecryptECB(Block,Block);
Result:= Result and CompareMem(@Block,@PlainText,Sizeof(PlainText));
Cipher.Free;
end;

procedure TDCP_3des.InitKey(const Key
Size: longword);
var
KeyB: array[0..2,0..7] of byte;
begin
FillChar(KeyB,Sizeof(KeyB),0);
Move(Key,KeyB,Size div 8);
DoInit(@KeyB[0],@KeyData[0]);
DoInit(@KeyB[1],@KeyData[1]);
if Size> 128 then
DoInit(@KeyB[2],@KeyData[2])
else
Move(KeyData[0],KeyData[2],128);
end;

procedure TDCP_3des.Burn;
begin
FillChar(KeyData,Sizeof(KeyData),0);
inherited Burn;
end;

procedure TDCP_3des.EncryptECB(const InData
var OutData);
begin
if not fInitialized then
raise EDCP_blockcipher.Create('Cipher not initialized');
EncryptBlock(InData,OutData,@KeyData[0]);
DecryptBlock(OutData,OutData,@KeyData[1]);
EncryptBlock(OutData,OutData,@KeyData[2]);
end;

procedure TDCP_3des.DecryptECB(const InData
var OutData);
begin
if not fInitialized then
raise EDCP_blockcipher.Create('Cipher not initialized');
DecryptBlock(InData,OutData,@KeyData[2]);
EncryptBlock(OutData,OutData,@KeyData[1]);
DecryptBlock(OutData,OutData,@KeyData[0]);
end;

end.

linchhero · 2007-11-06

to cxz9：
用不了。我这个ASP不是标准的DES算法。我需要的是DELPHI加密，ASP解密，单独的DELPHI DES加密码没有用的，做个DLL在ASP空间又无法调用，用ASP写个DLL，DELPHI每次使用都要注册，所以想来想去，不只有翻译这个ASP的代码，可能最好！

linchhero · 2007-11-06

接受答案了.

请高手，将这个ASP代码翻译成PASCAL代码，或者写一个ASP和PASCAL产生结果相同的DES加解密代码。在线等，特急 300分！ ( 积分: 300 )

linchhero

Unregistered / Unconfirmed

cxz9

Unregistered / Unconfirmed

linchhero

Unregistered / Unconfirmed

linchhero

Unregistered / Unconfirmed

Similar threads