(*** BASE64 by Alexander Myasnikov ***)
(*** Based on ideas from base64 functions by some authors ***)
(*** Web: www.darksoftware.narod.ru ***)
unit base64;
{$R-}
{$Q-}
interface
uses Classes, SysUtils;
procedure Base64EncodeFile(fn: string; tofn: string);
function Base64DecodeFile(fn: string; topath: string): boolean;
implementation
const
b64alphabet: PChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
pad: PChar = '====';
var
dectable: array [0..255] of
byte = (255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 62, 255, 255, 255, 63, 52, 53, 54,
55, 56, 57, 58, 59, 60, 61, 255, 255, 255, 255, 255, 255, 255,
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, 255, 255, 255, 255, 255, 255, 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, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255, 255,
255, 255, 255, 255, 255, 255, 255, 255, 255);
function PosEx(const SubStr, S: string; Offset: cardinal = 1): integer;
var
I, X: integer;
Len, LenSubStr: integer;
begin
if Offset = 1 then
Result := Pos(SubStr, S)
else
begin
I := Offset;
LenSubStr := Length(SubStr);
Len := Length(S) - LenSubStr + 1;
while I <= Len do
begin
if S[i] = SubStr[1] then
begin
X := 1;
while (X < LenSubStr) and (S[I + X] = SubStr[X + 1]) do
Inc(X);
if (X = LenSubStr) then
begin
Result := I;
exit;
end;
end;
Inc(I);
end;
Result := 0;
end;
end;
procedure Base64EncodeFile(fn: string; tofn: string);
function EncodeChunk(chunk: pbytearray; length: integer): string;
var
W, I: longword;
begin
W := 0;
for i := 0 to length - 1 do
Inc(W, (Chunk^[i]) shl ((2 - i) * 8));
Result := b64alphabet[(W shr 18) and $3f] + b64alphabet[(W shr 12) and $3f] +
b64alphabet[(W shr 06) and $3f] + b64alphabet[(W shr 00) and $3f];
if length <> 3 then
Result := Copy(Result, 0, length + 1) + Copy(pad, 0, 3 - length);
end;
var
hFile, hOut, ByteCount, Idx: longword;
base64String, Head: string;
Buf: array[0..56] of byte;
Left: longint;
begin
hFile := FileOpen(Fn, fmOpenRead);
hOut := FileCreate(tofn, fmOpenRead);
Head := 'MIME-Version: 1.0' + #13#10;
FileWrite(hOut, Head[1], Length(Head));
Head := Format('Content-Type: application/octet-stream; name="%s"',
[ExtractFileName(fn)]) + #13#10;
FileWrite(hOut, Head[1], Length(Head));
Head := 'Content-Transfer-Encoding: base64' + #13#10;
FileWrite(hOut, Head[1], Length(Head));
Head := Format('Content-Disposition: attachment; filename="%s"',
[ExtractFileName(fn)]) + #13#10#13#10;
FileWrite(hOut, Head[1], Length(Head));
FillChar(Buf, SizeOf(Buf), #0);
repeat
ByteCount := FileRead(hFile, Buf, 57);
Left := ByteCount;
base64String := '';
idx := 0;
repeat
if left >= 3 then
base64String := base64String + EncodeChunk(@Buf[idx], 3)
else
base64String := base64String + EncodeChunk(@Buf[idx], left);
Inc(idx, 3);
Dec(left, 3);
until left <= 0;
Head := base64String + #13#10;
FileWrite(hOut, Head[1], Length(Head));
until ByteCount < 57;
FileClose(hOut);
FileClose(hFile);
end;
function Base64DecodeFile(fn: string; topath: string): boolean;
function DecodeChunk(const Chunk: string; Data: PByteArray): longword;
var
W: longword;
i: byte;
begin
FillChar(Data^, 3, 0);
W := 0;
Result := 3;
for i := 1 to 4 do
if dectable[byte(Chunk[i])] <> 255 then
W := W + word((dectable[byte(Chunk[i])])) shl ((4 - i) * 6)
else
Dec(Result);
for i := 1 to 3 do
Data^[i - 1] := (W shr ((3 - i) * 8) and $ff);
end;
var
Read, i, ll, max, start: longword;
Txt: TFileStream;
s: string;
SBuf: array[0..65535] of char;
Buf: array[0..3] of byte;
Large: array[0..65535] of byte;
hOut: TFileStream;
idx, deco: integer;
begin
Result := True;
Txt := TFileStream.Create(fn, fmOpenRead or fmShareDenyWrite);
idx := 0;
FillChar(SBuf, 4098, 0);
Txt.Read(Sbuf, 4096);
start := Pos(#13#10#13#10, Sbuf) + 3;
if AnsiPos('base64', AnsiLowerCase(SBuf)) = 0 then
begin
Txt.Destroy;
Result := False;
Exit;
end;
i := AnsiPos('filename=', AnsiLowerCase(Sbuf));
i := PosEx('"', Sbuf, i + 1);
topath := SysUtils.IncludeTrailingBackslash(topath) +
trim(copy(Sbuf, i + 1, PosEx('"', Sbuf, i + 2) - (i + 1)));
txt.Seek(start, 0);
FillChar(SBuf, 128, 0);
Txt.Read(Sbuf, 100);
ll := Pos(#13#10, Sbuf) - 1;
max := ll * 100 + 2 * 100;
txt.Seek(start, 0);
hOut := TFileStream.Create(topath, fmCreate);
repeat
s := '';
Read := Txt.Read(Sbuf, max);
for i := 0 to Read - 1 do
if SBuf[i] > #13 then
s := s + SBuf[i];
while Length(s) > 0 do
begin
deco := DecodeChunk(Copy(s, 0, 4), @Buf);
Move(buf, large[idx], deco);
Delete(s, 1, 4);
if idx < 65528 then
Inc(idx, deco)
else
begin
hOut.WriteBuffer(Large, idx + deco);
idx := 0;
end;
end;
until Read < max;
if idx <> 0 then
hOut.Write(Large, idx);
txt.Destroy;
hOut.Destroy;
end;
end.