272 lines
9.7 KiB
ObjectPascal
272 lines
9.7 KiB
ObjectPascal
{******************************************************************************}
|
|
{ }
|
|
{ Library: Fundamentals 5.00 }
|
|
{ File name: flcBase64.pas }
|
|
{ File version: 5.03 }
|
|
{ Description: Base64 encoding/decoding }
|
|
{ }
|
|
{ Copyright: Copyright (c) 2002-2020, David J Butler }
|
|
{ All rights reserved. }
|
|
{ Redistribution and use in source and binary forms, with }
|
|
{ or without modification, are permitted provided that }
|
|
{ the following conditions are met: }
|
|
{ Redistributions of source code must retain the above }
|
|
{ copyright notice, this list of conditions and the }
|
|
{ following disclaimer. }
|
|
{ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND }
|
|
{ CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED }
|
|
{ WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED }
|
|
{ WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A }
|
|
{ PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL }
|
|
{ THE REGENTS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, }
|
|
{ INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR }
|
|
{ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, }
|
|
{ PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF }
|
|
{ USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) }
|
|
{ HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER }
|
|
{ IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING }
|
|
{ NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE }
|
|
{ USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE }
|
|
{ POSSIBILITY OF SUCH DAMAGE. }
|
|
{ }
|
|
{ Github: https://github.com/fundamentalslib }
|
|
{ E-mail: fundamentals.library at gmail.com }
|
|
{ }
|
|
{ Revision history: }
|
|
{ }
|
|
{ 2002/01/03 2.01 Added EncodeBase64, DecodeBase64 from cMaths and }
|
|
{ optimized. }
|
|
{ 2002/03/30 2.02 Fixed bug in DecodeBase64. }
|
|
{ 2017/10/07 5.03 Moved from flcUtils. }
|
|
{ }
|
|
{ Supported compilers: }
|
|
{ }
|
|
{ Delphi 2010-10.4 Win32/Win64 5.03 2020/06/02 }
|
|
{ Delphi 10.2-10.4 Linux64 5.03 2020/06/02 }
|
|
{ FreePascal 3.0.4 Win64 5.03 2020/06/02 }
|
|
{ }
|
|
{******************************************************************************}
|
|
|
|
{$INCLUDE ..\flcInclude.inc}
|
|
|
|
{$IFDEF FREEPASCAL}
|
|
{$WARNINGS OFF}
|
|
{$HINTS OFF}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF DEBUG}
|
|
{$IFDEF TEST}
|
|
{$DEFINE BASE64_TEST}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
unit flcBase64;
|
|
|
|
interface
|
|
|
|
uses
|
|
{ Fundamentals }
|
|
flcStdTypes;
|
|
|
|
|
|
|
|
{ }
|
|
{ Base64 }
|
|
{ }
|
|
{ EncodeBase64 converts a binary string (S) to a base 64 string using }
|
|
{ Alphabet. if Pad is True, the result will be padded with PadChar to be a }
|
|
{ multiple of PadMultiple. }
|
|
{ }
|
|
{ DecodeBase64 converts a base 64 string using Alphabet (64 characters for }
|
|
{ values 0-63) to a binary string. }
|
|
{ }
|
|
function EncodeBase64(const S, Alphabet: RawByteString;
|
|
const Pad: Boolean = False;
|
|
const PadMultiple: Integer = 4;
|
|
const PadChar: AnsiChar = AnsiChar(Ord('='))): RawByteString;
|
|
|
|
function DecodeBase64(const S, Alphabet: RawByteString;
|
|
const PadSet: ByteCharSet = []): RawByteString;
|
|
|
|
const
|
|
b64_MIMEBase64 : RawByteString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
|
|
b64_UUEncode : RawByteString = ' !"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
|
|
b64_XXEncode : RawByteString = '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
|
|
|
|
function MIMEBase64Decode(const S: RawByteString): RawByteString;
|
|
function MIMEBase64Encode(const S: RawByteString): RawByteString;
|
|
function UUDecode(const S: RawByteString): RawByteString;
|
|
function XXDecode(const S: RawByteString): RawByteString;
|
|
|
|
|
|
|
|
implementation
|
|
|
|
|
|
|
|
{ }
|
|
{ Base64 }
|
|
{ }
|
|
function EncodeBase64(const S, Alphabet: RawByteString; const Pad: Boolean;
|
|
const PadMultiple: Integer; const PadChar: AnsiChar): RawByteString;
|
|
var
|
|
R, C : Byte;
|
|
F, L, M, N, U : Integer;
|
|
P : PByteChar;
|
|
T : Boolean;
|
|
begin
|
|
Assert(Length(Alphabet) = 64);
|
|
{$IFOPT R+}
|
|
if Length(Alphabet) <> 64 then
|
|
begin
|
|
Result := '';
|
|
exit;
|
|
end;
|
|
{$ENDIF}
|
|
L := Length(S);
|
|
if L = 0 then
|
|
begin
|
|
Result := '';
|
|
exit;
|
|
end;
|
|
M := L mod 3;
|
|
N := (L div 3) * 4 + M;
|
|
if M > 0 then
|
|
Inc(N);
|
|
T := Pad and (PadMultiple > 1);
|
|
if T then
|
|
begin
|
|
U := N mod PadMultiple;
|
|
if U > 0 then
|
|
begin
|
|
U := PadMultiple - U;
|
|
Inc(N, U);
|
|
end;
|
|
end else
|
|
U := 0;
|
|
SetLength(Result, N);
|
|
P := Pointer(Result);
|
|
R := 0;
|
|
for F := 0 to L - 1 do
|
|
begin
|
|
C := Byte(S [F + 1]);
|
|
case F mod 3 of
|
|
0 : begin
|
|
P^ := Alphabet[C shr 2 + 1];
|
|
Inc(P);
|
|
R := (C and 3) shl 4;
|
|
end;
|
|
1 : begin
|
|
P^ := Alphabet[C shr 4 + R + 1];
|
|
Inc(P);
|
|
R := (C and $0F) shl 2;
|
|
end;
|
|
2 : begin
|
|
P^ := Alphabet[C shr 6 + R + 1];
|
|
Inc(P);
|
|
P^ := Alphabet[C and $3F + 1];
|
|
Inc(P);
|
|
end;
|
|
end;
|
|
end;
|
|
if M > 0 then
|
|
begin
|
|
P^ := Alphabet[R + 1];
|
|
Inc(P);
|
|
end;
|
|
for F := 1 to U do
|
|
begin
|
|
P^ := PadChar;
|
|
Inc(P);
|
|
end;
|
|
end;
|
|
|
|
function DecodeBase64(const S, Alphabet: RawByteString; const PadSet: ByteCharSet): RawByteString;
|
|
var
|
|
F, L, M, P : Integer;
|
|
B, OutPos : Byte;
|
|
OutB : array[1..3] of Byte;
|
|
Lookup : array[AnsiChar] of Byte;
|
|
R : PByteChar;
|
|
begin
|
|
Assert(Length(Alphabet) = 64);
|
|
{$IFOPT R+}
|
|
if Length(Alphabet) <> 64 then
|
|
begin
|
|
Result := '';
|
|
exit;
|
|
end;
|
|
{$ENDIF}
|
|
L := Length(S);
|
|
P := 0;
|
|
if PadSet <> [] then
|
|
while (L - P > 0) and (S[L - P] in PadSet) do
|
|
Inc(P);
|
|
M := L - P;
|
|
if M = 0 then
|
|
begin
|
|
Result := '';
|
|
exit;
|
|
end;
|
|
SetLength(Result, (M * 3) div 4);
|
|
FillChar(Lookup, Sizeof(Lookup), #0);
|
|
for F := 0 to 63 do
|
|
Lookup[Alphabet[F + 1]] := Byte(F);
|
|
R := Pointer(Result);
|
|
OutPos := 0;
|
|
for F := 1 to L - P do
|
|
begin
|
|
B := Lookup[S[F]];
|
|
case OutPos of
|
|
0 : OutB[1] := B shl 2;
|
|
1 : begin
|
|
OutB[1] := OutB[1] or (B shr 4);
|
|
R^ := AnsiChar(OutB[1]);
|
|
Inc(R);
|
|
OutB[2] := (B shl 4) and $FF;
|
|
end;
|
|
2 : begin
|
|
OutB[2] := OutB[2] or (B shr 2);
|
|
R^ := AnsiChar(OutB[2]);
|
|
Inc(R);
|
|
OutB[3] := (B shl 6) and $FF;
|
|
end;
|
|
3 : begin
|
|
OutB[3] := OutB[3] or B;
|
|
R^ := AnsiChar(OutB[3]);
|
|
Inc(R);
|
|
end;
|
|
end;
|
|
OutPos := (OutPos + 1) mod 4;
|
|
end;
|
|
if (OutPos > 0) and (P = 0) then // incomplete encoding, add the partial byte if not 0
|
|
if OutB[OutPos] <> 0 then
|
|
Result := Result + ByteChar(OutB[OutPos]);
|
|
end;
|
|
|
|
function MIMEBase64Encode(const S: RawByteString): RawByteString;
|
|
begin
|
|
Result := EncodeBase64(S, b64_MIMEBase64, True, 4, AnsiChar(Ord('=')));
|
|
end;
|
|
|
|
function UUDecode(const S: RawByteString): RawByteString;
|
|
begin
|
|
// Line without size indicator (first byte = length + 32)
|
|
Result := DecodeBase64(S, b64_UUEncode, [AnsiChar(Ord('`'))]);
|
|
end;
|
|
|
|
function MIMEBase64Decode(const S: RawByteString): RawByteString;
|
|
begin
|
|
Result := DecodeBase64(S, b64_MIMEBase64, [AnsiChar(Ord('='))]);
|
|
end;
|
|
|
|
function XXDecode(const S: RawByteString): RawByteString;
|
|
begin
|
|
Result := DecodeBase64(S, b64_XXEncode, []);
|
|
end;
|
|
|
|
|
|
|
|
end.
|
|
|