base 64
encoding/decoding
From: massoft@xs4all.nl (Jan Doggen)
untested
code follows. From: Arne de Bruijn
{ Decode
base-64 files, Arne de Bruijn, 1996, Released to the Public Domain }
{ Strip
everything but the base-64 lines before feeding it into this program }
uses
dos;
var
Base64:array[43..122] of byte;
var
T:text;
Chars:set of char;
S:string;
K,I,J:word;
Buf:pointer;
DShift:integer;
F:file;
B,B1:byte;
Decode:array[0..63] of byte;
Shift2:byte;
Size,W:word;
begin
FillChar(Base64,SizeOf(Base64),255);
J:=0;
for I:=65 to 90 do
begin
Base64[I]:=J;
Inc(J);
end;
for I:=97 to 122 do
begin
Base64[I]:=J;
Inc(J);
end;
for I:=48 to 57 do
begin
Base64[I]:=J;
Inc(J);
end;
Base64[43]:=J; Inc(J);
Base64[47]:=J; Inc(J);
if ParamCount=0 then
begin
WriteLn('UNBASE64 <mime file>
[<output file>]');
Halt(1);
end;
S:=ParamStr(1);
assign(T,S);
GetMem(Buf,32768);
SetTextBuf(T,Buf^,32768);
{$I-} reset(T); {$I+}
if IOResult<>0 then
begin
WriteLn('Error reading ',S);
Halt(1);
end;
if ParamCount>=2 then
S:=ParamStr(2)
else
begin write('Destination:'); ReadLn(S); end;
assign(F,S);
{$I-} rewrite(F,1); {$I+}
if IOResult<>0 then
begin
WriteLn('Error creating ',S);
Halt(1);
end;
while not eof(T) do
begin
ReadLn(T,S);
if (S<>'') and (pos(' ',S)=0) and
(S[1]>=#43) and (S[1]<=#122) and
(Base64[byte(S[1])]<>255) then
begin
FillChar(Decode,SizeOf(Decode),0);
DShift:=0;
J:=0; Shift2:=1;
Size:=255;
B:=0;
for I:=1 to Length(S) do
begin
case S[I] of
#43..#122:B1:=Base64[Ord(S[I])];
else
B1:=255;
end;
if B1=255 then
if S[I]='=' then
begin
B1:=0; if Size=255 then Size:=J;
end
else
WriteLn('Char error:',S[I],'
(',Ord(S[I]),')');
if DShift and 7=0 then
begin
Decode[J]:=byte(B1 shl 2);
DShift:=2;
end
else
begin
Decode[J]:=Decode[J] or Hi(word(B1)
shl (DShift+2));
Decode[J+1]:=Lo(word(B1) shl
(DShift+2));
Inc(J);
Inc(DShift,2);
end;
end;
if Size=255 then Size:=J;
BlockWrite(F,Decode,Size);
end;
end;
Close(F);
close(T);
end.
Other
source;
...use
Base64 encoding and decoding?
Author:
Steve Schafer
Homepage:
http://www.teamb.com
1 Comment
to this tip [Write new comment]
[ Print tip
]
Tip Rating
(2):
Skill:
Useful:
Overall:
function
Decode(const S: AnsiString): AnsiString;
const
Map: array[Char] of Byte = (0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, 0,
0, 0, 63, 52, 53,
54, 55, 56, 57, 58, 59, 60, 61, 0, 0, 0,
0, 0, 0, 0, 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, 0, 0, 0, 0, 0, 0,
26, 27, 28, 29, 30,
31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
41, 42, 43, 44, 45,
46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0,
0);
var
I: LongInt;
begin
case Length(S) of
2:
begin
I := Map[S[1]] + (Map[S[2]] shl 6);
SetLength(Result, 1);
Move(I, Result[1], Length(Result))
end;
3:
begin
I := Map[S[1]] + (Map[S[2]] shl 6) +
(Map[S[3]] shl 12);
SetLength(Result, 2);
Move(I, Result[1], Length(Result))
end;
4:
begin
I := Map[S[1]] + (Map[S[2]] shl 6) +
(Map[S[3]] shl 12) +
(Map[S[4]] shl 18);
SetLength(Result, 3);
Move(I, Result[1], Length(Result))
end
end
end;
function
Encode(const S: AnsiString): AnsiString;
const
Map: array[0..63] of Char =
'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
'abcdefghijklmnopqrstuvwxyz0123456789+/';
var
I: LongInt;
begin
I := 0;
Move(S[1], I, Length(S));
case Length(S) of
1:
Result := Map[I mod 64] + Map[(I shr 6)
mod 64];
2:
Result := Map[I mod 64] + Map[(I shr 6)
mod 64] +
Map[(I shr 12) mod 64];
3:
Result := Map[I mod 64] + Map[(I shr 6)
mod 64] +
Map[(I shr 12) mod 64] + Map[(I shr
18) mod 64]
end
end;