Arsip: Membuat sendiri UDF library bag.2

/
  Copyright 2007,2008 aa, Adrian H. and Ray AF.
  Private property of PT Softindo JAKARTA
  All rights reserved.
  last rev. 2008.05.26
 /
A use of natural integer number
-------------------------------
C family language does not handle string as well as Pascal did
with her string type. actually all string operations in c will be
felt-down when encounter 0, an ASCIIZ string in Pascal is not as
important as it did in C, although recognized (as in Delphi and fpc),
Pascal doesn't give a damn about what the content of string since
she has already have the length of the string in string header.
since the 0 (null) denoted as end of asciiz string, this will lead
to us the rule#1:
  the asciiz string must not contains a 0 (null) character
note.
  although the concept will also work with 2 or 4 byte character
  we will assume that the string in this article is an asciiz
  string of 1 byte character for easy understanding.
in database-centric applications (which almost certainly
written in C) we could only pass the decimal representation as
a non-null string, most often with conversion first from an
integer to string, which means an overfluous call to another
slow  C string handling routines.
note:
  the term slow is compared to pascal's string routines.
  don't be amazed by this fact, we'll give you an overview:
  to get the length of string (the most primitive and most often
  called string function) in Pascal, is a blatantly mere simple
  stupid plain instruction: mov eax,[S-4] (or as such in other
  platform other than intel's), while in C by strlen, you must
  scan the whole string from the beginning of pointer 'till
  the end, until it found null (and still, consequently, that's
  only works with asciiz string, not an arbitrary bytes stream
  as it does in pascal).
  of course, we talk only of bult-in support by the language, as
  a matter of fact, either dancing with Pascal or laboured by C,
  you can do anything as you could imagine.
so how to embed an integer type number into an asciiz string?
as promulgated by the rule#1above, we have to make sure that
every single character within the integer we wish to embed into
an asciiz string is not a null character. if a character is
1-byte wide, then all of bytes of integer must not be 0.
the  most easy way to implement (against each bytes of integer
storage) is to:
  1. always set the highest bit, and
  2. use the remaining bits for number
this means we could only used half of maximum capacity per character
(as it did back to '80 era), the obvious shortage will be exponentially
increased by the size of integer type we use.
------------------------------------------------------
type	length	max-capacity	stripped	ratio
------------------------------------------------------
byte	1	256^1 = 256	128^1 = 128	1:2
word	2	256^2 = 65536	128^2 = 16384	1:4
integer	4	256^4 = 4G	128^4 = 256M	1:16
bigint	8	256^8 = 16E	128^8 = 64P	1:256
------------------------------------------------------
note:
  64P =    72057594037927936
  16E = 18446744073709551616
but then there's another way, or more properly said, is the general
concept of natural number reformulation of integer stated as:
  for every single element of integer as a representation of
  character for the null-terminated-string:
    apply different exponential base number (base), and then
    normalize/reorder/recompose, so it will not be represented
    as a null-character
  - the highest base is at most 1-less of maximum capacity of character
  - the lowest base is 2 (equal with binary number)
(in the previous example, we actually choose 128 as different base
for number, and set the highest bit to normalize it).
the most space efficient is the highest different base allowed (255
for 1-byte wide character, 65535 for 2-byte wide, and so on), this might
or might not be desirable (for example you'd better pick an even number
for the new base, a perfect square of 2 is the best, since it is cheap
and much easier to maintain, but if you do need all the space you can get,
you will pick the highest allowed value instead).
note:
  it's a classic dilema of price (of space) vs. performace, when using
  perfect 2 fold you can substitute a costly div/mod instruction with
  much cheaper shift instruction.
Capacity loss = (C ^ N) - (C' ^ N)
where:
   ^  = power
   C  = original capacity of character (eg. 256 for byte)
   C' = capacity of character after rebase
   N  = number of characters in integer-type (eg. 4 for type
          long/cardinal in bytes)
comparison of different base number capacity
------------------------------------------------------------------------------
type	size	2	4	8	16	32	64	96	128
------------------------------------------------------------------------------
byte	1	2	4	8	16	32	64	96	128
word	2	4	16	64	256	1024	4096	9216	16384
integer	4	16	256	4096	65536	1M	16M	81M	256M
bigint	8	256	65536	16M	4G	1T	256T	6.4P	64P
------------------------------------------------------------------------------
comparison of different base number capacity (continued), next 16 fold
------------------------------------------------------------------------------
type	size	144	160	176	192	208	224	240	256
------------------------------------------------------------------------------
byte	1	144	160	176	192	208	224	240	256
word	2	20736	25600	30976	36864	43264	50176	57600	65536
integer	4	410M	625M	915M	1.27G	1.74G	2.34G	3.09G	4G
bigint	8	164P	380P	817.7P	1.6E	3.04E	5.4E	9.55E	16E
------------------------------------------------------------------------------
comparison of different base number capacity (continued), esoterics
------------------------------------------------------------------------------
type	size	50	100	120	140	180	200	250	255
------------------------------------------------------------------------------
byte	1	50	100	120	140	180	200	250	255
word	2	2500	10000	14400	19600	32400	40000	62500	65025
integer	4	5.96M	95.24M	197.75M	366.36M	1.001G	1.49G	3.64G	3.94G
bigint	8	35.53T	8.88P	38.19P	131.08P	978.77P	2.22E	13.23E	15.5E
------------------------------------------------------------------------------
note:
  Kilo = 1024
  Mega = 1024  1024 = 1024^2 = 1048576
  Giga = 1024 3 =            1073741824
  Tera = 1024^4 =         1099511627776
  Peta = 1024^5 =      1125899906842624
  Exa  = 1024^6 =   1152921504606846976
  zeta,yota
reminder...
  64P = 65536.T =     72057594037927936
  16E = 16384.P =  18446744073709551616
physical storage of (intel's little-endian) integer compared to
non-zero integer number base 128 (before normalized):
-------------------------------------------------------------------------
byte	#0#1#2#3		beforenormalized	highest bit set )
------------------------------------------------------------------------
0	  0   0   0   0		  0   0   0   0		 -   -   -   -
128	128   0   0   0           0   1   0   0		 -  129  -   -
256	  0   1   0   0           0   2   0   0		 -  130  -   -
32768	  0 128   0   0           0   0   1   0		 -   -  129  -
65536	  0   0   1   0           0   0   4   0		 -   -  132  -
------------------------------------------------------------------------
note:  ) all - (DASH) marks means 128, for the sake of readability
physical storage of (intel's little-endian) integer compared to
non-zero integer number base 255 (before normalized):
------------------------------------------------------------------------
byte	#0#1#2#3		beforenormalized	method: add +1 )
------------------------------------------------------------------------
0	  0   0   0   0		  0   0   0   0		 -   -   -   -
255	255   0   0   0           0   1   0   0		 -   2   -   -
256	  0   1   0   0           1   1   0   0		 2   2   -   -
65025	  1 254   0   0           0   0   1   0		 -   -   2   -
65536	  0   0   1   0           1   2   1   0		 2   3   2   -
------------------------------------------------------------------------
note:  ) all - (DASH) marks means 1, for the sake of readability
...
handling negative value:
  when we say about integer here, that means a POSITIVE number,
  negative integer is nothing more than a half truncated integer
  capacity with the highest bit (in the highest char) set.
  if you intend to use negative value then you'll have to manually
  extend the sign when the highest bit (in the highest byte) is
  set, fortunately this only happen if you pick base below the
  half of maximum capacity (which questionably chosen) as for
  base value equal or greater than half maximum, the sign bit
  will be automatically carried within normalized value.
{ code: }
{ 1. sample code }
function DivMod(const Dividend: cardinal;
  const Divisor: byte; var Reminder: byte): cardinal;
begin
  Result := Dividend div Divisor;
  Reminder := Dividend mod Divisor;
end;
function inttoNZN(I: cardinal; const base: byte = high(byte)): cardinal;
const
  ByteOnes = $01010101;
type
  tInt4Chars = packed record
    ch0, ch1, ch2, ch3: byte;
  end;
begin
  Result := 0;
  I := divMod(I, base, tInt4Chars(Result).ch0);
  if I > 0 then
    I := divMod(I, base, tInt4Chars(Result).ch1);
  if I > 0 then
    tInt4Chars(Result).ch3 := divMod(I, base, tInt4Chars(Result).ch2);
  Result := Result + ByteOnes; // normalize
end;
{ as could bee seen in this code, replacing exponent base }
{ with constant number will help performance a LOT        )
function NZNtoInt(NZN: cardinal; const base: byte = high(byte)): cardinal;
const
  ByteOnes = $01010101;
type
  tInt4Chars = packed record
    ch0, ch1, ch2, ch3: byte;
  end;
begin
  Result := NZN - ByteOnes;
  if Result > 0 then
    Result :=
      tInt4Chars(Result).ch3  base   base  base +
      tInt4Chars(Result).ch2   base  base +
      tInt4Chars(Result).ch1   base +
      tInt4Chars(Result).ch0
end;
{ 2. optimized sample code                                        }
{ note:                                                           }
{  we have to avoid using expensive div/mod as could as possible. }
{  the code below although longer, should be faster than above    }
{  (out of branch mis-prediction penalty).                        }
function inttoNZN2(I: cardinal; const base: byte =  high(byte)): cardinal;
const
  ByteOnes = $01010101;
type
  tInt4Chars = packed record
    ch0, ch1, ch2, ch3: byte;
  end;
  function proci(var b0, b1: byte): cardinal;
  begin
    Result := I;
    if Result <= base then begin
      if Result < base then
        b0 := Result
      else
        b1 := 1;
      Result := 0;
    end
    else begin
      Result := divMod(Result, base, b0);
      if Result < base then begin
        b1 := Result;
        Result := 0;
      end;
      I := Result;
    end;
  end;
begin
  Result := 0;
  if proci(tInt4Chars(Result).ch0, tInt4Chars(Result).ch1) >= base then
    if proci(tInt4Chars(Result).ch1, tInt4Chars(Result).ch2) >= base then
      proci(tInt4Chars(Result).ch2, tInt4Chars(Result).ch3);
  Result := Result + ByteOnes;
end;
{ 3. asm optimized sample code                                }
{ when you got an urge for speed, then asm is the only choice }
function asmInttoNZN(const I: cardinal; const base: byte): integer;
const AllOnes = $01010101;
asm
  test eax, not 0ffh; jnz @@0
  add eax,AllOnes; ret;
@@0: movzx ecx,dl; //sanitize
  //cmp eax,ecx; ja @@1
  //sbb edx,edx; and eax,edx
  //sete ah; add eax,AllOnes; ret;
;@@1: xor edx,edx; push edx; // Result
  div ecx; mov [esp],dl;
  cmp eax,ecx; ja @@2
  sbb edx,edx; and eax,edx
  sete dl;
  mov [esp+1],al; mov [esp+2],dl;
  jmp @@normalize
@@2: xor edx,edx; div ecx;
  mov [esp+1],dl;
  cmp eax,ecx; ja @@3
  sbb edx,edx; and eax,edx
  sete ah; mov [esp+2],ax;
  jmp @@normalize
@@3: xor edx,edx; div ecx;
  mov [esp+2],dl; mov [esp+3],al;
@@normalize:
  pop eax; add eax,AllOnes;
end;
function asmNZNtoInt(const NZN: cardinal; const base: byte): integer; overload;
const AllOnes = $01010101;
asm
  sub eax,AllOnes;
  jnz @@0; ret
@@0:
  push ebx; push eax;
  movzx ebx,al; movzx ecx,dl;
  test ah,ah; jz @@1;
  movzx eax,ah; mul ecx;
  add ebx,eax;
@@1:
  movzx eax,[esp+2];
  test eax,eax; jz @@2
  push eax;
  mov eax,ecx; mul ecx;
  pop edx; mul edx;
  add ebx,eax;
@@2:
  movzx eax,[esp+3];
  test eax,eax; jz @@3
  push eax;
  mov eax,ecx; mul ecx; mul ecx;
  pop edx; mul edx;
  add ebx,eax
@@3:
  pop eax; mov eax,ebx;
  pop ebx;
end;
function asmDivMod(const Dividend: cardinal;
  const Divisor: byte; var Reminder: byte): cardinal;
asm
  push ecx; movzx ecx,dl; 
  xor edx,edx; div ecx;
  pop ecx; mov [ecx],dl;
end;
function mod255(const I: cardinal): byte;
asm
  movzx edx,al; movzx ecx,ah
  bswap eax
  add ecx,edx; movzx edx,ah
  movzx eax,al; add edx,ecx
  add eax,edx;
  add al,ah; xor ah,ah;
end;
{ when base is constant = 255, we could replace mul with cheaper shift/sub }
function asmNZNtoInt(const NZN: cardinal): integer; overload; // base = 255
// the 2nd byte need to be multiplied by 255 or (100h - 1)
// the 3rd byte need to be multiplied by 255  255 or (100h - 1)   (100h - 1)
// the 4rd byte need to be multiplied by 255^3 or (100h - 1)^3
// and so on.. for integer more than 4 bytes wide
const AllOnes = $01010101;
const m0 = 0; m1 = $FF; m2 = $FE01; m3 = $00FD02FF;
const m1neg = 1;
const m2neg = $01FF; //  // = 200 - 1
const m3neg = $0002FD01; // = 30000 - 2FF = 30000 - (300 - 1)
                         //               = 30000 - 300 + 1
                         //               = 3  (10000 - 100) + 1
                         //               = 3   100  (100 - 1) + 1
asm
{ the branch prediction failure's penalty is absurdly high }
{ we'd better let all inst. pass rather than jcc           }
  sub eax,AllOnes; //jnz @@begin; ret
  //test eax, not $ff; jnz @@begin; ret
;@@begin:
  push ebx; mov ebx,eax;
  movzx edx,ah; sub ebx,edx;
  shr eax,16; jz @@end
  movzx ecx,al; movzx edx,al;
  shl ecx,8+1; sub ecx,edx;
  sub ebx,ecx;
  and eax,not 0ffh; jz @@end;
  mov ecx,eax; movzx edx,ah;
  shl ecx,8; sub ebx,edx;
  sub ecx,eax; mov eax,ecx;
  add ecx,ecx; add ecx,eax;
  sub ebx,ecx;
@@end: mov eax,ebx; pop ebx;
end;
EOF.

unit dbzCrypt;
{$WEAKPACKAGEUNIT ON}
{
  Copyright (c) 2004, aa, Adrian H. & Inge DR.
  Property of PT SOFTINDO Jakarta.
  All rights reserved.
  mailto:aa|AT|softindo|DOT|net,
  http://delphi.softindo.net
  Version: 1.0.0.000
  Dated: 2005.01.01
  LastRev: 2007.01.01
  LastRev: 2008.05.01 - using new algorithm ID capacity now upto 16581375 (~16M)
}
{
indexed Nonzero encrypt. include additional index infomation
in the encrypted string. need additional 4 bytes as index
(encrypted string will be 4 characters longer than original)
useful to retain field index/order
note:
  since index will be hi-stripped, 3 bytes wide, then max. value
  of index is: 128 128128-1 = 2097151 (roughly 2 million) --obsolete
  should be enough for most of database                    --obsolete
  (it could be up to 268435455 if you're not using random salt-key)
+ 2007.0.0: (untested!) added NZidEncrypt64/NZidDecrypt64 #deprecated
            to overcome 2M limitation as noticed above.   #deprecated
-------------------------------------------------------------------------
  2008.05.01: implementation of natural (non-zero positive) integer number
              (see artcle attached)
              now max.ID (3 bytes) capacity upto: 255255 255 = 16,581,375
              and thus CRID64 NZidEncrypt64/NZidDecrypt64 is deprecated,
              i think 16M just quite enough, i'm not planning to index for
              monster database as google or wiki's
}
interface
type
  THexString = string; //mod32's string xor32
function XOR32(const S: string): string;
function XOR32encrypt(const Str: string): THexString; // encrypt TO hexStr
function XOR32decrypt(const HexStr: THexString): string; // decrypt FROM hexStr
// encrypt S without containing#0in the result, useful for pchar
// or database string field which does not accept#0within string
function NZDecrypt(const S: string): string;
function NZEncrypt(const S: string): string;
function NZDecryptOfHexStr(const HexStr: THexString): string;
function NZEncryptToHexStr(const Str: string): THexString;
function NZidDecrypt(const S: string): string;
function NZidEncrypt(const S: string; const ID: integer = 0): string;
function NZidDecryptOfHexStr(const HexStr: THexString): string;
function NZidEncryptToHexStr(const Str: string; const ID: integer = 0): THexString;
// NZ_PIX will be used as key seed generator
function HexStrtoStr(const HexStr: string): string;
function StrtoHexStr(const Str: string): string;
const
  NZ_PIX: int64 = trunc(PI  1E18);
  MAX_NZID = high(byte)   high(byte)  high(byte)   cardinal(high(byte)); // max capacity of nzid
function asmInttoNZN(const I: cardinal; const base: byte = 255): integer;
function asmNZNtoInt(const NZN: cardinal): integer; overload; // constant base = 255
function asmNZNtoInt(const NZN: cardinal; const base: byte): integer; overload;
implementation
//uses Ordinals;
type
  r64 = packed record
    case Integer of
      0: (Lo, Hi: Cardinal);
      1: (Cardinals: array[0..1] of Cardinal);
      2: (Words: array[0..3] of Word);
      3: (Bytes: array[0..7] of Byte);
  end;
function rol(const I: integer): integer; overload asm rol I, 1 end;
function rol(const I: Int64): Int64; overload asm
    mov edx, I.r64.hi  // using register is faster than directly accessing memory
    mov eax, I.r64.lo // in Pentium they could also be run parallelized
    shl eax, 1; rcl edx, 1
    jnc @done; or eax, 1
  @done: //popfd
end;
function ror(const I: integer): integer; overload asm ror I, 1 end;
function ror(const I: Int64): Int64; overload asm
    mov edx, I.r64.hi  // using register is faster than directly accessing memory
    mov eax, I.r64.lo //  in Pentium they could also be run parallelized
    shr edx, 1; rcr eax, 1
    jnc @done; or edx, 1 shl 31
  @done: //popfd
end;
function rol(const I: Int64; const ShiftCount: integer): Int64; overload register asm
    mov ecx, ShiftCount // as Intel says, upon shift this value will be taken MODULO 32
    mov edx, I.r64.hi   // using register is faster than directly accessing memory
    mov eax, I.r64.lo   // in Pentium they could also be run parallelized
    and ecx, $3f; jz @exit
    cmp cl, 32; jb @begin
    //xchg eax, edx     // avoid LOCK prefixed xchg instruction
    mov eax, edx        // simple move should be faster & pairing enable
    mov edx, I.r64.lo //
    jz @exit
  @begin:
    push ebx; mov ebx, eax
    shld eax, edx, cl
    shld edx, ebx, cl
  @done: pop ebx
  @exit:
end;
function ror(const I: Int64; const ShiftCount: integer): Int64; overload register asm
    mov ecx, ShiftCount // as Intel says, upon shift this value will be taken MODULO 32
    mov edx, I.r64.hi  // using register is faster than directly accessing memory
    mov eax, I.r64.lo // in Pentium they could also be run parallelized
    and ecx, $3f; jz @exit
    cmp cl, 32; jb @begin
    //xchg eax, edx   // avoid LOCK prefixed xchg instruction
    mov eax, edx      // simple move should be faster & pairing enable
    mov edx, I.r64.lo //
    jz @exit
  @begin:
    push ebx; mov ebx, edx
    shrd edx, eax, cl
    shrd eax, ebx, cl
  @done: pop ebx
  @exit:
end;
function rol(const I: integer; const ShiftCount: integer): integer; overload register asm
  mov ecx, ShiftCount; rol I, cl
end;
function ror(const I: integer; const ShiftCount: integer): integer; overload register asm
  mov ecx, ShiftCount; ror I, cl
end;
function asmInttoNZN(const I: cardinal; const base: byte = 255): integer;
const AllOnes = $01010101;
asm
  test eax, not 0ffh; jnz @@0
  add eax,AllOnes; ret;
@@0: movzx ecx,dl; //sanitize
  //cmp eax,ecx; ja @@1
  //sbb edx,edx; and eax,edx
  //sete ah; add eax,AllOnes; ret;
;@@1: xor edx,edx; push edx; // Result
  div ecx; mov [esp],dl;
  cmp eax,ecx; ja @@2
  sbb edx,edx; and eax,edx
  sete dl;
  mov [esp+1],al; mov [esp+2],dl;
  jmp @@normalize
@@2: xor edx,edx; div ecx;
  mov [esp+1],dl;
  cmp eax,ecx; ja @@3
  sbb edx,edx; and eax,edx
  sete ah; mov [esp+2],ax;
  jmp @@normalize
@@3: xor edx,edx; div ecx;
  mov [esp+2],dl; mov [esp+3],al;
@@normalize:
  pop eax; add eax,AllOnes;
end;
function asmNZNtoInt(const NZN: cardinal; const base: byte): integer; overload;
const AllOnes = $01010101;
asm
  sub eax,AllOnes;
  jnz @@0; ret
@@0:
  push ebx; push eax;
  movzx ebx,al; movzx ecx,dl;
  test ah,ah; jz @@1;
  movzx eax,ah; mul ecx;
  add ebx,eax;
@@1:
  movzx eax,[esp+2];
  test eax,eax; jz @@2
  push eax;
  mov eax,ecx; mul ecx;
  pop edx; mul edx;
  add ebx,eax;
@@2:
  movzx eax,[esp+3];
  test eax,eax; jz @@3
  push eax;
  mov eax,ecx; mul ecx; mul ecx;
  pop edx; mul edx;
  add ebx,eax
@@3:
  pop eax; mov eax,ebx;
  pop ebx;
end;
{ when base is constant = 255, we could replace mul with cheaper shift/sub }
function div255(const I: cardinal): byte;
asm
end;
function mod255(const I: cardinal): byte;
asm
 movzx edx,al; movzx ecx,ah
 bswap eax
 add ecx,edx; movzx edx,ah
 movzx eax,al; add edx,ecx
 add eax,edx; add al,ah
 xor ah,ah
end;
function asmNZNtoInt(const NZN: cardinal): integer; overload; // constant base = 255
const AllOnes = $01010101;
const m1 = $FF; m2 = $FE01; m3 = $00FD02FF;
const m2neg = $1FF; //   // = 200 - 1
const m3neg = $0002FD01; // = 30000 - 2FF = 30000 - 300 + 1
                         //               = 3  (10000 - 100) + 1
                         //               = 3   100  (100 - 1) + 1
asm
{ the branch prediction failure's penalty is absurdly high }
{ we'd better let all inst. pass rather than jcc           }
  sub eax,AllOnes; //jnz @@begin; ret
  //test eax, not $ff; jnz @@begin; ret
;@@0:
  push ebx; mov ebx,eax;
  movzx edx,ah; sub ebx,edx;
  shr eax,16; jz @@end
  movzx ecx,al; movzx edx,al;
  shl ecx,8+1; sub ecx,edx;
  sub ebx,ecx;
  and eax,not 0ffh; jz @@end;
  mov ecx,eax; movzx edx,ah;
  shl ecx,8; sub ebx,edx;
  sub ecx,eax; mov eax,ecx;
  add ecx,ecx; add ecx,eax;
  sub ebx,ecx;
@@end: mov eax,ebx; pop ebx;
end;
// StrToHexStr and HexStrToStr functions are made to remove dependency to
// bigshit ordinals unit (also made by us). if you are using ordinals unit
// then this stupid little craps are not needed. use much-much-much more capable
// ordinals.hexs routines instead;
function StrtoHexStr(const Str: string): string;
// returns HexString (byte-per-byte in hexdigits) representation of string
const hexdigit = '0123456789ABCDEF';
var
  i, b: integer;
begin
  Result := '';
  for i := 1 to length(Str) do begin
    b := ord(Str[i]);
    Result := result +
      hexdigit[(b shr 4) and $0F + 1] + hexdigit[b and $0F + 1];
  end;
end;
function HexStrtoStr(const HexStr: THexString): string;
  // convert array of each 2 hex digits ['0'..'9','a'..'f', 'A'..'F']
  // pairs to their respective character counterpart (make them a string)
  // (any invalid hex digits will be skipped)
  // length should be an even number, unpaired last digit
  // (if length is an odd number), will also be skipped.
const HEXDIGITS = ['0'..'9', 'A'..'F', 'a'..'f'];
  function StrToIntDef(const S: string; Default: Integer): Integer;
  var E: Integer;
  begin
    Val(S, Result, E);
    if E <> 0 then Result := Default;
  end;
var
  i, n: integer;
  vHex, sn: string;
begin
  vHex := ''; //(Validated HexStr)
  for i := 1 to length(HexStr) do
    if HexStr[i] in HEXDIGITS then
      vHex := vHex + HexStr[i];
  Result := '';
  for i := 0 to length(vHex) div 2 - 1 do begin
    sn := '$' + copy(vHex, i   2 + 1, 2);
    n := strToIntDef(sn, 0);
    Result := Result + char(n);
  end;
end;
function XOR32(const S: string): string;
var
  i: integer;
begin
  i := length(S);
  setLength(Result, i);
  for i := 1 to i do
    Result[i] := char(ord(s[i]) xor (i and $1F));
end;
function XOR32encrypt(const Str: string): THexString; begin // encrypt TO hexStr
  Result := StrtoHexStr(XOR32(Str));
end;
function XOR32decrypt(const HexStr: THexString): string; begin // decrypt FROM hexStr
  Result := XOR32(HexStrtoStr(HexStr));
end;
function NZEncrypt(const S: string): string;
var
  i, l: integer;
  Key: integer; //64;
  b: byte;
begin
  l := length(S);
  setlength(Result, l);
  if l > 0 then begin
    Key := l  NZ_PIX;
    for i := l downto 1 do begin
      b := ord(S[i]);
      if b <> byte(Key) then b := b xor (Key);
      Key := rol(Key, (b or 1));
      Result[l - i + 1] := char(b);
    end;
  end;
end;
function NZDecrypt(const S: string): string;
var
  i, l: integer;
  Key: integer; //int64;
  b0, b: byte;
begin
  l := length(S);
  setlength(Result, l);
  if l > 0 then begin
    Key := l   NZ_PIX;
    for i := 1 to l do begin
      b0 := ord(S[i]);
      if b0 = byte(Key) then b := Key // do NOT forget byte(Key) typecast!
      else b := b0 xor Key;
      Key := rol(Key, (b0 or 1));
      Result[l - i + 1] := char(b);
    end;
  end;
end;
function NZEncryptToHexStr(const Str: string): string;
begin
  Result := StrtoHexStr(NZEncrypt(Str));
end;
function NZDecryptOfHexStr(const HexStr: string): string;
begin
  Result := NZDecrypt(HexStrtoStr(HexStr));
end;
type
  TCrIDType = type integer; // decoded: (Key) + (3  7 bits)
                            // max = 128 128128-1 = 2097151
const
  PREFIXLEN = sizeof(TCrIDType);
  PREFIXLEN2 = PREFIXLEN   2;
// ID use only 3 bytes, the most significant byte of ID will not be used!
function getCrID(const ID: integer; OpenChar: char): integer; overload;
var
  Key: byte;
  function BigEndian3bytes(const I: integer): integer; asm bswap eax; shr eax,8; end; // only 3 bytes used + 2 bits
begin
  repeat Key := random(high(Key) + 1)
  until (byte(key) > 0) and (byte(Key) <> ord(OpenChar));
  Result := asmInttoNZN(ID);
  Result := BigEndian3bytes(Result) or (Key shl 24)
end;
function NZidDecrypt(const S: string): string; {$Q-} // no-overflow-checking
var
  i, l: integer;
  Key: int64;
  b0, b: byte;
begin
  l := length(S) - PREFIXLEN;
  if l < 1 then Result := ''
  else begin
    setlength(Result, l);
    move(S[1], I, sizeof(PREFIXLEN));
    Key := I  NZ_PIX;
    RandSeed := Key;
    Key := Key   integer(Random(MaxInt));
    for i := 1 to l do begin
      b0 := ord(S[i + PREFIXLEN]);
      //OK.
      //if (Key and $60) > 0 then
      //  b := b0 xor (Key and $9F)
      //else b := b0 xor Key;
      if b0 = byte(Key) then b := byte(Key) // do NOT forget byte(Key) typecast!
      else b := b0 xor Key;
      Key := rol(Key, (b0 or 1));
      Result[l - i + 1] := char(b);
    end;
  end;
end;
function NZidEncrypt(const S: string; const ID: integer = 0): string; {$Q-} // no-overflow-checking
var
  i, l, X: integer;
  Key: int64;
  b: byte;
begin
  l := length(S);
  if l < 1 then Result := ''
  else begin
    setlength(Result, l + PREFIXLEN);
    X := getCrID(ID, S[l]);
    move(X, Result[1], PREFIXLEN);
    Key := X  NZ_PIX;
    RandSeed := Key;
    Key := Key   integer(Random(MaxInt));
    for i := l downto 1 do begin
      b := ord(S[i]);
      //OK.
      //if (Key and $60) > 0 then
      //  b := b xor (Key and $9F)
      //else b := b xor Key;
      //b := b xor Key;
      //if b = 0 then b := Key;
      if b <> byte(Key) then b := b xor (Key);
      Key := rol(Key, (b or 1));
      Result[l - i + PREFIXLEN + 1] := char(b);
    end;
  end;
end;
function NZidEncryptToHexStr(const Str: string; const ID: integer = 0): THexString;
begin
  Result := StrtoHexStr(NZidEncrypt(Str, ID));
end;
function NZidDecryptOfHexStr(const HexStr: THexString): string;
begin
  Result := NZidDecrypt(HexStrtoStr(HexStr));
end;
end.