function EncodeBase64(Value: String): String;
const
b64alphabet: PChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
pad: PChar = '====';
function EncodeChunk(const Chunk: String): String;
var
W: LongWord;
i, n: Byte;
begin
n := Length(Chunk); W := 0;
for i := 0 to n - 1 do
W := W + Ord(Chunk[i + 1]) 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 n <> 3 then
Result := Copy(Result, 0, n + 1) + Copy(pad, 0, 3 - n); //add padding when out len isn't 24 bits
end;
begin
Result := '';
while Length(Value) > 0 do
begin
Result := Result + EncodeChunk(Copy(Value, 0, 3));
Delete(Value, 1, 3);
end;
end;
function DecodeBase64(Value: String): String;
const b64alphabet: PChar = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
function DecodeChunk(const Chunk: String): String;
var
W: LongWord;
i: Byte;
begin
W := 0; Result := '';
for i := 1 to 4 do
if Pos(Chunk[i], b64alphabet) <> 0 then
W := W + Word((Pos(Chunk[i], b64alphabet) - 1)) shl ((4 - i) * 6);
for i := 1 to 3 do
Result := Result + Chr(W shr ((3 - i) * 8) and $ff);
end;
begin
Result := '';
if Length(Value) mod 4 <> 0 then Exit;
while Length(Value) > 0 do
begin
Result := Result + DecodeChunk(Copy(Value, 0, 4));
Delete(Value, 1, 4);
end;
end;
Crypt :
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Text := EncodeBase64(Memo1.Text);
end;
Decrypt :
procedure TForm1.Button2Click(Sender: TObject);
begin
Memo1.Text := DecodeBase64(Memo1.Text);
end;
Keine Kommentare:
Kommentar veröffentlichen