szcodebasex.pas

更新希网动态域名(8866.org)的服务程序

function SZEncodeBase16(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
begin
  result:=SZEncodeBaseXStream(sIN, sOUT, Size, SZCodes16, SZBITS16, SZFullQuantum0, MIMELine);
end;

function SZEncodeBase16(const S: string; MIMELine: integer = 0): string; overload;
begin
  Result:=SZEncodeBaseXString(S, SZCodes16, SZBITS16, SZFullQuantum0, MIMELine)
end;

function SZDecodeBase16(pIN, pOUT: PByte; Size: integer): integer; overload;
begin
  result:= SZDecodeBaseXMemory(pIN,pOUT, Size, SZCodes16, SZBITS16);
end;

function SZDecodeBase16(sIN, sOUT: TStream): integer; overload;
begin
  result:= SZDecodeBaseXStream(sIN,sOUT, SZCodes16, SZBITS16);
end;

function SZDecodeBase16(const S: string): string; overload;
begin
  Result:=SZDecodeBaseXString(S, SZCodes16, SZBITS16)
end;

////////////////////////////////////////////////////////////
/// Base32
////////////////////////////////////////////////////////////

function SZFullEncodeBase32(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer;  overload;
begin
  result:=SZEncodeBaseXMemory(pIN,pOUT, Size, SZCodes32, SZBITS32, SZFullQuantum32, MIMELine);
end;

function SZFullEncodeBase32(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
begin
  result:=SZEncodeBaseXStream(sIN,sOUT, Size, SZCodes32, SZBITS32, SZFullQuantum32, MIMELine);
end;

function SZFullEncodeBase32(const S: string; MIMELine: integer = 0): string; overload;
begin
  Result:=SZEncodeBaseXString(S, SZCodes32, SZBITS32, SZFullQuantum32, MIMELine);
end;

function SZEncodeBase32(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
begin
  result:=SZEncodeBaseXMemory(pIN,pOUT, Size, SZCodes32, SZBITS32, SZFullQuantum0, MIMELine);
end;

function SZEncodeBase32(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
begin
  result:=SZEncodeBaseXStream(sIN,sOUT, Size, SZCodes32, SZBITS32, SZFullQuantum0, MIMELine);
end;

function SZEncodeBase32(const S: string; MIMELine: integer = 0): string; overload;
begin
  Result:=SZEncodeBaseXString(S, SZCodes32, SZBITS32, SZFullQuantum0, MIMELine)
end;

function SZDecodeBase32(pIN, pOUT: PByte; Size: integer): integer; overload;
begin
  result:= SZDecodeBaseXMemory(pIN,pOUT, Size, SZCodes32, SZBITS32);
end;

function SZDecodeBase32(sIN, sOUT: TStream): integer; overload;
begin
  result:=SZDecodeBaseXStream(sIN,sOUT, SZCodes32, SZBITS32);
end;

function SZDecodeBase32(const S: string): string; overload;
begin
  Result:=SZDecodeBaseXString(S, SZCodes32, SZBITS32)
end;

////////////////////////////////////////////////////////////
///    Base64
////////////////////////////////////////////////////////////
function SZFullEncodeBase64(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer;  overload;
begin
  result:=SZEncodeBaseXMemory(pIN,pOUT, Size, SZCodes64, SZBITS64, SZFullQuantum64, MIMELine);
end;

function SZFullEncodeBase64(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
begin
  result:=SZEncodeBaseXStream(sIN,sOUT, Size, SZCodes64, SZBITS64, SZFullQuantum64, MIMELine);
end;

function SZFullEncodeBase64(const S: string; MIMELine: integer = 0): string;  overload;
begin
  Result:=SZEncodeBaseXString(S, SZCodes64, SZBITS64, SZFullQuantum64, MIMELine)
end;

function SZEncodeBase64(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
begin
  result:=SZEncodeBaseXMemory(pIN,pOUT, Size, SZCodes64, SZBITS64, SZFullQuantum0, MIMELine);
end;

function SZEncodeBase64(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
begin
  result:=SZEncodeBaseXStream(sIN,sOUT, Size, SZCodes64, SZBITS64, SZFullQuantum0, MIMELine);
end;

function SZEncodeBase64(const S: string; MIMELine: integer = 0): string; overload;
begin
  Result:=SZEncodeBaseXString(S, SZCodes64, SZBITS64, SZFullQuantum0, MIMELine)
end;

function SZDecodeBase64(pIN, pOUT: PByte; Size: integer): integer; overload;
begin
  result:= SZDecodeBaseXMemory(pIN,pOUT, Size, SZCodes64, SZBITS64);
end;

function SZDecodeBase64(sIN, sOUT: TStream): integer; overload;
begin
  result:=SZDecodeBaseXStream(sIN,sOUT, SZCodes64, SZBITS64);
end;

function SZDecodeBase64(const S: string): string; overload;
begin
  Result:=SZDecodeBaseXString(S, SZCodes64, SZBITS64)
end;

////////////////////////////////////////////////////////////
///  Base64 URL table
////////////////////////////////////////////////////////////

function SZFullEncodeBase64URL(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
begin
  result:=SZEncodeBaseXMemory(pIN, pOUT, Size, SZCodes64URL, SZBITS64, SZFullQuantum64, MIMELine);
end;

function SZFullEncodeBase64URL(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
begin
  result:=SZEncodeBaseXStream(sIN,sOUT, Size, SZCodes64URL, SZBITS64, SZFullQuantum64, MIMELine);
end;

function SZFullEncodeBase64URL(const S: string; MIMELine: integer = 0): string; overload;
begin
  Result:=SZEncodeBaseXString(S, SZCodes64URL, SZBITS64, SZFullQuantum64, MIMELine)
end;

function SZEncodeBase64URL(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
begin
  result:=SZEncodeBaseXMemory(pIN, pOUT, Size, SZCodes64URL, SZBITS64, SZFullQuantum0, MIMELine);
end;

function SZEncodeBase64URL(const S: string; MIMELine: integer = 0): string; overload;
begin
  Result:=SZEncodeBaseXString(S, SZCodes64URL, SZBITS64, SZFullQuantum0, MIMELine)
end;

function SZEncodeBase64URL(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
begin
  result:=SZEncodeBaseXStream(sIN,sOUT, Size, SZCodes64URL, SZBITS64, SZFullQuantum0, MIMELine);
end;

function SZDecodeBase64URL(pIN, pOUT: PByte; Size: integer): integer; overload;
begin
  result:= SZDecodeBaseXMemory(pIN,pOUT, Size, SZCodes64URL, SZBITS64);
end;

function SZDecodeBase64URL(sIN, sOUT: TStream): integer; overload;
begin
  result:=SZDecodeBaseXStream(sIN,sOUT, SZCodes64URL, SZBITS64);
end;

function SZDecodeBase64URL(const S: string): string; overload;
begin
  Result:=SZDecodeBaseXString(S, SZCodes64URL, SZBITS64)
end;

//////////////////////////////////////////////////////////////


procedure SZCodeBaseXSetBufferSize(Size:integer);
begin
  // Do not allow Buffers size less than original
  // to avoid drastic performace decresing with streams

  if size > SZORIGBUFFSIZE then
    SZBUFFSIZE := Size
  else
    SZBUFFSIZE := SZORIGBUFFSIZE;
end;

procedure SZCodeBaseXSetOrigBufferSize;
begin
  SZCodeBaseXSetBufferSize(SZORIGBUFFSIZE);
end;

//////////////////////////////////////////////////////////////////
// Calculating Required Output Memory
//////////////////////////////////////////////////////////////////

function SZCalcRequiredOutputMemoryForFullEncodeBase64(Size: integer; MIMELine: integer=0): integer;
begin
  Result:=SZCalcRequireOutputMemory(Size, SZBITS64, SZFullQuantum64, MIMELine);
end;

function SZCalcRequiredOutputMemoryForFullEncodeBase32(Size: integer; MIMELine: integer=0): integer;
begin
  Result:=SZCalcRequireOutputMemory(Size, SZBITS32, SZFullQuantum32, MIMELine);
end;

function SZCalcRequiredOutputMemoryForFullEncodeBase16(Size: integer; MIMELine: integer=0): integer;
begin
  Result:=SZCalcRequireOutputMemory(Size, SZBITS16, SZFullQuantum0, MIMELine);
end;

function SZCalcRequiredOutputMemoryForEncodeBase64(Size: integer; MIMELine: integer=0): integer;
begin
  Result:=SZCalcRequireOutputMemory(Size, SZBITS64, SZFullQuantum0, MIMELine);
end;

function SZCalcRequiredOutputMemoryForEncodeBase32(Size: integer; MIMELine: integer=0): integer;
begin
  Result:=SZCalcRequireOutputMemory(Size, SZBITS32, SZFullQuantum0, MIMELine);
end;

function SZCalcRequiredOutputMemoryForEncodeBase16(Size: integer; MIMELine: integer=0): integer;
begin
  Result:=SZCalcRequireOutputMemory(Size, SZBITS16, SZFullQuantum0, MIMELine);
end;

////////////////////
///      End     ///
////////////////////


//////////////////////////////////////////////////////////////
//Additional codes, may be deleted in the future
//////////////////////////////////////////////////////////////

//Returns 64-bit count of CPU clock cycles.
function RDTSC: Int64;
asm
  dw $310F  // opcode for RDTSC
end;

{
function ROR(value: LongWord;dummy: integer; count: LongWord): LongWord;
asm
   ROR EAX, CL
end;

function ROL(value: LongWord;dummy: integer; count: LongWord): LongWord;
asm
   ROL EAX, CL
end;

function BSWAP(value: LongWord): LongWord;
asm
   BSWAP EAX
end;
}

const
  codes64: array[0..63] of byte = (
    065, 066, 067, 068, 069, 070, 071, 072,
    073, 074, 075, 076, 077, 078, 079, 080,
    081, 082, 083, 084, 085, 086, 087, 088,
    089, 090, 097, 098, 099, 100, 101, 102,
    103, 104, 105, 106, 107, 108, 109, 110,
    111, 112, 113, 114, 115, 116, 117, 118,
    119, 120, 121, 122, 048, 049, 050, 051,
    052, 053, 054, 055, 056, 057, 043, 047);

function SZFullEncodeOnlyBase64(const S: string; MIMELine: integer = 0): string;
{
 Encode algorithm for Base64
 Reference: RFC 3548 - full compatibility

 ATTENTION! MIMELine here in not in use!
}

type
  TBI3= packed array [0..2] of byte;
  pBI3= ^TBI3;

  TBO4= packed array [0..3] of byte;
  pBO4= ^TBO4;
var
  i: integer;

  pIN: pBI3;
  pOUT: pBO4;

  TotalIn, TotalOut, TotalInRest: integer;
  B32: longword;

begin

  TotalIn  := length(s);
  TotalOut := (TotalIn + 2) div 3 * 4 ;
  TotalINRest:= TotalIn - TotalIN div 3 * 3;

  SetLength(Result, TotalOut);

  pIN  := @S[1];
  pOUT := @Result[1];

  // Start coding
  for i := 1 to TotalIn Div 3 do
  begin

    // Set new DWORD value in format
    // 00000000 11111111 22222222 33333333

    B32 := (pIN[0] shl 16) or (pIN[1] shl 8) or (pIn[2]);
    inc(pIN);

    pOUT[3] := Codes64[ B32  and $3F ]; B32:=B32 shr 6;
    pOUT[2] := Codes64[ B32  and $3F ]; B32:=B32 shr 6;
    pOUT[1] := Codes64[ B32  and $3F ]; B32:=B32 shr 6;
    pOUT[0] := Codes64[ B32          ];

    inc(pOUT);

  end;

  if TotalINRest = 1 then
  begin
    B32:= (pIn[0] shl 4) ;

    pOUT[1] := Codes64[ B32 and $3F ]; B32:= B32 shr 6;
    pOUT[0] := Codes64[ B32         ];

    pOUT[3] := byte('=');
    pOUT[2] := byte('=');
  end
  else
  if TotalINRest = 2
  then
  begin
    B32:= ((pIn[0] shl 8) or pIn[1]) shl 2 ;

    pOUT[2] := Codes64[ B32 and $3F ]; B32:= B32 shr 6;
    pOUT[1] := Codes64[ B32 and $3F ]; B32:= B32 shr 6;
    pOUT[0] := Codes64[ B32         ];

    pOUT[3] := byte('=');

  end

end;


function SZFullEncodeOnlyBase64_6(const S: string; MIMELine: integer = 0): string;
{
 Encode algorithm for Base64
 Reference: RFC 3548 - full compatibility

  ATTENTION! MIMELine here in not in use!

}

type

  TBI3= packed array [0..2] of byte;
  pBI3= ^TBI3;

  TBO4= packed array [0..3] of byte;
  pBO4= ^TBO4;

var
  i: integer;

  pIN: pBI3;
  pOUT: pBO4;

  TotalIn, TotalOut, TotalINRest: integer;
  B32: longword;

begin

  TotalIn  := length(s);
  TotalOut := (TotalIn + 2) div 3 * 4 ;
  TotalINRest:= TotalIn - TotalIN div 3 * 3;

  SetLength(Result, TotalOut);

  pIN  := @S[1];
  pOUT := @Result[1];

  // This variation encode directly form input DWORD

  // Start coding
  for i := 1 to TotalIn Div 3 do
  begin

    B32:=pLongWord(pIN)^;
    inc(pIN);

    pOUT[0] := Codes64[((B32 shr  2) and $3F)];
    pOUT[1] := Codes64[((B32 shl  4) and $3F) or ((B32 shr 12) and $0F)];
    pOUT[2] := Codes64[((B32 shr  6) and $3C) or ((B32 shr 22) and $03)];
    pOUT[3] := Codes64[((B32 shr 16) and $3F)];

    inc(pOUT);

  end;

  if TotalINRest = 1 then
  begin
    B32:= (pIn[0] shl 4) ;

    pOUT[1] := Codes64[ B32 and $3F ]; B32:= B32 shr 6;
    pOUT[0] := Codes64[ B32         ];

    pOUT[3] := byte('=');
    pOUT[2] := byte('=');
  end
  else
  if TotalINRest = 2
  then
  begin
    B32:= ((pIn[0] shl 8) or pIn[1]) shl 2 ;

    pOUT[2] := Codes64[ B32 and $3F ]; B32:= B32 shr 6;
    pOUT[1] := Codes64[ B32 and $3F ]; B32:= B32 shr 6;
    pOUT[0] := Codes64[ B32         ];

    pOUT[3] := byte('=');
  end

end;


Initialization
  SZCodeBaseXSetOrigBufferSize;

end.