pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Base32 encoding + tests

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1357 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
inoussa
2010-10-27 21:20:19 +00:00
parent ceee4a61cd
commit 2fd9828e4e
2 changed files with 346 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

194
wst/trunk/basex_encode.pas
View File

@ -21,6 +21,7 @@ type
EBaseXException = class(Exception);
EBase16Exception = class(EBaseXException);
EBase32Exception = class(EBaseXException);
EBase64Exception = class(EBaseXException);
TBaseXOption = ( xoDecodeIgnoreIllegalChar );
@ -30,6 +31,10 @@ type
function Base64Encode(const AInBuffer : TBinaryString) : string;overload;
function Base64Decode(const AInBuffer : string; const AOptions : TBaseXOptions) : TByteDynArray;overload;
function Base32Encode(const ALength : PtrInt; const AInBuffer) : string; overload;
function Base32Encode(const AInBuffer : TBinaryString) : string; overload;
function Base32Decode(const AInBuffer : string; const AOptions : TBaseXOptions) : TByteDynArray;
procedure Base16Encode(const ABin; const ALen : Integer; AOutBuffer : PChar); overload;
function Base16Encode(const ABin; const ALen : Integer) : string; overload;
function Base16Encode(const AInBuffer : TBinaryString) : string;overload;
@ -203,6 +208,195 @@ begin
Move(locRes[0],Result[1],Length(Result));
end;
const
Base32_CHAR_TABLE : array[0..31] of char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ234567';
function Base32Encode(const ALength : PtrInt; const AInBuffer) : string;
var
locBuffer : PByte;
locCopied, locBlockCount, i, locAtualLen : PtrInt;
locInQuantom : array[0..4] of Byte;
locOutQuantom : array[0..7] of Char;
begin
Result := '';
if ( ALength > 0 ) then begin
locBuffer := @AInBuffer;
locBlockCount := ALength div 5;
SetLength(Result,(locBlockCount + 1 ) * 8);
locAtualLen := 0;
for i := 1 to locBlockCount do begin
Move(locBuffer^,locInQuantom[0],5);
Inc(locBuffer,5);
locOutQuantom[0] := Base32_CHAR_TABLE[(locInQuantom[0] shr 3)];
locOutQuantom[1] := Base32_CHAR_TABLE[( (locInQuantom[0] and 7) shl 2 ) or ( locInQuantom[1] shr 6 )];
locOutQuantom[2] := Base32_CHAR_TABLE[( (locInQuantom[1] and 62) shr 1 )];
locOutQuantom[3] := Base32_CHAR_TABLE[( (locInQuantom[1] and 1) shl 4 ) or ( locInQuantom[2] shr 4 )];
locOutQuantom[4] := Base32_CHAR_TABLE[( (locInQuantom[2] and 15) shl 1 ) or ( locInQuantom[3] shr 7 )];
locOutQuantom[5] := Base32_CHAR_TABLE[( (locInQuantom[3] and 124) shr 2 )];
locOutQuantom[6] := Base32_CHAR_TABLE[( (locInQuantom[3] and 3) shl 3 ) or ( locInQuantom[4] shr 5 )];
locOutQuantom[7] := Base32_CHAR_TABLE[(locInQuantom[4] and 31)];
Move(locOutQuantom[0],Result[locAtualLen + 1],( 8 * SizeOf(Char) ));
Inc(locAtualLen,8);
end;
locCopied := ALength mod 5;
if ( locCopied > 0 ) then begin
case locCopied of
1 :
begin
Move(locBuffer^,locInQuantom[0],1);
locInQuantom[1] := 0;
locOutQuantom[0] := Base32_CHAR_TABLE[(locInQuantom[0] shr 3)];
locOutQuantom[1] := Base32_CHAR_TABLE[( (locInQuantom[0] and 7) shl 2 ) or ( locInQuantom[1] shr 6 )];
locOutQuantom[2] := '=';
locOutQuantom[3] := '=';
locOutQuantom[4] := '=';
locOutQuantom[5] := '=';
locOutQuantom[6] := '=';
locOutQuantom[7] := '=';
end;
2 :
begin
Move(locBuffer^,locInQuantom[0],2);
locInQuantom[2] := 0;
locOutQuantom[0] := Base32_CHAR_TABLE[(locInQuantom[0] shr 3)];
locOutQuantom[1] := Base32_CHAR_TABLE[( (locInQuantom[0] and 7) shl 2 ) or ( locInQuantom[1] shr 6 )];
locOutQuantom[2] := Base32_CHAR_TABLE[( (locInQuantom[1] and 62) shr 1 )];
locOutQuantom[3] := Base32_CHAR_TABLE[( (locInQuantom[1] and 1) shl 4 ) or ( locInQuantom[2] shr 4 )];
locOutQuantom[4] := '=';
locOutQuantom[5] := '=';
locOutQuantom[6] := '=';
locOutQuantom[7] := '=';
end;
3 :
begin
Move(locBuffer^,locInQuantom[0],3);
locInQuantom[3] := 0;
locOutQuantom[0] := Base32_CHAR_TABLE[(locInQuantom[0] shr 3)];
locOutQuantom[1] := Base32_CHAR_TABLE[( (locInQuantom[0] and 7) shl 2 ) or ( locInQuantom[1] shr 6 )];
locOutQuantom[2] := Base32_CHAR_TABLE[( (locInQuantom[1] and 62) shr 1 )];
locOutQuantom[3] := Base32_CHAR_TABLE[( (locInQuantom[1] and 1) shl 4 ) or ( locInQuantom[2] shr 4 )];
locOutQuantom[4] := Base32_CHAR_TABLE[( (locInQuantom[2] and 15) shl 1 ) or ( locInQuantom[3] shr 7 )];
locOutQuantom[5] := '=';
locOutQuantom[6] := '=';
locOutQuantom[7] := '=';
end;
4 :
begin
Move(locBuffer^,locInQuantom[0],4);
locInQuantom[4] := 0;
locOutQuantom[0] := Base32_CHAR_TABLE[(locInQuantom[0] shr 3)];
locOutQuantom[1] := Base32_CHAR_TABLE[( (locInQuantom[0] and 7) shl 2 ) or ( locInQuantom[1] shr 6 )];
locOutQuantom[2] := Base32_CHAR_TABLE[( (locInQuantom[1] and 62) shr 1 )];
locOutQuantom[3] := Base32_CHAR_TABLE[( (locInQuantom[1] and 1) shl 4 ) or ( locInQuantom[2] shr 4 )];
locOutQuantom[4] := Base32_CHAR_TABLE[( (locInQuantom[2] and 15) shl 1 ) or ( locInQuantom[3] shr 7 )];
locOutQuantom[5] := Base32_CHAR_TABLE[( (locInQuantom[3] and 124) shr 2 )];
locOutQuantom[6] := Base32_CHAR_TABLE[( (locInQuantom[3] and 3) shl 3 ) or ( locInQuantom[4] shr 5 )];
locOutQuantom[7] := '=';
end;
end;
Move(locOutQuantom[0],Result[locAtualLen + 1],(8 * SizeOf(Char)));
Inc(locAtualLen,8);
end;
SetLength(Result,locAtualLen);
end;
end;
function Base32Encode(const AInBuffer : TBinaryString) : string;
begin
if ( Length(AInBuffer) = 0 ) then
Result := ''
else
Result := Base32Encode(Length(AInBuffer),AInBuffer[1]);
end;
function Base32Decode(const AInBuffer : string; const AOptions : TBaseXOptions) : TByteDynArray;
const
ALPHA_UP_MAP : array['A'..'Z'] of Byte = (
0 , 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
16, 17, 18, 19, 20, 21, 22, 23, 24, 25
);
ALPHA_LOW_MAP : array['a'..'z'] of Byte = (
0 , 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
16, 17, 18, 19, 20, 21, 22, 23, 24, 25
);
DIGIT_MAP : array['2'..'7'] of Byte = ( 26, 27, 28, 29, 30, 31);
var
locBuffer : PChar;
locInLen, locInIndex, i, locPadded : PtrInt;
locOutQuantom : array[0..4] of Byte;
locInQuantom : array[0..7] of Byte;
ok : Boolean;
locAtualLen : PtrInt;
locInValue, locReadedValidChars : Byte;
locFailOnIllegalChar : Boolean;
locTrueData : Integer;
begin
if ( AInBuffer = '' ) then begin
Result := nil;
end else begin
locInIndex := 0;
locAtualLen := 0;
locPadded := 0;
locInLen := Length(AInBuffer);
SetLength(Result,locInLen);
locBuffer := @(AInBuffer[1]);
locFailOnIllegalChar := not ( xoDecodeIgnoreIllegalChar in AOptions );
while ( locInIndex < locInLen ) do begin
locReadedValidChars := 0;
for i := 0 to 7 do begin
ok := False;
while ( locInIndex <= locInLen ) do begin
case locBuffer^ of
'A'..'Z' : locInValue := ALPHA_UP_MAP[locBuffer^];
'a'..'z' : locInValue := ALPHA_LOW_MAP[locBuffer^];
'2'..'7' : locInValue := DIGIT_MAP[locBuffer^];
'=' : locInValue := 0;
else begin
if locFailOnIllegalChar then
raise EBase32Exception.CreateFmt(SERR_IllegalChar,[Char(locBuffer^)]);
Inc(locBuffer);
Inc(locInIndex);
Continue;
end;
end;
Inc(locBuffer);
Inc(locInIndex);
locInQuantom[i] := locInValue;
if ( locBuffer^ = '=' ) then
Inc(locPadded);
ok := True;
Inc(locReadedValidChars);
Break;
end;
if ( not ok ) and locFailOnIllegalChar then
raise EBase64Exception.CreateFmt(SERR_IllegalChar,[Char(locBuffer^)]);
end;
if ( locReadedValidChars > 0 ) then begin
locOutQuantom[0] := ( locInQuantom[0] shl 3 ) or ( locInQuantom[1] shr 2 );
locOutQuantom[1] := ( (locInQuantom[1] shl 6) and 192 ) or
( (locInQuantom[2] shl 1) and 62) or
(locInQuantom[3] shr 4);
locOutQuantom[2] := ((locInQuantom[3] shl 4) and 240) or ( locInQuantom[4] shr 1);
locOutQuantom[3] := ((locInQuantom[4] shl 7) and 128) or
((locInQuantom[5] shl 2) and 124) or
(locInQuantom[6] shr 3);
locOutQuantom[4] := ((locInQuantom[6] shl 5) and 224) or locInQuantom[7];
case locPadded of
6 : locTrueData := 1;
4 : locTrueData := 2;
3 : locTrueData := 3;
1 : locTrueData := 4;
else
locTrueData := 5;
end;
Move(locOutQuantom[0],Result[locAtualLen],locTrueData);
Inc(locAtualLen,locTrueData);
end;
end;
SetLength(Result,locAtualLen);
end;
end;
procedure Base16Encode(const ABin; const ALen : Integer; AOutBuffer : PChar);
const
HEX_MAP : array[0..15] of Char = '0123456789ABCDEF';

152
wst/trunk/tests/test_suite/test_basex_encode.pas
View File

@ -49,6 +49,31 @@ type
procedure Decode_illegal_char();
procedure Decode_empty();
end;
{ TTest_Base32 }
TTest_Base32 = class(TWstBaseTest)
protected
procedure Check_Encode(const AIn, AExpect : string);
procedure Check_Decode(const AIn, AExpect : string; const AOptions : TBaseXOptions = [xoDecodeIgnoreIllegalChar]);
published
procedure Encode_empty();
procedure Encode_f();
procedure Encode_fo();
procedure Encode_foo();
procedure Encode_foob();
procedure Encode_fooba();
procedure Encode_foobar();
procedure Decode_f();
procedure Decode_fo();
procedure Decode_foo();
procedure Decode_foob();
procedure Decode_fooba();
procedure Decode_foobar();
procedure Decode_illegal_char();
procedure Decode_empty();
end;
TTest_Base16 = class(TWstBaseTest)
protected
@ -200,6 +225,132 @@ begin
//Check_Encode('foobar','Zm9vYmFy');
end;
{ TTest_Base32 }
procedure TTest_Base32.Check_Decode(const AIn, AExpect: string; const AOptions : TBaseXOptions);
var
locRes : TByteDynArray;
begin
locRes := Base32Decode(AIn,AOptions);
CheckEquals(StringToByteArray(AExpect),locRes);
end;
procedure TTest_Base32.Check_Encode(const AIn, AExpect: string);
var
locRes : string;
begin
locRes := Base32Encode(AIn);
CheckEquals(AExpect,locRes);
end;
procedure TTest_Base32.Decode_f();
begin
Check_Decode('MY======','f');
end;
procedure TTest_Base32.Decode_fo();
begin
Check_Decode('MZXQ====','fo');
end;
procedure TTest_Base32.Decode_foo();
begin
Check_Decode('MZXW6===','foo');
end;
procedure TTest_Base32.Decode_foob();
begin
Check_Decode('MZXW6YQ=','foob');
end;
procedure TTest_Base32.Decode_fooba();
begin
Check_Decode('MZXW6YTB','fooba');
end;
procedure TTest_Base32.Decode_foobar();
begin
Check_Decode('MZXW6YTBOI======','foobar');
end;
procedure TTest_Base32.Decode_illegal_char();
var
ok : Boolean;
begin
ok := False;
try
Check_Decode('MZX'#200'W6' + sLineBreak + 'Y'#0'TB','fooba',[]);
except
on e : EBase32Exception do
ok := True;
end;
CheckEquals(True,ok);
Check_Decode('MZX'#200'W6' + sLineBreak + 'Y'#0'TB','fooba',[xoDecodeIgnoreIllegalChar]);
Check_Decode('MZX'#200'W6' + sLineBreak + 'Y'#0'TB' + sLineBreak,'fooba',[xoDecodeIgnoreIllegalChar]);
Check_Decode('MZX'#200'W6' + sLineBreak + 'Y'#0'TB' + sLineBreak + sLineBreak,'fooba',[xoDecodeIgnoreIllegalChar]);
end;
procedure TTest_Base32.Decode_empty();
var
ok : Boolean;
begin
ok := False;
try
Check_Decode(sLineBreak,'',[]);
except
on e : EBase32Exception do
ok := True;
end;
CheckEquals(True,ok);
Check_Decode('','',[]);
Check_Decode(#0,'',[xoDecodeIgnoreIllegalChar]);
Check_Decode(sLineBreak,'',[xoDecodeIgnoreIllegalChar]);
Check_Decode(sLineBreak + sLineBreak,'',[xoDecodeIgnoreIllegalChar]);
Check_Decode(sLineBreak + sLineBreak + sLineBreak,'',[xoDecodeIgnoreIllegalChar]);
end;
procedure TTest_Base32.Encode_empty();
begin
Check_Encode('','');
end;
procedure TTest_Base32.Encode_f();
begin
Check_Encode('f','MY======');
end;
procedure TTest_Base32.Encode_fo();
begin
Check_Encode('fo','MZXQ====');
end;
procedure TTest_Base32.Encode_foo();
begin
Check_Encode('foo','MZXW6===');
end;
procedure TTest_Base32.Encode_foob();
begin
Check_Encode('foob','MZXW6YQ=');
end;
procedure TTest_Base32.Encode_fooba();
begin
Check_Encode('fooba','MZXW6YTB');
end;
procedure TTest_Base32.Encode_foobar();
var
a, b : string;
begin
a := 'foobar';
b := 'MZXW6YTBOI======';
Check_Encode(a,b);
//Check_Encode('foobar','Zm9vYmFy');
end;
{ TTest_Base16 }
procedure TTest_Base16.Check_Decode(const AIn, AExpect: string; const AOptions: TBaseXOptions);
@ -301,6 +452,7 @@ end;
initialization
RegisterTest('Encoding',TTest_Base64.Suite);
RegisterTest('Encoding',TTest_Base32.Suite);
RegisterTest('Encoding',TTest_Base16.Suite);
end.