200分，谁将里面的C代码(一个是MD4算法，另一个是des算法)翻译成DELPHI(可能比较难)？ (100分)

typedef unsigned uint32;

static uint32 A, B, C, D;

static uint32 F(uint32 X, uint32 Y, uint32 Z)
{
return (X&Y) | ((~X)&Z);
}

static uint32 G(uint32 X, uint32 Y, uint32 Z)
{
return (X&Y) | (X&Z) | (Y&Z);
}

static uint32 H(uint32 X, uint32 Y, uint32 Z)
{
return X^Y^Z;
}

static uint32 lshift(uint32 x, int s)
{
x &= 0xFFFFFFFF;
return ((x<<s)&0xFFFFFFFF) | (x>>(32-s));
}

#define ROUND1(a,b,c,d,k,s) a = lshift(a + F(b,c,d) + X[k], s)
#define ROUND2(a,b,c,d,k,s) a = lshift(a + G(b,c,d) + X[k] + (uint32)0x5A827999,s)
#define ROUND3(a,b,c,d,k,s) a = lshift(a + H(b,c,d) + X[k] + (uint32)0x6ED9EBA1,s)

static void mdfour64(uint32 *M)
{
int j;
uint32 AA, BB, CC, DD;
uint32 X[16];

for (j=0;j<16;j++)
X[j] = M[j];

AA = A; BB = B; CC = C; DD = D;

ROUND1(A,B,C,D, 0, 3); ROUND1(D,A,B,C, 1, 7);
ROUND1(C,D,A,B, 2, 11); ROUND1(B,C,D,A, 3, 19);
ROUND1(A,B,C,D, 4, 3); ROUND1(D,A,B,C, 5, 7);
ROUND1(C,D,A,B, 6, 11); ROUND1(B,C,D,A, 7, 19);
ROUND1(A,B,C,D, 8, 3); ROUND1(D,A,B,C, 9, 7);
ROUND1(C,D,A,B, 10, 11); ROUND1(B,C,D,A, 11, 19);
ROUND1(A,B,C,D, 12, 3); ROUND1(D,A,B,C, 13, 7);
ROUND1(C,D,A,B, 14, 11); ROUND1(B,C,D,A, 15, 19);

ROUND2(A,B,C,D, 0, 3); ROUND2(D,A,B,C, 4, 5);
ROUND2(C,D,A,B, 8, 9); ROUND2(B,C,D,A, 12, 13);
ROUND2(A,B,C,D, 1, 3); ROUND2(D,A,B,C, 5, 5);
ROUND2(C,D,A,B, 9, 9); ROUND2(B,C,D,A, 13, 13);
ROUND2(A,B,C,D, 2, 3); ROUND2(D,A,B,C, 6, 5);
ROUND2(C,D,A,B, 10, 9); ROUND2(B,C,D,A, 14, 13);
ROUND2(A,B,C,D, 3, 3); ROUND2(D,A,B,C, 7, 5);
ROUND2(C,D,A,B, 11, 9); ROUND2(B,C,D,A, 15, 13);

ROUND3(A,B,C,D, 0, 3); ROUND3(D,A,B,C, 8, 9);
ROUND3(C,D,A,B, 4, 11); ROUND3(B,C,D,A, 12, 15);
ROUND3(A,B,C,D, 2, 3); ROUND3(D,A,B,C, 10, 9);
ROUND3(C,D,A,B, 6, 11); ROUND3(B,C,D,A, 14, 15);
ROUND3(A,B,C,D, 1, 3); ROUND3(D,A,B,C, 9, 9);
ROUND3(C,D,A,B, 5, 11); ROUND3(B,C,D,A, 13, 15);
ROUND3(A,B,C,D, 3, 3); ROUND3(D,A,B,C, 11, 9);
ROUND3(C,D,A,B, 7, 11); ROUND3(B,C,D,A, 15, 15);

A += AA; B += BB; C += CC; D += DD;

A &= 0xFFFFFFFF; B &= 0xFFFFFFFF;
C &= 0xFFFFFFFF; D &= 0xFFFFFFFF;

for (j=0;j<16;j++)
X[j] = 0;
}

static void copy64(uint32 *M, unsigned char *in)
{
int i;

for (i=0;i<16;i++)
M = (in[i*4+3]<<24) | (in[i*4+2]<<16) |
(in[i*4+1]<<8) | (in[i*4+0]<<0);
}

static void copy4(unsigned char *out,uint32 x)
{
out[0] = x&0xFF;
out[1] = (x>>8)&0xFF;
out[2] = (x>>16)&0xFF;
out[3] = (x>>24)&0xFF;
}

void mdfour(unsigned char *out, unsigned char *in, int n)
{
unsigned char buf[128];
uint32 M[16];
uint32 b = n * 8;
int i;

A = 0x67452301;
B = 0xefcdab89;
C = 0x98badcfe;
D = 0x10325476;

while (n > 64) {
copy64(M, in);
mdfour64(M);
in += 64;
n -= 64;
}

for (i=0;i<128;i++)
buf = 0;
memcpy(buf, in, n);
buf[n] = 0x80;

if (n <= 55) {
copy4(buf+56, b);
copy64(M, buf);
mdfour64(M);
} else {
copy4(buf+120, b);
copy64(M, buf);
mdfour64(M);
copy64(M, buf+64);
mdfour64(M);
}

for (i=0;i<128;i++)
buf = 0;
copy64(M, buf);

copy4(out, A);
copy4(out+4, B);
copy4(out+8, C);
copy4(out+12, D);

A = B = C = D = 0;
}

上面是MD4的算法，下面的是des算法，哪位愿意将它们转成DELPHI的？我再出100分。一共就这么多分了！

#define uchar unsigned char

static uchar perm1[56] = {57, 49, 41, 33, 25, 17, 9,
1, 58, 50, 42, 34, 26, 18,
10, 2, 59, 51, 43, 35, 27,
19, 11, 3, 60, 52, 44, 36,
63, 55, 47, 39, 31, 23, 15,
7, 62, 54, 46, 38, 30, 22,
14, 6, 61, 53, 45, 37, 29,
21, 13, 5, 28, 20, 12, 4};

static uchar perm2[48] = {14, 17, 11, 24, 1, 5,
3, 28, 15, 6, 21, 10,
23, 19, 12, 4, 26, 8,
16, 7, 27, 20, 13, 2,
41, 52, 31, 37, 47, 55,
30, 40, 51, 45, 33, 48,
44, 49, 39, 56, 34, 53,
46, 42, 50, 36, 29, 32};

static uchar perm3[64] = {58, 50, 42, 34, 26, 18, 10, 2,
60, 52, 44, 36, 28, 20, 12, 4,
62, 54, 46, 38, 30, 22, 14, 6,
64, 56, 48, 40, 32, 24, 16, 8,
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};

static uchar perm4[48] = { 32, 1, 2, 3, 4, 5,
4, 5, 6, 7, 8, 9,
8, 9, 10, 11, 12, 13,
12, 13, 14, 15, 16, 17,
16, 17, 18, 19, 20, 21,
20, 21, 22, 23, 24, 25,
24, 25, 26, 27, 28, 29,
28, 29, 30, 31, 32, 1};

static uchar perm5[32] = { 16, 7, 20, 21,
29, 12, 28, 17,
1, 15, 23, 26,
5, 18, 31, 10,
2, 8, 24, 14,
32, 27, 3, 9,
19, 13, 30, 6,
22, 11, 4, 25};


static uchar perm6[64] ={ 40, 8, 48, 16, 56, 24, 64, 32,
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};


static uchar sc[16] = {1, 1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 1};

static uchar sbox[8][4][16] = {
{{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}}};

static void permute(char *out, char *in, uchar *p, int n)
{
int i;
for (i=0;i<n;i++)
out = in[p-1];
}

static void lshift(char *d, int count, int n)
{
char out[64];
int i;
for (i=0;i<n;i++)
out = d[(i+count)%n];
for (i=0;i<n;i++)
d = out;
}

static void concat(char *out, char *in1, char *in2, int l1, int l2)
{
while (l1--)
*out++ = *in1++;
while (l2--)
*out++ = *in2++;
}

static void xor(char *out, char *in1, char *in2, int n)
{
int i;
for (i=0;i<n;i++)
out = in1 ^ in2;
}

static void dohash(char *out, char *in, char *key, int forw)
{
int i, j, k;
char pk1[56];
char c[28];
char d[28];
char cd[56];
char ki[16][48];
char pd1[64];
char l[32], r[32];
char rl[64];

permute(pk1, key, perm1, 56);

for (i=0;i<28;i++)
c = pk1;
for (i=0;i<28;i++)
d = pk1[i+28];

for (i=0;i<16;i++) {
lshift(c, sc, 28);
lshift(d, sc, 28);

concat(cd, c, d, 28, 28);
permute(ki, cd, perm2, 48);
}

permute(pd1, in, perm3, 64);

for (j=0;j<32;j++) {
l[j] = pd1[j];
r[j] = pd1[j+32];
}

for (i=0;i<16;i++) {
char er[48];
char erk[48];
char b[8][6];
char cb[32];
char pcb[32];
char r2[32];

permute(er, r, perm4, 48);

xor(erk, er, ki[forw ? i : 15 - i], 48);

for (j=0;j<8;j++)
for (k=0;k<6;k++)
b[j][k] = erk[j*6 + k];

for (j=0;j<8;j++) {
int m, n;
m = (b[j][0]<<1) | b[j][5];

n = (b[j][1]<<3) | (b[j][2]<<2) | (b[j][3]<<1) | b[j][4];

for (k=0;k<4;k++)
b[j][k] = (sbox[j][m][n] & (1<<(3-k)))?1:0;
}

for (j=0;j<8;j++)
for (k=0;k<4;k++)
cb[j*4+k] = b[j][k];
permute(pcb, cb, perm5, 32);

xor(r2, l, pcb, 32);

for (j=0;j<32;j++)
l[j] = r[j];

for (j=0;j<32;j++)
r[j] = r2[j];
}

concat(rl, r, l, 32, 32);

permute(out, rl, perm6, 64);
}

static void str_to_key(unsigned char *str,unsigned char *key)
{
int i;

key[0] = str[0]>>1;
key[1] = ((str[0]&0x01)<<6) | (str[1]>>2);
key[2] = ((str[1]&0x03)<<5) | (str[2]>>3);
key[3] = ((str[2]&0x07)<<4) | (str[3]>>4);
key[4] = ((str[3]&0x0F)<<3) | (str[4]>>5);
key[5] = ((str[4]&0x1F)<<2) | (str[5]>>6);
key[6] = ((str[5]&0x3F)<<1) | (str[6]>>7);
key[7] = str[6]&0x7F;
for (i=0;i<8;i++) {
key = (key<<1);
}
}


static void smbhash(unsigned char *out, unsigned char *in, unsigned char *key, int forw)
{
int i;
char outb[64];
char inb[64];
char keyb[64];
unsigned char key2[8];

str_to_key(key, key2);

for (i=0;i<64;i++) {
inb = (in[i/8] & (1<<(7-(i%8)))) ? 1 : 0;
keyb = (key2[i/8] & (1<<(7-(i%8)))) ? 1 : 0;
outb = 0;
}

dohash(outb, inb, keyb, forw);

for (i=0;i<8;i++) {
out = 0;
}

for (i=0;i<64;i++) {
if (outb)
out[i/8] |= (1<<(7-(i%8)));
}
}

void E_P16(unsigned char *p14,unsigned char *p16)
{
unsigned char sp8[8] = {0x4b, 0x47, 0x53, 0x21, 0x40, 0x23, 0x24, 0x25};
smbhash(p16, sp8, p14, 1);
smbhash(p16+8, sp8, p14+7, 1);
}

void E_P24(unsigned char *p21, unsigned char *c8, unsigned char *p24)
{
smbhash(p24, c8, p21, 1);
smbhash(p24+8, c8, p21+7, 1);
smbhash(p24+16, c8, p21+14, 1);
}

void D_P16(unsigned char *p14, unsigned char *in, unsigned char *out)
{
smbhash(out, in, p14, 0);
smbhash(out+8, in+8, p14+7, 0);
}

void E_old_pw_hash( unsigned char *p14, unsigned char *in, unsigned char *out)
{
smbhash(out, in, p14, 1);
smbhash(out+8, in+8, p14+7, 1);
}

void cred_hash1(unsigned char *out,unsigned char *in,unsigned char *key)
{
unsigned char buf[8];

smbhash(buf, in, key, 1);
smbhash(out, buf, key+9, 1);
}

void cred_hash2(unsigned char *out,unsigned char *in,unsigned char *key)
{
unsigned char buf[8];
static unsigned char key2[8];

smbhash(buf, in, key, 1);
key2[0] = key[7];
smbhash(out, buf, key2, 1);
}

void cred_hash3(unsigned char *out,unsigned char *in,unsigned char *key, int forw)
{
static unsigned char key2[8];

smbhash(out, in, key, forw);
key2[0] = key[7];
smbhash(out + 8, in + 8, key2, forw);
}

void SamOEMhash( unsigned char *data, unsigned char *key, int val)
{
unsigned char s_box[256];
unsigned char index_i = 0;
unsigned char index_j = 0;
unsigned char j = 0;
int ind;

for (ind = 0; ind < 256; ind++)
{
s_box[ind] = (unsigned char)ind;
}

for( ind = 0; ind < 256; ind++)
{
unsigned char tc;

j += (s_box[ind] + key[ind%16]);

tc = s_box[ind];
s_box[ind] = s_box[j];
s_box[j] = tc;
}
for( ind = 0; ind < (val ? 516 : 16); ind++)
{
unsigned char tc;
unsigned char t;

index_i++;
index_j += s_box[index_i];

tc = s_box[index_i];
s_box[index_i] = s_box[index_j];
s_box[index_j] = tc;

t = s_box[index_i] + s_box[index_j];
data[ind] = data[ind] ^ s_box[t];
}
}

思考中、、、

这里除了付值就是循环,等我下周修改好！

是的，没有定义很复杂的结构类型，也没有调用API，所以从转换的角度看可能不太难，不过
由于它是一个算法，有一点点转换错误，程序能正常运行，不过结果肯定不对了。

做成DLL再调用不是简单方便吗？

行行好拉，vcl.vclxx.or上面大把这种控件

MD4 DES 都是极经典的算法，网上很多源码，你去搜索来看看吧！

我不需要控件！如果要控件的话，我有一个cipher，什么加密方式都有。
我要的是上面两个C程序的DELPHI写法。

是Pascal或者Delphi写的源码！最差也有DLL！
如果你不是打算做加密算法大师的话，建议不要去死扣这些，了解大概原理即可！
闻道有先后，术业有专攻。把精力花在更值更容易出成绩的地方！

我并不是要研究加密方法。只是在做一个控件，里面涉及到了MD4和DES加密。如果在做的
控件中去使用另外一个控件，这样很不独立。

自己转一下好了，我不相信你不会，干嘛指望别人帮你打下手呢？

如果转换很顺利，也不会叫大家帮忙了。C放下有好些时候了。另外，怎么叫“打下手”呢？
我看大富翁上好多人都喜欢贴人家的代码，能做实事的有多少呢？不过贴代码也是好事，
帮了别人的忙了。而现在有一个动手的机会，每个人又说，到那里去找一找，或什么的。
可能有些人不屑一顾，可如果自己动手去做的时候，肯定不会很顺利的。

说的好，但是实践起来可能会有问题了。要转换的话，是有很大难度的，不过你完全可以
按新的来做呀。

抄了段DES，希望有所启发。

{Newsgroups: comp.lang.pascal
From: Menno Victor van der Star <s795238@dutiws.twi.tudelft.nl>
Subject: Re: DES source in Pascal
Organization: Delft University of Technology
Date: Tue, 18 Apr 1995 10:38:58 GMT


Source for doing DES encryption/decryption in Pascal.

This procedure uses 4 parameters :

Input : 8 byte (64 bit) input
Output : 8 byte (64 bit) output from DES algorithm
Key : 8 byte (64 bit) key for DES algorithm
Encrypt : True to encrypt, False to decrypt

The procedure uses typeless parameters so you can use variables of
any type for Input, Output and the Key, as long as they are 8 bytes
long (or more).


Delft, 18 april 1995
s795238@dutiws.twi.tudelft.nl
}
unit Desunit;

interface


procedure DDES(source,Destinate,Keyointer;count:word;En:boolean);

procedure Mydes(var input:string;var output:string;var key:string;
Encrypt:Boolean);
Procedure DES (Var Input; Var Output; Var Key; Encrypt : Boolean);
{Procedure DDES(source,Destinate,Keyointer;count:word;En:boolean);}

function HexToInt(Tstr:string):longint; //十六进制转十进制
function Toint(Tstr:char) :integer;
function ToHex(num:integer):string;
function Addspac(ch:string;Tlens:integer ; Tflag:integer):string;
function getserial(loginid:string;serverid:integer):string;
function getdata(ch:string;var UserId,ServerId:string):boolean ;


implementation
uses SysUtils ;

procedure Mydes(var input:string;var output:string; var key:string;
Encrypt:Boolean);
var a1,a2:array[0..8] of char;
var j,i,l:integer;
var mykey:array[0..7] of char;
begin
output:='';
i:=length(input) mod 8 ;
if i > 0 then for j:=1 to 8-i do input:=input+' ';
l:=length(input) div 8;
strPLcopy(mykey,key,8);
for i:=1 to l do
begin
strplcopy(a1,copy(input,8*(i-1)+1,8),8);
Des(a1,a2,mykey,Encrypt);
output:=output+copy(strpas(a2),1,8);
end;
end;

Procedure DES (Var Input; Var Output; var Key; Encrypt : Boolean);

Const
IP : Array [1..64] Of Byte = (58,50,42,34,26,18,10,2,
60,52,44,36,28,20,12,4,
62,54,46,38,30,22,14,6,
64,56,48,40,32,24,16,8,
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);
InvIP : Array [1..64] Of Byte = (40, 8,48,16,56,24,64,32,
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);
E : Array [1..48] Of Byte = (32, 1, 2, 3, 4, 5,
4, 5, 6, 7, 8, 9,
8, 9,10,11,12,13,
12,13,14,15,16,17,
16,17,18,19,20,21,
20,21,22,23,24,25,
24,25,26,27,28,29,
28,29,30,31,32, 1);
P : Array [1..32] Of Byte = (16, 7,20,21,
29,12,28,17,
1,15,23,26,
5,18,31,10,
2, 8,24,14,
32,27, 3, 9,
19,13,30, 6,
22,11, 4,25);
SBoxes : Array [1..8,0..3,0..15] 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,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)));

PC_1 : Array [1..56] Of Byte = (57,49,41,33,25,17, 9,
1,58,50,42,34,26,18,
10, 2,59,51,43,35,27,
19,11, 3,60,52,44,36,
63,55,47,39,31,23,15,
7,62,54,46,38,30,22,
14, 6,61,53,45,37,29,
21,13, 5,28,20,12, 4);

PC_2 : Array [1..48] Of Byte = (14,17,11,24, 1, 5,
3,28,15, 6,21,10,
23,19,12, 4,26, 8,
16, 7,27,20,13, 2,
41,52,31,37,47,55,
30,40,51,45,33,48,
44,49,39,56,34,53,
46,42,50,36,29,32);

ShiftTable : Array [1..16] Of Byte = (1,1,2,2,2,2,2,2,1,2,2,2,2,2,2,1);

Var
InputValue : Array [1..64] Of Byte;
OutputValue : Array [1..64] Of Byte;
RoundKeys : Array [1..16,1..48] Of Byte;
L, R, FunctionResult : Array [1..32] Of Byte;
C, D : Array [1..28] Of Byte;

Function GetBit (Var Data; Index : Byte) : Byte;

Var
Bits : Array [0..7] Of Byte ABSOLUTE Data;

Begin
Dec (Index);
If Bits[Index DIV 8] And (128 SHR (Index MOD 8))>0 then GetBit:=1 Else GetBit:=0;
End;{GetBit}

Procedure SetBit (Var Data; Index, Value : Byte);

Var
Bits : Array [0..7] Of Byte ABSOLUTE Data;
Bit : Byte;

Begin
Dec (Index);
Bit:=128 SHR (Index MOD 8);
Case Value Of
0 : Bits[Index DIV 8]:=Bits[Index DIV 8] And (Not Bit);
1 : Bits[Index DIV 8]:=Bits[Index DIV 8] Or Bit;
End;
End;{SetBit}

Procedure F (Var FR, FK, Output);

Var
R : Array [1..48] Of Byte ABSOLUTE FR;
K : Array [1..48] Of Byte ABSOLUTE FK;
Temp1 : Array [1..48] Of Byte;
Temp2 : Array [1..32] Of Byte;
n, h, i, j, Row, Column : Integer;
TotalOut : Array [1..32] Of Byte ABSOLUTE Output;

Begin
For n:=1 to 48 Do Temp1[n]:=R[E[n]] Xor K[n];
For n:=1 to 8 Do Begin
i:=(n-1)*6;
j:=(n-1)*4;
Row:=Temp1[i+1]*2+Temp1[i+6];
Column:=Temp1[i+2]*8 + Temp1[i+3]*4 + Temp1[i+4]*2 + Temp1[i+5];
For h:=1 to 4 Do Begin
Case h Of
1 : Temp2[j+h]:=(SBoxes[n,Row,Column] And 8) DIV 8;
2 : Temp2[j+h]:=(SBoxes[n,Row,Column] And 4) DIV 4;
3 : Temp2[j+h]:=(SBoxes[n,Row,Column] And 2) DIV 2;
4 : Temp2[j+h]:=(SBoxes[n,Row,Column] And 1);
End;
End;
End;
For n:=1 to 32 Do TotalOut[n]:=Temp2[P[n]];
End;{F}

Procedure Shift (Var SubKeyPart);

Var
SKP : Array [1..28] Of Byte ABSOLUTE SubKeyPart;
n, b : Byte;

Begin
b:=SKP[1];
For n:=1 to 27 Do SKP[n]:=SKP[n+1];
SKP[28]:=b;
End;{Shift}

Procedure SubKey (Round : Byte; Var SubKey);

Var
SK : Array [1..48] Of Byte ABSOLUTE SubKey;
n, b : Byte;

Begin
For n:=1 to ShiftTable[Round] Do Begin
Shift (C);
Shift (D);
End;
For n:=1 to 48 Do Begin
b:=PC_2[n];
If b<=28 then SK[n]:=C Else SK[n]:=D[b-28];
End;
End;{SubKey}

Var
n, i, b, Round : Byte;
Outputje : Array [1..64] Of Byte;
K : Array [1..48] Of Byte;
fi : Text;

Begin
For n:=1 to 64 Do InputValue[n]:=GetBit (Input,n);
For n:=1 to 28 Do Begin
C[n]:=GetBit(Key,PC_1[n]);
D[n]:=GetBit(Key,PC_1[n+28]);
End;
For n:=1 to 16 Do SubKey (n,RoundKeys[n]);
For n:=1 to 64 Do If n<=32 then L[n]:=InputValue[IP[n]] Else R[n-32]:=InputValue[IP[n]];
For Round:=1 to 16 Do Begin
If Encrypt then
F (R,RoundKeys[Round],FunctionResult)
Else
F (R,RoundKeys[17-Round],FunctionResult);
For n:=1 to 32 Do FunctionResult[n]:=FunctionResult[n] Xor L[n];
L:=R;
R:=FunctionResult;
End;
For n:=1 to 64 Do Begin
b:=InvIP[n];
If b<=32 then OutputValue[n]:=R Else OutputValue[n]:=L[b-32];
End;
For n:=1 to 64 Do SetBit (Output,n,OutputValue[n]);
End;

procedure DDES(source,Destinate,Keyointer;count:word;En:boolean);
var
a,b:array[0..7] of byte;
begin
while (count>8) do
begin
des(source^,destinate^,key^,en);
inc(longint(source),8);
inc(longint(destinate),8);
dec(count,8);
end;
if count>0 then
begin
move(source^,a,count);
des(a,b,key^,en);
move(b,destinate^,count);
end;
end;

function getserial(loginid:string;serverid:integer):string;
var s1,s2,key:array [0..7] of char;
var flag:boolean;
var i:integer;
var svr:array [0..1] of char ;
var t1:string;

BEGIN
result:='';
Flag:=True;
strpcopy(key,'handsome');
t1:=inttohex(serverid,4);
svr[0]:=chr(hextoint(copy(t1,1,2)));
svr[1]:=chr(hextoint(copy(t1,3,2)));
t1:=addspac(loginid,6,1)+strpas(svr);
strplcopy(s1,t1,8);
s1[6]:=svr[0];
s1[7]:=svr[1];
des(s1,s2,key,Flag);
for i:=0 to 7 do
begin
t1:=IntTohex(Ord(s2),2);
if length(t1)=1 then t1:='0'+t1;
result:=result+t1;
end ;
end;
//*************************************************************
function getdata(ch:string;var UserId,ServerId:string):boolean;
var s1,s2,Key:array[0..8] of char;
var i:integer;
var t1:string;
var flag:Boolean;
begin
userId:='';
serverId:='';
if length(ch)<>16 then
ch:=addspac(ch,16,1);
for i:=0 to 7 do
begin
t1:=copy(ch,2*i+1,2);
s1:=chr(hextoint(t1));
end;
strpcopy(key,'handsome');
flag:=False;
des(s1,s2,key,flag);
t1:=strpas(s2);
userId:=copy(s2,1,6);
serverId:=inttostr(ord(s2[6])*256+ord(s2[7]));
if strtoint(serverId) mod 4 =2 then result:=true
else result:=False;
end;
//*********************************************************
function HexToInt(Tstr:string):longint; //十六进制转十进制
var i,Tlen :integer;
p1:array [0..1] of char;
begin
result:=0;
Tstr:=trim(Tstr);
tlen:=length(Tstr);
for i:=1 to tlen do
begin
StrPcopy(p1,copy(Tstr,i,1));
result:=result*16+Toint(p1[0]);
end
end;

//********************************************************************
function ToHex(num:integer):string;
begin
if num <=9 then begin
result:=inttostr(num);
exit;
end;
case num of
10: result:='A';
11: result:='B';
12: result:='C';
13: result:='D';
14: result:='E';
15: result:='F';
else
result:='0';
end;
end;
//***********************************************
function Toint(Tstr:char) :integer;
begin
if ord((tstr)) >=65 then result:=10+ord(Tstr)-65
else result:=ord(Tstr)-48;
end;
//**********************************************************************
function Addspac(ch:string;Tlens:integer ; Tflag:integer):string;
var j,n:integer;
var spac:string;
begin
result:=ch;
spac:='';
n:=length(ch);
for j:=1 to (Tlens-n) do spac:=' '+spac;
if Tflag=0 then result:=spac+result;
if Tflag=1 then result:=result+spac;
end;
//***********************************************************************

end.

没必要这么复杂吧，到网上找一找 CHIPHER 控件，找不到的话告诉我邮箱，里面有源码。

to tseug:
我下了一个Chipher,但不能编译，给我一个 cnkk163@163.com