szcodebasex.pas

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

{$O+} // Optimization must be ON
{$R-} // Range checking must be OFF

unit SZCodeBaseX;

/////////////////////////////
// Version 1.3.3
////////////////////////////

{

 The contents of this file are subject to the Mozilla Public License
 Version 1.1 (the "License"); you may not use this file except in compliance
 with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/

 Software distributed under the License is distributed on an "AS IS" basis,
 WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the
 specific language governing rights and limitations under the License.

 The original code is SZCodeBaseX.pas, released 15. July, 2004.

 The initial developer of the original code is
 Sasa Zeman ([e-mail], www.szutils.net)

 Copyright(C) 2004-2006 Sasa Zeman. All Rights Reserved.
}

{--------------------------------------------------------------------

Encode/Decode algorithms for Base16, Base32 and Base64
Reference: RFC 3548

- Universal Encode/Decode algorithms for Base16, Base32 and Base64
- Standard Base16, Base32 and Base64 encoding/decoding functions
- Reference: RFC 3548, full compatibility
- Full MIME suppport
- Supported work with Memory, Stream, String and Files
- Optionally supported work with padding keys (required numbers
  of '=' at the end of the encoded array)
- Very flexible work - you may easily create your own Encode/Decode functions
  based on your own specific codes, from Base2 up to Base128

Revision History:
----------------------------------

Version 1.3.3, 2006-12-10
  - Better demo
  - Some minor code reorganization

Version 1.3.2, 2005-07-09
  - Added external functions to calculate Required Output Memory
    Thanks to Grant.

Version 1.3.1, 2005-06-18
  - fixed runtime error in decoding when range checking is ON.
    Thanks to Grant.

Version 1.3.0, 2005-05-03
  - Added MIME support

Version 1.2.1, 2004-11-19
  - Added support for Memory, Stream and Files
  - Added support for Delphi 5 and BCB - pByte issue

Version 1.1.0, 2004-08-21
  - Optimized version, more than 35 times speed acceleration,
    one of the fastest and the simplest universal Base16/32/64 encoder/decoder

Version 1.0.0, 2004-07-15
  - Initial version

----------------------------------

  Author   : Sasa Zeman
  E-mail   : [e-mail] or [e-mail]
  Web site : www.szutils.net
}

interface

uses Windows, SysUtils, Types, Classes;

//////////////////////////////////////////////////////////////////
// Universal Encode/Decode algorithms for Base16, Base32 and Base64
// Actualy, you can create any variation you need, even by your own
// codes from Base2 to Base128
//////////////////////////////////////////////////////////////////

function SZEncodeBaseXMemory( pIN, pOUT: pByte; Size: integer; const Codes: String; BITS: integer; FullQuantum : integer; MIMELine: integer): integer;
function SZDecodeBaseXMemory( pIN, pOUT: pByte; Size: integer; const Codes: string; BITS: integer): integer;

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

function SZEncodeBaseXString(const S: string; const Codes: string; BITS: integer; FullQuantum : integer; MIMELine: integer): string;
function SZDecodeBaseXString(const S: string; const Codes: string; BITS: integer): string;

function SZEncodeBaseXFile(const FileName: String; sOUT: TStream; const Codes: string; BITS: integer; FullQuantum : integer; MIMELine: integer): integer;
// Decoding entire file is not supported, as is not logical - file may
// contain any data, or more than one encoded data
// Use the stream realization for precise and logical decoding - even
// for a part of a stream (fully supported)


//////////////////////////////////////////////////////////////////
// Calculates full reqired memory for output
// based on input size, BITS and needs for padding keys
//////////////////////////////////////////////////////////////////
function SZCalcRequireOutputMemory(TotalIn: integer; BITS, FullQuantum: integer; MIMELine: integer): integer;

// Calculates reqired ammount of padding keys based on output size
function SZCalcRequiredPaddingKeys(Size, FullQuantum: integer):Integer;

//////////////////////////////////////////////////////////////////
// ATTENTION!!!
// Next two functions are for testing purposes only.
// My be deleted in the future.
////////////////////////////////////////////////////////////////////
function SZFullEncodeOnlyBase64(const S: string; MIMELine: integer = 0): string;
function SZFullEncodeOnlyBase64_6(const S: string; MIMELine: integer = 0): string;

////////////////////////////////////////////////////////////////////
// Base 16
//////////////////////////////////////////////////////////////////
function SZEncodeBase16(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
function SZEncodeBase16(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
function SZEncodeBase16(const S: string; MIMELine: integer = 0): string; overload;
function SZEncodeBase16(const FileName: String; sOUT: TStream; MIMELine: integer = 0): integer; overload;

function SZDecodeBase16(pIN, pOUT: PByte; Size: integer): integer; overload;
function SZDecodeBase16(sIN, sOUT: TStream): integer; overload;
function SZDecodeBase16(const S: string): string; overload;

//////////////////////////////////////////////////////////////////
// Base32, Full encoding mean adding padding keys
//////////////////////////////////////////////////////////////////

function SZFullEncodeBase32(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
function SZFullEncodeBase32(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
function SZFullEncodeBase32(const S: string; MIMELine: integer = 0): string; overload;
function SZFullEncodeBase32(const FileName: String; sOUT: TStream; MIMELine: integer = 0): integer; overload;

function SZEncodeBase32(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
function SZEncodeBase32(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
function SZEncodeBase32(const S: string; MIMELine: integer = 0): string; overload;
function SZEncodeBase32(const FileName: String; sOUT: TStream; MIMELine: integer = 0): integer; overload;

function SZDecodeBase32(pIN, pOUT: PByte; Size: integer): integer; overload;
function SZDecodeBase32(sIN, sOUT: TStream): integer; overload;
function SZDecodeBase32(const S: string): string; overload;

//////////////////////////////////////////////////////////////////
// Base 64, Full encoding mean adding padding keys
//////////////////////////////////////////////////////////////////

function SZFullEncodeBase64(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
function SZFullEncodeBase64(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
function SZFullEncodeBase64(const S: string; MIMELine: integer = 0): string; overload;
function SZFullEncodeBase64(const FileName: String; sOUT: TStream; MIMELine: integer = 0): integer; overload;

function SZEncodeBase64(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
function SZEncodeBase64(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
function SZEncodeBase64(const S: string; MIMELine: integer = 0): string; overload;
function SZEncodeBase64(const FileName: String; sOUT: TStream; MIMELine: integer = 0): integer; overload;

function SZDecodeBase64(pIN, pOUT: PByte; Size: integer): integer; overload;
function SZDecodeBase64(sIN, sOUT: TStream): integer; overload;
function SZDecodeBase64(const S: string): string; overload;

//////////////////////////////////////////////////////////////////
// Base64 URL, Full encoding mean adding padding keys
//////////////////////////////////////////////////////////////////
function SZFullEncodeBase64URL(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
function SZFullEncodeBase64URL(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
function SZFullEncodeBase64URL(const S: string; MIMELine: integer = 0): string; overload;
function SZFullEncodeBase64URL(const FileName: String; sOUT: TStream; MIMELine: integer = 0): integer; overload;

function SZEncodeBase64URL(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
function SZEncodeBase64URL(sIN, sOUT: TStream; Size: integer=-1; MIMELine: integer = 0): integer; overload;
function SZEncodeBase64URL(const S: string; MIMELine: integer = 0): string; overload;
function SZEncodeBase64URL(const FileName: String; sOUT: TStream; MIMELine: integer = 0): integer; overload;

function SZDecodeBase64URL(pIN, pOUT: PByte; Size: integer): integer; overload;
function SZDecodeBase64URL(sIN, sOUT: TStream): integer; overload;
function SZDecodeBase64URL(const S: string): string; overload;

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

function SZCalcRequiredOutputMemoryForFullEncodeBase64(Size: integer; MIMELine: integer=0): integer;
function SZCalcRequiredOutputMemoryForFullEncodeBase32(Size: integer; MIMELine: integer=0): integer;

function SZCalcRequiredOutputMemoryForEncodeBase64(Size: integer; MIMELine: integer=0): integer;
function SZCalcRequiredOutputMemoryForEncodeBase32(Size: integer; MIMELine: integer=0): integer;

function SZCalcRequiredOutputMemoryForEncodeBase16(Size: integer; MIMELine: integer=0): integer;


//////////////////////////////////////////////////////////////////
// Setting Buffer Size procedure
//////////////////////////////////////////////////////////////////
procedure SZCodeBaseXSetBufferSize(Size:integer);
procedure SZCodeBaseXSetOrigBufferSize;
//////////////////////////////////////////////////////////////////

implementation

const

  // Basic size for buffer is 64KB
  SZORIGBUFFSIZE = 64*1024;

///////////////////////////////////////////
/// Base 64 definitions
///////////////////////////////////////////

  SZCodes64    = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  SZCodes64URL = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_';
  SZBITS64 = 6;

  // Resulted number of chars must be integral multiple of
  // 24 input bits div 6 output group bits
  SZFullQuantum64 = 24 div 6;

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

///////////////////////////////////////////
/// Base 32 definitions
///////////////////////////////////////////

  SZCodes32 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ234567';
  SZBITS32 = 5;

  // Resulted number of chars must be integral multiple of
  // 40 input bits div 5 output group bits
  SZFullQuantum32 = 40 div 5;

  // If there is no need for padding keys
  SZFullQuantum0 = 0;


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

///////////////////////////////////////////
/// Base 16 definitions
///////////////////////////////////////////

  SZCodes16 = '0123456789ABCDEF';
  SZBITS16 = 4;

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

type
  TFastDecodeTable=array[0..255] of byte;

var
  // Optimized buffer length for encoding files up to 64KB
  // Important for speed-up works with large streams

  SZBUFFSIZE: integer;

  SZFastDecodeTable: TFastDecodeTable;


////////////////////////////
// Basic Functions
////////////////////////////

procedure SZUpdateFastDecodeTable(const Codes: string);
var
  i: integer;
begin
  FillChar(SZFastDecodeTable,256,#0);

  for i := 1 to length(Codes) do
    SZFastDecodeTable[ byte( Codes[i] ) ] := i;
end;

function SZCalcRequiredPaddingKeys(Size, FullQuantum: integer):Integer;
{
  Adding necessary padding keys to create a full
  RFC 3548 compatibility string
}
var
  IM: integer;
begin
  IM:=Size mod FullQuantum;

  if IM>0 then
    Result:=FullQuantum-IM
  else
    Result:=0
end;

function SZCalcRequireOutputMemory(TotalIn: integer; BITS, FullQuantum: integer; MIMELine: integer): integer;
var
  TotalOut, IM, MIMEOut: integer;
begin

  TotalOut := TotalIn 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;

  if FullQuantum>0 then
  begin
    IM:=TotalOut mod FullQuantum;

    if IM>0 then
      TotalOut:= TotalOut + FullQuantum-IM;
  end;

  // Additional space for CRLF (2 bytes) if MIME encoding is required
  if MIMELine>0 then
    TotalOut:= TotalOut + MIMEOut;

  result:=TotalOut;
end;


procedure GetRelevantData(TotalIn: integer; var TotalOut: integer;
        BITS, FullQuantum: integer; var IM: integer; MIMELine: integer);
var
  MIMEOut: integer;
begin

  TotalOut:=TotalIn 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;

  if FullQuantum>0 then
  begin
    IM:=TotalOut mod FullQuantum;

    if IM>0 then
      TotalOut:= TotalOut + FullQuantum-IM;
  end
  else
    IM:=0;

  // Additional space for CRLF (2 bytes) if MIME encoding is required
  if MIMELine>0 then
    TotalOut:= TotalOut + MIMEOut
end;


////////////////////////////
// Memory
////////////////////////////


function SZEncodeBaseXMemoryUpdate(pIN: PByte; var pOUT: PByte; Size: integer; const Codes: String; BITS: integer; var vB8, VI8: integer; MIMELine: integer; Var MIMECountdown, MIMEBytesCount: integer): integer;
{
  Universal Encode algorithm for Base16, Base32 and Base64
  Reference: RFC 3548
  RFC incompatibility: No padding keys
}

const Mask: array [0..16] of Word=
( 0, 1, 3, 7, 15, 31, 63,
  127,255,511,1023, 2047,
  4095,8191,16383,32767,65535
);

var
  i,B8, I8, Count: integer;
  MIME: Boolean;
begin

  MIME:=MIMELine > 0;

  Count:=0;

  B8 := vB8;
  I8 := vI8;

  for i := 1 to Size do
  begin
    B8 := B8 shl 8;
    B8 := B8 or pIN^;
    I8 := I8 + 8;

    while I8 >= BITS do
    begin

      I8 := (I8 - BITS);

      // Get first BITS of bits
      pchar(pOUT)^ := Codes[(B8 shr I8)+1];
      inc(pOUT);

      inc(Count);

      if MIME then
      begin

        MIMECountdown := MIMECountdown - 1;

        if MIMECountdown <= 0 then
        begin
           MIMECountdown := MIMELine;
           MIMEBytesCount := MIMEBytesCount + 2;

           // Put CRLF
           pOUT^ := 13; inc(pOUT);
           pOUT^ := 10; inc(pOUT);

           inc(Count,2);

        end;

      end;

      //Return position back for BITS bits
      //B8 := B8 - ((B8 shr I8) shl I8);

      // The same result as upper code, a bit faster
      B8 := B8 and MASK[I8];

    end;