szcodebasex.pas

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

    inc(pIN);

  end;

  vB8 := B8;
  vI8 := I8;

  result:=Count;
end;
                 
function SZEncodeBaseXMemoryFinalyze(var pOUT: PByte; const Codes: String; BITS: integer; B8, I8: integer): integer;
// Finalyzing encoding with last left bites (if any)
begin
  // If something left
  if I8 > 0 then
  begin
    pchar(pOUT)^ := Codes[ (B8 shl (BITS-I8)) + 1];
    inc(pOUT);
    result:=1;
  end else
    result:=0;
end;

function SZEncodeBaseXMemory(pIN, pOUT: pByte; Size: integer; const Codes: String; BITS: integer; FullQuantum : integer; MIMELine : integer): integer;
var
  B8,I8: integer;

  TotalOut : integer;
  IM       : integer;

  MIMECountdown  : integer;
  MIMEBytesCount : integer;

  ppIN, ppOUT: pByte;
begin
  B8:=0;
  I8:=0;

  ppIN  := pIN;
  ppOUT := pOut;

  MIMEBytesCount:=0;
  MIMECountdown:=MIMELine;

  TotalOut:=SZEncodeBaseXMemoryUpdate(ppIN, ppOUT, Size, Codes, BITS, B8, I8, MIMELine, MIMECountdown, MIMEBytesCount);

  // If something left
  if I8>0 then
    TotalOut:=TotalOut+
      SZEncodeBaseXMemoryFinalyze(ppOut, Codes, BITS, B8, I8);

  if FullQuantum>0 then
  begin

    // Calculate relevant data
    //GetRelevantData(TotalIn, TotalOut, BITS, FullQuantum, IM);

    // Get required padding keys
    IM:=SZCalcRequiredPaddingKeys(TotalOut - MIMEBytesCount, FullQuantum);

    if IM>0 then
    begin
      FillChar( ppOUT^, IM,'=');
      pchar(ppOut):=pchar(ppOut)+IM;

      TotalOut:=TotalOut + IM
    end
  end;

  result:=TotalOut;
end;


function SZDecodeBaseXMemoryUpdate(pIN,pOUT: pByte; Size: integer; const FastDecodeTable: TFastDecodeTable; BITS: integer; var B8, I8 : integer): integer;
{
  Universal Decode algorithm for Base16, Base32 and Base64
  Reference: RFC 3548 - full compatibility
}

var
  i: Integer;
  TotalIN, Count: integer;

begin

  TotalIN  := Size;

  // Start decoding
  count := 0;
  for i := 1 to TotalIN do
  begin

    if SZFastDecodeTable[pIN^] > 0 then
    begin

      B8 := B8 shl BITS;
      B8 := B8 or (SZFastDecodeTable[pIN^]-1);

      I8 := I8 + BITS;

      while I8 >= 8 do
      begin
        I8 := I8 - 8;

        pOUT^ := Byte(B8 shr I8);
        inc( pOUT );

        inc(count)
      end;

      inc(pIN);
    end
    else if pIN^=13 then inc(pIN)
    else if pIN^=10 then inc(pIN)
    else
      break
  end;

  result:=Count;
end;

function SZDecodeBaseXMemory(pIN,pOUT: pByte; Size: integer; const Codes: string; BITS: integer): integer;
{
  Universal Decode algorithm for Base16, Base32 and Base64
  Reference: RFC 3548 - full compatibility
}

var
  B8, I8 : integer;
begin
  B8:=0;
  I8:=0;

  SZUpdateFastDecodeTable(Codes);

  result:=SZDecodeBaseXMemoryUpdate( pIN, pOUT, Size, SZFastDecodeTable, BITS, B8, I8);
end;

function SZDecodeBaseXString(const S: string; const Codes: String; BITS: integer): String;
var
  TotalIn  : integer;
  TotalOut : integer;

  pIN,pOUT: pByte;

begin

  TotalIn  := length(S);
  TotalOut := (TotalIn * BITS) div 8;

  Setlength(Result,TotalOut);

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

  TotalOut:=SZDecodeBaseXMemory( pIN, pOUT, TotalIn, Codes, BITS);

  if length(Result)<> TotalOut then
    Setlength(Result,TotalOut);
end;

function SZEncodeBaseXString(const S: string; const Codes: string; BITS: integer; FullQuantum : integer ; MIMELine : integer): string;
// Universal Encode algorithm for Base16, Base32 and Base64
var
  pIN, pOUT: pByte;

  TotalIn, TotalOut: integer;
  IM: integer;
begin
  TotalIn  := length(s);

  // Calculate relevant data
  GetRelevantData(TotalIn, TotalOut, BITS, FullQuantum, IM, MIMELine);

  // Get required padding keys
  //IM:=SZCalcRequiredPaddingKeys(TotalOut, FullQuantum);

  SetLength(Result,TotalOut);

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

  SZEncodeBaseXMemory(pIn,pOut, TotalIn, Codes, BITS, FullQuantum, MIMELine);
end;

//////////////////////////
// Stream
//////////////////////////

function SZEncodeBaseXStreamUpdate(sIN, sOUT: TStream; Size: integer; const Codes: String; BITS: integer; var vB8, vI8: integer; MIMELine: integer; Var MIMECountdown, MIMEByteCount: integer): integer;
var
  pBuffIn, pBuffOut: pByte;
  Res,BUFF : Integer;
  pIn,pOut: pByte;
  LOut,Count,TotalIn, TotalOut, MIMEOut: integer;
begin

  BUFF := SZBUFFSIZE;

  TotalIn:=Size;

  if BUFF > TotalIn  then
    BUFF:=TotalIn+1;

  TotalOut := BUFF shl 3; // * 8

  if TotalOut mod BITS > 0 then
    TotalOut:= TotalOut div BITS +1
  else
    TotalOut:= TotalOut div BITS;

  if MIMELine>0 then
    MIMEOut:= ( (TotalOut-1) div (MIMELine) ) * 2
  else
    MIMEOut:=0;

  TotalOut:= TotalOut + MIMEOut;


  // Get memory for it

  GetMem(pBuffIn,BUFF);
  GetMem(pBuffOut,TotalOut);
  
  Count:=0;

  repeat
    Res := sIn.Read(pBuffIn^, BUFF);

    pIn  := pBuffIn;
    pOut := pBuffOut;

    LOut:=SZEncodeBaseXMemoryUpdate(pIn,pOut, Res, Codes, BITS, vB8, vI8, MIMELine, MIMECountdown, MIMEByteCount);
    sOut.Write(pBuffOut^,LOut);

    Count := Count + LOut;

  until (Res <> LongInt(BUFF));

  FreeMem(pBuffIn);
  FreeMem(pBuffOut);

  result:=Count;
end;

function SZEncodeBaseXStreamFinalyze(sOUT: TStream; const Codes: String; BITS: integer; var B8, I8: integer): integer;
var
  pOut: pByte;
  b: byte;
begin
  pOut:=@b;

  Result:=SZEncodeBaseXMemoryFinalyze(pOUT, Codes, BITS,B8,I8);

  if Result>0 then
    sOut.Write(b,Result);
end;

function SZEncodeBaseXStream(sIN, sOUT: TStream; Size: integer; const Codes: String; BITS: integer; FullQuantum : integer; MIMELine : integer): integer;
var
  B8,I8: integer;

  TotalIn  : integer;
  TotalOut : integer;
  IM       : integer;

  MIMECountdown, MIMEBytesCount: integer;
begin

  if size=0 then
  begin
    result:=0;
    exit
  end;

  // This is important code if you encode just part of a stream
  if size<0 then
    TotalIn:= sIn.Size-sIn.Position
  else
    TotalIn:= Size;

  B8:=0;
  I8:=0;

  MIMECountdown:=MIMELine;
  MIMEBytesCount:=0;

  TotalOut:=SZEncodeBaseXStreamUpdate(sIN, sOUT, TotalIn, Codes, BITS, B8, I8, MIMELine, MIMECountdown, MIMEBytesCount);
  // If something left
  if I8>0 then
    TotalOut:=TotalOut+SZEncodeBaseXStreamFinalyze(sOUT, Codes, BITS, B8, I8);

  if FullQuantum>0 then
  begin

    // Calculate relevant data
    // GetRelevantData(TotalIn, TotalOut, BITS, FullQuantum, IM);
    // Get required padding keys
    IM:=SZCalcRequiredPaddingKeys(TotalOut - MIMEBytesCount, FullQuantum);

    if IM>0 then
    begin
      sOut.Write(pchar(StringOfChar('=',IM))^,IM);
      TotalOut:=TotalOut+IM
    end

  end;

  result:=TotalOut;
end;

function SZDecodeBaseXStream(sIN, sOUT: TStream;  const Codes: String; BITS: integer): integer;
var
  TotalIn  : integer;
  TotalOut : integer;

  pIn,pOut: pByte;

  pBuffIn, pBuffOut: pByte;
  Res,BUFF : Integer;
  LOut,Count: integer;

  B8, I8: integer;
begin

  BUFF := SZBUFFSIZE;

  // This is important code if you encode just a part of a stream
  TotalIn := sIn.Size - SIn.Position;

  if BUFF > TotalIn  then
    BUFF:=TotalIn+1;

  TotalOut := BUFF;

  // Get memory for it

  GetMem(pBuffIn,BUFF);
  GetMem(pBuffOut,TotalOut);

  Count:=0;

  B8:=0;
  I8:=0;

  SZUpdateFastDecodeTable(Codes);

  repeat
    Res := sIn.Read(pBuffIn^, BUFF);

    pIn  := pBuffIn;
    pOut := pBuffOut;

    Lout:=SZDecodeBaseXMemoryUpdate(pIN, pOUT, Res, SZFastDecodeTable, BITS, B8, I8);

    sOut.Write(pBuffOut^,LOut);

    Count := Count + LOut;

  until (Res <> LongInt(BUFF));

  FreeMem(pBuffOut);
  FreeMem(pBuffIn);

  result:=Count;
end;

function SZEncodeBaseXFile(const FileName: String; sOUT: TStream; const Codes: string; BITS: integer; FullQuantum : integer; MIMELine: integer ): integer;
var
  sIn: TFileStream;
  Size: integer;
begin
  sIn := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);

  Size:= sIn.Size;

  try
    result:= SZEncodeBaseXStream(sIN, sOUT, Size, Codes, BITS, FullQuantum, MIMELine);
  finally
    sIn.Free;
  end;
end;

///////////////////////////////////////////////////
// File to stream
///////////////////////////////////////////////////

function SZFullEncodeBase64(const FileName: String; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
  result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes64, SZBITS64, SZFullQuantum64, MIMELine);
end;

function SZFullEncodeBase64URL(const FileName: String; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
  result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes64URL, SZBITS64, SZFullQuantum64, MIMELine);
end;

function SZEncodeBase64(const FileName: String; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
  result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes64, SZBITS64, SZFullQuantum0, MIMELine);
end;

function SZEncodeBase64URL(const FileName: String; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
  result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes64URL, SZBITS64, SZFullQuantum0, MIMELine);
end;

function SZFullEncodeBase32(const FileName: String; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
  result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes32, SZBITS32, SZFullQuantum32, MIMELine);
end;

function SZEncodeBase32(const FileName: String; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
  result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes32, SZBITS32, SZFullQuantum0, MIMELine);
end;

function SZEncodeBase16(const FileName: String; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
  result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes16, SZBITS16, SZFullQuantum0, MIMELine);
end;

////////////////////////////////////////////////////////////
///    Base16
////////////////////////////////////////////////////////////

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

function SZEncodeBase16(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
begin
  result:= SZEncodeBaseXMemory(pIN,pOUT, Size, SZCodes16, SZBITS16, SZFullQuantum0, MIMELine);
end;