function KUser(Str: String;Num1,Num2,Num3: Integer): String;
var
I,L: Byte;
Num: Integer;
begin
Result := '';
Num := Num1;
L := Length(Str);
for I := 1 to L do
begin
Result := Result + Char(Ord(Str[I]) xor ((Num shr 8) and $FF));
Num := Num + Ord(Result[I]);
Num := Num * Num2 + Num3;
end;
end;
function KCode(Str: String;Num1,Num2,Num3: Integer): String;
var
I,L: Byte;
Num: Integer;
begin
Result := '';
Num := Num1;
L := Length(Str);
for I := 1 to L do
begin
Result := Result + Char(Ord(Str[I]) xor ((Num shr 8) and $FF));
Num := Num + Ord(Str[I]);
Num := Num * Num2 + Num3;
end;
end;
function KCode1(Str: String): String;
var
L,I: Integer;
B0,B1,B2,B3: Byte;
begin
Result := '';
L := Length(Str) shr 1;
for I := 0 to L - 1 do
begin
B0 := Ord(Str[I * 2 + 1]);
B1 := Ord(Str[I * 2 + 2]);
B2 := B1 and $4F;//0100-1111
B3 := (B1 and $30) shr 4;
if B1 and $40 = 0 then
begin
B0 := 0;
end
else
begin
if B2 < $43 then
begin
B2 := $43 - B2;
B0 := (B0 shl B2) or B3;
end
else
begin
if B2 > $43 then
begin
B2 := B2 - $43;
B0 := B0 shr B2;
end;
end;
end;
Result := Result + Char(B0);
end;
end;
function UserCode(StrCode: String;Num1,Num2,Num3: Integer): String;
var
Str: String;
begin
Str := KCode1(StrCode);
Result := KCode(Str,Num1,Num2,Num3);
end;
function UserUser(StrId,StrUser: String;Num1,Num2,Num3: Integer): String;
var
Str: String;
L,Pad: Integer;
LastCh,PadCh,Sign: Byte;
begin
Str := StrUser + StrId;
L := Length(Str);
if L = 0 then
begin
Result := '';
Exit;
end;
if L > 18 then
begin
PadCh := Ord(Str[18]);
Pad := L - $14;
Sign := $14;
while Pad > 0 do
begin
LastCh := Ord(Str[Sign]);
if PadCh > LastCh then
begin
PadCh := PadCh - LastCh;
end
else
begin
PadCh := LastCh - PadCh;
end;
Inc(Sign);
Dec(Pad);
end;
SetLength(Str,18);
if PadCh = 0 then
begin
PadCh := $FF;
end;
Insert(Char(PadCh),Str,1);
end
else
begin
PadCh := Ord(Str[L]);
LastCh := PadCh;
if L < 18 then
begin
if PadCh > $7F then
begin
Sign := $FF;
end
else
begin
Sign := 1;
end;
Pad := 18 - L;
while Pad > 0 do
begin
PadCh := PadCh + Sign;
Insert(Char(PadCh),Str,1);
Dec(Pad);
end;
end;
Insert(Char(LastCh),Str,1);
end;
if L > $FF then
begin
L := $FF;
end;
Insert(Char(L),Str,2);
Result := KUser(Str,Num1,Num2,Num3);
end;
function GetShift1(I: Integer): Byte;
var
c: Byte;
begin
c := 0;
i := i and $FF;
repeat
Inc(c);
i := i shr 1;//
until i < $7F;//6x
Result := c;
end;
function GetFake2(I: Integer): Byte;
var
c: Byte;
begin
c := 0;
i := i and $FF;
repeat
Inc(c);
i := i shl 1;
until i > $20;
Result := c;
end;
function GetMask(Shift: Integer): Integer;
begin
Result := $0;
while Shift > 0 do
begin
Result := (Result shl 1) or 1;
Dec(Shift);
end;
end;
function GetHD(): String;
var
Serial: DWORD;
MaximumComponentLength: DWORD;
FileSystemFlags: DWORD;
Str: String;
I,L: Integer;
ch: Char;
begin
GetVolumeInformation('C:\',nil,0,@Serial,MaximumComponentLength,FileSystemFlags,nil,0);
Str := Format('%x',[Serial]);
Result := '';
L := Length(Str);
for I := L downto 1 do
begin
Ch := Str[I];
if Not(Ch in ['9','Z']) then
Ch := Char(Ord(Ch) + 1);
Result := Result + Ch;
end;
end;
//一下是对应函数的反函数
function DKCode1(Str: String): String;
var
L,I: Integer;
B0,B1,B2,B3: Byte;
begin
Result := '';
L := Length(Str);
for I := 1 to L do
begin
B0 := Ord(Str[I]);
if B0 = 0 then
begin
B0 := Random(26) + $41;//
B1 := Random(10) + $30;//30-39//防止特殊字符出现, 正常范围还可以包含特殊字符
end
else
begin
if B0 in[$21..$7E] then
begin
B1 := $43;//B1 := $63;//也可以
end
else
begin
if B0 > $7E then
begin
B2 := GetShift1(B0);
if B2 = 2 then
begin
B2 := 3;
end;
B3 := B0 and GetMask(B2);
B0 := B0 shr B2;
B1 := ($43 - B2) or (B3 shl 4);
end
else
begin
B2 := GetFake2(B0);
B0 := B0 shl B2;
B1 := $43 + B2;
end;
// B2=40,则B0=xxxx x000
// B2=41,则B0=xxxx xx00
// B2=42,则B0=xxxx xxx0
// B2=43,则B0=任意可见字符
// B2=44,则B0=0xxx xxxx
// B2=45,则B0=00xx xxxx
// B2=46,则B0=000x xxxx
// B2=47,则B0=0000 xxxx
// B2=48,则B0=0000 0xxx
// B2=49,则B0=0000 00xx
// B2=4A,则B0=0000 000x
// B2=4B以上,则B0=0;
end;
end;
Result := Result + Char(B0) + Char(B1);
end;
end;
function DKCode(Str: String;Num1,Num2,Num3: Integer): String;
var
I,L: Byte;
Num: Integer;
begin
Result := '';
Num := Num1;
L := Length(Str);
for I := 1 to L do
begin
Result := Result + Char(Ord(Str[I]) xor ((Num shr 8) and $FF));
Num := Num + Ord(Str[I]);
Num := Num * Num2 + Num3;
end;
end;
function DUserCode(StrUser: String): String;
var
Str: String;
begin
Str := KUser(StrUser,982,12675,35892);
Result := DKCode1(Str);
end;
function Serial(StrId, StrUser: String): String;
begin
Result := DUserCode(UserUser(StrId,StrUser,982,12675,35892));
end;
