//freeRes 0.94注册算法

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;

//入口函数是Serial