mirror-github-bspeice/apophysis7x
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
master
apophysis7x/IO/Base64.pas
xyrus02 95a2f54683 ADMIN: migration complete 
git-svn-id: https://svn.code.sf.net/p/apophysis7x/svn/trunk@1 a5d1c0f9-a0e9-45c6-87dd-9d276e40c949
2013-07-28 08:58:33 +00:00

268 lines
8.4 KiB
ObjectPascal
Raw Permalink Blame History

{
Apophysis Copyright (C) 2001-2004 Mark Townsend
Apophysis Copyright (C) 2005-2006 Ronald Hordijk, Piotr Borys, Peter Sdobnov
Apophysis Copyright (C) 2007-2008 Piotr Borys, Peter Sdobnov
Apophysis "3D hack" Copyright (C) 2007-2008 Peter Sdobnov
Apophysis "7X" Copyright (C) 2009-2010 Georg Kiehne
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
}
unit Base64;
interface
uses
Windows, Sysutils;
type TBinArray = Array of Byte;
{ Base64 encode and decode a string }
function B64Encode(const data: TBinArray; size : integer): string;
procedure B64Decode(S: string; var data : TBinArray; var size : integer);
{******************************************************************************}
{******************************************************************************}
implementation
const
B64Table= 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
procedure StringToBinArray(const s: String; var bin: TBinArray);
var
l: Integer;
begin
l := Length(s);
SetLength(bin, l);
CopyMemory(@bin[0], @s[1], l);
end;
procedure BinArrayToString(const bin: TBinArray; var s: string);
var
l: Integer;
begin
l := Length(bin);
SetLength(s, l);
CopyMemory(@s[1], @bin[0], l);
end;
function B64Encode(const data: TBinArray; size : integer) : string;
var
i: integer;
S: string;
InBuf: array[0..2] of byte;
OutBuf: array[0..3] of char;
begin
BinArrayToString(data, s);
SetLength(Result,((size+2) div 3)*4);
for i:= 1 to ((size+2) div 3) do
begin
if size< (i*3) then
Move(S[(i-1)*3+1],InBuf,size-(i-1)*3)
else
Move(S[(i-1)*3+1],InBuf,3);
OutBuf[0]:= B64Table[((InBuf[0] and $FC) shr 2) + 1];
OutBuf[1]:= B64Table[(((InBuf[0] and $03) shl 4) or ((InBuf[1] and $F0) shr 4)) + 1];
OutBuf[2]:= B64Table[(((InBuf[1] and $0F) shl 2) or ((InBuf[2] and $C0) shr 6)) + 1];
OutBuf[3]:= B64Table[(InBuf[2] and $3F) + 1];
Move(OutBuf,Result[(i-1)*4+1],4);
end;
if (size mod 3)= 1 then
begin
Result[Length(Result)-1]:= '=';
Result[Length(Result)]:= '=';
end
else if (Length(S) mod 3)= 2 then
Result[Length(Result)]:= '=';
end;
procedure B64Decode(S: string; var data : TBinArray; var size : integer);
var
i: integer;
InBuf: array[0..3] of byte;
OutBuf: array[0..2] of byte;
Result2: string;
begin
if (Length(S) mod 4)<> 0 then
raise Exception.Create('Base64: Incorrect string format');
SetLength(Result2,((Length(S) div 4)-1)*3);
for i:= 1 to ((Length(S) div 4)-1) do
begin
Move(S[(i-1)*4+1],InBuf,4);
if (InBuf[0]> 64) and (InBuf[0]< 91) then
Dec(InBuf[0],65)
else if (InBuf[0]> 96) and (InBuf[0]< 123) then
Dec(InBuf[0],71)
else if (InBuf[0]> 47) and (InBuf[0]< 58) then
Inc(InBuf[0],4)
else if InBuf[0]= 43 then
InBuf[0]:= 62
else
InBuf[0]:= 63;
if (InBuf[1]> 64) and (InBuf[1]< 91) then
Dec(InBuf[1],65)
else if (InBuf[1]> 96) and (InBuf[1]< 123) then
Dec(InBuf[1],71)
else if (InBuf[1]> 47) and (InBuf[1]< 58) then
Inc(InBuf[1],4)
else if InBuf[1]= 43 then
InBuf[1]:= 62
else
InBuf[1]:= 63;
if (InBuf[2]> 64) and (InBuf[2]< 91) then
Dec(InBuf[2],65)
else if (InBuf[2]> 96) and (InBuf[2]< 123) then
Dec(InBuf[2],71)
else if (InBuf[2]> 47) and (InBuf[2]< 58) then
Inc(InBuf[2],4)
else if InBuf[2]= 43 then
InBuf[2]:= 62
else
InBuf[2]:= 63;
if (InBuf[3]> 64) and (InBuf[3]< 91) then
Dec(InBuf[3],65)
else if (InBuf[3]> 96) and (InBuf[3]< 123) then
Dec(InBuf[3],71)
else if (InBuf[3]> 47) and (InBuf[3]< 58) then
Inc(InBuf[3],4)
else if InBuf[3]= 43 then
InBuf[3]:= 62
else
InBuf[3]:= 63;
OutBuf[0]:= (InBuf[0] shl 2) or ((InBuf[1] shr 4) and $03);
OutBuf[1]:= (InBuf[1] shl 4) or ((InBuf[2] shr 2) and $0F);
OutBuf[2]:= (InBuf[2] shl 6) or (InBuf[3] and $3F);
Move(OutBuf,Result2[(i-1)*3+1],3);
end;
if Length(S)<> 0 then
begin
Move(S[Length(S)-3],InBuf,4);
if InBuf[2]= 61 then
begin
if (InBuf[0]> 64) and (InBuf[0]< 91) then
Dec(InBuf[0],65)
else if (InBuf[0]> 96) and (InBuf[0]< 123) then
Dec(InBuf[0],71)
else if (InBuf[0]> 47) and (InBuf[0]< 58) then
Inc(InBuf[0],4)
else if InBuf[0]= 43 then
InBuf[0]:= 62
else
InBuf[0]:= 63;
if (InBuf[1]> 64) and (InBuf[1]< 91) then
Dec(InBuf[1],65)
else if (InBuf[1]> 96) and (InBuf[1]< 123) then
Dec(InBuf[1],71)
else if (InBuf[1]> 47) and (InBuf[1]< 58) then
Inc(InBuf[1],4)
else if InBuf[1]= 43 then
InBuf[1]:= 62
else
InBuf[1]:= 63;
OutBuf[0]:= (InBuf[0] shl 2) or ((InBuf[1] shr 4) and $03);
Result2:= Result2 + char(OutBuf[0]);
end
else if InBuf[3]= 61 then
begin
if (InBuf[0]> 64) and (InBuf[0]< 91) then
Dec(InBuf[0],65)
else if (InBuf[0]> 96) and (InBuf[0]< 123) then
Dec(InBuf[0],71)
else if (InBuf[0]> 47) and (InBuf[0]< 58) then
Inc(InBuf[0],4)
else if InBuf[0]= 43 then
InBuf[0]:= 62
else
InBuf[0]:= 63;
if (InBuf[1]> 64) and (InBuf[1]< 91) then
Dec(InBuf[1],65)
else if (InBuf[1]> 96) and (InBuf[1]< 123) then
Dec(InBuf[1],71)
else if (InBuf[1]> 47) and (InBuf[1]< 58) then
Inc(InBuf[1],4)
else if InBuf[1]= 43 then
InBuf[1]:= 62
else
InBuf[1]:= 63;
if (InBuf[2]> 64) and (InBuf[2]< 91) then
Dec(InBuf[2],65)
else if (InBuf[2]> 96) and (InBuf[2]< 123) then
Dec(InBuf[2],71)
else if (InBuf[2]> 47) and (InBuf[2]< 58) then
Inc(InBuf[2],4)
else if InBuf[2]= 43 then
InBuf[2]:= 62
else
InBuf[2]:= 63;
OutBuf[0]:= (InBuf[0] shl 2) or ((InBuf[1] shr 4) and $03);
OutBuf[1]:= (InBuf[1] shl 4) or ((InBuf[2] shr 2) and $0F);
Result2:= Result2 + char(OutBuf[0]) + char(OutBuf[1]);
end
else
begin
if (InBuf[0]> 64) and (InBuf[0]< 91) then
Dec(InBuf[0],65)
else if (InBuf[0]> 96) and (InBuf[0]< 123) then
Dec(InBuf[0],71)
else if (InBuf[0]> 47) and (InBuf[0]< 58) then
Inc(InBuf[0],4)
else if InBuf[0]= 43 then
InBuf[0]:= 62
else
InBuf[0]:= 63;
if (InBuf[1]> 64) and (InBuf[1]< 91) then
Dec(InBuf[1],65)
else if (InBuf[1]> 96) and (InBuf[1]< 123) then
Dec(InBuf[1],71)
else if (InBuf[1]> 47) and (InBuf[1]< 58) then
Inc(InBuf[1],4)
else if InBuf[1]= 43 then
InBuf[1]:= 62
else
InBuf[1]:= 63;
if (InBuf[2]> 64) and (InBuf[2]< 91) then
Dec(InBuf[2],65)
else if (InBuf[2]> 96) and (InBuf[2]< 123) then
Dec(InBuf[2],71)
else if (InBuf[2]> 47) and (InBuf[2]< 58) then
Inc(InBuf[2],4)
else if InBuf[2]= 43 then
InBuf[2]:= 62
else
InBuf[2]:= 63;
if (InBuf[3]> 64) and (InBuf[3]< 91) then
Dec(InBuf[3],65)
else if (InBuf[3]> 96) and (InBuf[3]< 123) then
Dec(InBuf[3],71)
else if (InBuf[3]> 47) and (InBuf[3]< 58) then
Inc(InBuf[3],4)
else if InBuf[3]= 43 then
InBuf[3]:= 62
else
InBuf[3]:= 63;
OutBuf[0]:= (InBuf[0] shl 2) or ((InBuf[1] shr 4) and $03);
OutBuf[1]:= (InBuf[1] shl 4) or ((InBuf[2] shr 2) and $0F);
OutBuf[2]:= (InBuf[2] shl 6) or (InBuf[3] and $3F);
Result2:= Result2 + Char(OutBuf[0]) + Char(OutBuf[1]) + Char(OutBuf[2]);
end;
end;
StringToBinArray(Result2, data);
size := Length(result2);
end;
end.
Reference in New Issue View Git Blame Copy Permalink