{$O+} // Optimization must be ON
{$R-} // Range checking must be OFF
unit SZCodeBaseX;
/////////////////////////////
// Version 1.3.5
////////////////////////////
{
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 (public@szutils.net, www.szutils.net)
Copyright(C) 2004-2007 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.5, 2007-07-02
-------------------------
- Bugfix on SZCodeBaseXSetBufferSize;
-------------------------
Version 1.3.4, 2007-03-10
-------------------------
- Cleaning some useless code
- Some minor code tweaks
- Demo update
-------------------------
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 : public@szutils.net or sasaz72@mail.ru
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
//////////////////////////////////////////////////////////////////
const
SZCodeBaseXver='1.3.5';
function SZEncodeBaseXMemory( pIN, pOUT: pByte; Size: integer; const Codes: AnsiString; BITS: integer; FullQuantum : integer; MIMELine: integer): integer;
function SZDecodeBaseXMemory( pIN, pOUT: pByte; Size: integer; const Codes: AnsiString; BITS: integer): integer;
function SZEncodeBaseXStream(sIN, sOUT: TStream; Size: integer; const Codes: AnsiString; BITS: integer; FullQuantum : integer; MIMELine: integer ): integer;
function SZDecodeBaseXStream(sIN, sOUT: TStream; const Codes: AnsiString; BITS: integer): integer;
function SZEncodeBaseXString(const S: AnsiString; const Codes: AnsiString; BITS: integer; FullQuantum : integer; MIMELine: integer): AnsiString;
function SZDecodeBaseXString(const S: AnsiString; const Codes: AnsiString; BITS: integer): AnsiString;
function SZEncodeBaseXFile(const FileName: AnsiString; sOUT: TStream; const Codes: AnsiString; 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: AnsiString; MIMELine: integer = 0): AnsiString;
function SZFullEncodeOnlyBase64_6(const S: AnsiString; MIMELine: integer = 0): AnsiString;
////////////////////////////////////////////////////////////////////
// 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: AnsiString; MIMELine: integer = 0): AnsiString; overload;
function SZEncodeBase16(const FileName: AnsiString; 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: AnsiString): AnsiString; 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: AnsiString; MIMELine: integer = 0): AnsiString; overload;
function SZFullEncodeBase32(const FileName: AnsiString; 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: AnsiString; MIMELine: integer = 0): AnsiString; overload;
function SZEncodeBase32(const FileName: AnsiString; 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: AnsiString): AnsiString; 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: AnsiString; MIMELine: integer = 0): AnsiString; overload;
function SZFullEncodeBase64(const FileName: AnsiString; 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: AnsiString; MIMELine: integer = 0): AnsiString; overload;
function SZEncodeBase64(const FileName: AnsiString; 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: AnsiString): AnsiString; 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: AnsiString; MIMELine: integer = 0): AnsiString; overload;
function SZFullEncodeBase64URL(const FileName: AnsiString; 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: AnsiString; MIMELine: integer = 0): AnsiString; overload;
function SZEncodeBase64URL(const FileName: AnsiString; 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: AnsiString): AnsiString; 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: AnsiString);
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
if FullQuantum>0 then
IM:=Size mod FullQuantum
else
IM:=0;
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) ) shl 1 // * 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) ) shl 1 // * 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: AnsiString; 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
PAnsiChar(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;
inc(pIN);
end;
vB8 := B8;
vI8 := I8;
result:=Count;
end;
function SZEncodeBaseXMemoryFinalyze(var pOUT: PByte; const Codes: AnsiString; BITS: integer; B8, I8: integer): integer;
// Finalyzing encoding with last left bites (if any)
begin
// If something left
if I8 > 0 then
begin
PAnsiChar(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: AnsiString; 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;
MIMECountdown := MIMELine;
MIMEBytesCount := 0;
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,'=');
PAnsiChar(ppOut):=PAnsiChar(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: AnsiString; 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: AnsiString; const Codes: AnsiString; BITS: integer): AnsiString;
var
TotalIn : integer;
TotalOut : integer;
pIN,pOUT: pByte;
begin
TotalIn := length(S);
TotalOut := (TotalIn * BITS) shr 3; // 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: AnsiString; const Codes: AnsiString; BITS: integer; FullQuantum : integer ; MIMELine : integer): AnsiString;
// Universal Encode algorithm for Base16, Base32 and Base64
var
pIN, pOUT: pByte;
TotalIn, TotalOut: integer;
IM: integer;
LOut: integer;
begin
TotalIn := length(S);
// Calculate relevant data
GetRelevantData(TotalIn, TotalOut, BITS, FullQuantum, IM, MIMELine);
SetLength(Result,TotalOut);
pIN :=@S[1];
pOUT:=@Result[1];
LOut:=SZEncodeBaseXMemory(pIn,pOut, TotalIn, Codes, BITS, FullQuantum, MIMELine);
if Lout<>TotalOut then
SetLength(Result,LOut);
end;
//////////////////////////
// Stream
//////////////////////////
function SZEncodeBaseXStreamUpdate(sIN, sOUT: TStream; Size: integer; const Codes: AnsiString; 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) ) shl 1 // * 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: AnsiString; 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: AnsiString; BITS: integer; FullQuantum : integer; MIMELine : integer): integer;
var
B8, I8: integer;
TotalIn : integer;
TotalOut : integer;
IM : integer;
MIMECountdown : integer;
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(PAnsiChar(StringOfChar('=',IM))^,IM);
TotalOut:=TotalOut+IM
end
end;
result:=TotalOut;
end;
function SZDecodeBaseXStream(sIN, sOUT: TStream; const Codes: AnsiString; 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: AnsiString; sOUT: TStream; const Codes: AnsiString; 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: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes64, SZBITS64, SZFullQuantum64, MIMELine);
end;
function SZFullEncodeBase64URL(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes64URL, SZBITS64, SZFullQuantum64, MIMELine);
end;
function SZEncodeBase64(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes64, SZBITS64, SZFullQuantum0, MIMELine);
end;
function SZEncodeBase64URL(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes64URL, SZBITS64, SZFullQuantum0, MIMELine);
end;
function SZFullEncodeBase32(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes32, SZBITS32, SZFullQuantum32, MIMELine);
end;
function SZEncodeBase32(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes32, SZBITS32, SZFullQuantum0, MIMELine);
end;
function SZEncodeBase16(const FileName: AnsiString; sOUT: TStream; MIMELine: integer = 0): integer; overload;
begin
result:=SZEncodeBaseXFile(FileName, sOUT, SZCodes16, SZBITS16, SZFullQuantum0, MIMELine);
end;
////////////////////////////////////////////////////////////
/// Base16
////////////////////////////////////////////////////////////
function SZEncodeBase16(pIN, pOUT: PByte; Size: integer; MIMELine: integer = 0): integer; overload;
begin
result:= SZEncodeBaseXMemory(pIN,pOUT, Size, SZCodes16, SZBITS16, SZFullQuantum0, MIMELine);
end;
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: AnsiString; MIMELine: integer = 0): AnsiString; 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: AnsiString): AnsiString; 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: AnsiString; MIMELine: integer = 0): AnsiString; 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: AnsiString; MIMELine: integer = 0): AnsiString; 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: AnsiString): AnsiString; 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: AnsiString; MIMELine: integer = 0): AnsiString; 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: AnsiString; MIMELine: integer = 0): AnsiString; 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: AnsiString): AnsiString; 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: AnsiString; MIMELine: integer = 0): AnsiString; 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: AnsiString; MIMELine: integer = 0): AnsiString; 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: AnsiString): AnsiString; 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 OF ACTUAL CODE
//////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////
//Additional code may be deleted in the future
//////////////////////////////////////////////////////////////
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: AnsiString; MIMELine: integer = 0): AnsiString;
{
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: AnsiString; MIMELine: integer = 0): AnsiString;
{
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.
unit Code64;
interface
function Encode64(S: string): string;
function Decode64(S: string): string;
function Encode64Unicode(S: string): string;
function Decode64Unicode(S: string): string;
implementation
const
Codes64 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
function Encode64(S: string): string;
var
i: Integer;
a: Integer;
x: Integer;
b: Integer;
begin
Result := '';
a := 0;
b := 0;
for i := 1 to Length(s) do
begin
x := Ord(s[i]);
b := b * 256 + x;
a := a + 8;
while a >= 6 do
begin
a := a - 6;
x := b SHR a;//div (1 shl a);
b := b AND ((1 SHL a)-1); //mod (1 shl a);
Result := Result + Codes64[x + 1];
end;
end;
if a > 0 then
begin
x := b shl (6 - a);
Result := Result + Codes64[x + 1];
end;
end;
function Decode64(S: string): string;
var
i: Integer;
a: Integer;
x: Integer;
b: Integer;
begin
Result := '';
a := 0;
b := 0;
for i := 1 to Length(s) do
begin
x := Pos(s[i], codes64) - 1;
if x >= 0 then
begin
b := b * 64 + x;
a := a + 6;
if a >= 8 then
begin
a := a - 8;
x := b shr a;
b := b AND ((1 SHL a)-1);
Result := Result + chr(x);
end;
end
else
Exit;
end;
end;
function Encode64Unicode(S: WideString): ANSIString;
var
i: Integer;
a: Integer;
x: Integer;
b: Integer;
p : pByte;
l :Integer;
begin
Result := '';
a := 0;
b := 0;
l:=Length(s)*SizeOf(WideChar);
p:=pByte(@s[1]);
for i := 0 to L-1 do
begin
x := p^;
Inc(p);
b := b * 256 + x;
a := a + 8;
while a >= 6 do
begin
a := a - 6;
x := b SHR a;//div (1 shl a);
b := b AND ((1 SHL a)-1); //mod (1 shl a);
Result := Result + Codes64[x + 1];
end;
end;
if a > 0 then
begin
x := b shl (6 - a);
Result := Result + Codes64[x + 1];
end;
end;
function Decode64Unicode(S: ANSIString): WideString;
var
i: Integer;
a: Integer;
x: Integer;
b: Integer;
p : pByte;
begin
Result := '';
a := 0;
b := 0;
SetLength(Result, (length(s)+ 2) div 3 * 4);
p:=pByte(@Result[1]);
for i := 1 to Length(s) do
begin
x := Pos(s[i], codes64) - 1;
if x >= 0 then
begin
b := b * 64 + x;
a := a + 6;
if a >= 8 then
begin
a := a - 8;
x := b shr a;
b := b AND ((1 SHL a)-1);
p^:= x;
Inc(p);
//Result := Result + chr(x);
end;
end
else
Exit;
end;
end;
end.
so, I think you have to change all string types into unit to AnsiString
or maybe there is a compiler directive for that?