Codificar y descodificar un String en Base 64

Código fuente:
unit String64; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; const B64Table = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/'; function Base64Decode(const S: string): string; function Base64Encode(const S: string): string; implementation {$R *.dfm} function Base64Encode(const S: string): string; var InBuf: array[0..2] of Byte; OutBuf: array[0..3] of Char; iI, iJ: Integer; begin SetLength(Result, ((Length(S) + 2) div 3) * 4); for iI := 1 to ((Length(S) + 2) div 3) do begin if Length(S) < (iI * 3) then Move(S[(iI - 1) * 3 + 1], InBuf, Length(S) - (iI - 1) * 3) else Move(S[(iI - 1) * 3 + 1], InBuf, 3); OutBuf[0] := B64Table[((InBuf[0] and $FC) shr 2) + 1]; OutBuf[1] := B64Table[(((InBuf[0] and $3) shl 4) or ((InBuf[1] and $F0) shr 4)) + 1]; OutBuf[2] := B64Table[(((InBuf[1] and $F) shl 2) or ((InBuf[2] and $C0) shr 6)) + 1]; OutBuf[3] := B64Table[(InBuf[2] and $3F) + 1]; Move(OutBuf, Result[(iI - 1) * 4 + 1], 4); end; if Length(S) 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; function Base64Decode(const S: string): string; var OutBuf: array[0..2] of Byte; InBuf: array[0..3] of Byte; iI, iJ: Integer; begin if Length(S) mod 4 <> 0 then raise Exception.Create('Base64: Incorrect string format'); SetLength(Result, ((Length(S) div 4) - 1) * 3); for iI := 1 to (Length(S) div 4) - 1 do begin Move(S[(iI - 1) * 4 + 1], InBuf, 4); for iJ := 0 to 3 do case InBuf[iJ] of 43: InBuf[iJ] := 62; 48..57: Inc(InBuf[iJ], 4); 65..90: Dec(InBuf[iJ], 65); 97..122: Dec(InBuf[iJ], 71); else InBuf[iJ] := 63; end; OutBuf[0] := (InBuf[0] shl 2) or ((InBuf[1] shr 4) and $3); OutBuf[1] := (InBuf[1] shl 4) or ((InBuf[2] shr 2) and $F); OutBuf[2] := (InBuf[2] shl 6) or (InBuf[3] and $3F); Move(OutBuf, Result[(iI - 1) * 3 + 1], 3); end; if Length(S) <> 0 then begin Move(S[Length(S) - 3], InBuf, 4); if InBuf[2] = 61 then begin for iJ := 0 to 1 do case InBuf[iJ] of 43: InBuf[iJ] := 62; 48..57: Inc(InBuf[iJ], 4); 65..90: Dec(InBuf[iJ], 65); 97..122: Dec(InBuf[iJ], 71); else InBuf[iJ] := 63; end; OutBuf[0] := (InBuf[0] shl 2) or ((InBuf[1] shr 4) and $3); Result := Result + Char(OutBuf[0]); end else if InBuf[3] = 61 then begin for iJ := 0 to 2 do case InBuf[iJ] of 43: InBuf[iJ] := 62; 48..57: Inc(InBuf[iJ], 4); 65..90: Dec(InBuf[iJ], 65); 97..122: Dec(InBuf[iJ], 71); else InBuf[iJ] := 63; end; OutBuf[0] := (InBuf[0] shl 2) or ((InBuf[1] shr 4) and $3); OutBuf[1] := (InBuf[1] shl 4) or ((InBuf[2] shr 2) and $F); Result := Result + Char(OutBuf[0]) + Char(OutBuf[1]); end else begin for iJ := 0 to 3 do case InBuf[iJ] of 43: InBuf[iJ] := 62; 48..57: Inc(InBuf[iJ], 4); 65..90: Dec(InBuf[iJ], 65); 97..122: Dec(InBuf[iJ], 71); else InBuf[iJ] := 63; end; OutBuf[0] := (InBuf[0] shl 2) or ((InBuf[1] shr 4) and $3); OutBuf[1] := (InBuf[1] shl 4) or ((InBuf[2] shr 2) and $F); OutBuf[2] := (InBuf[2] shl 6) or (InBuf[3] and $3F); Result := Result + Char(OutBuf[0]) + Char(OutBuf[1]) + Char(OutBuf[2]); end; end; end; procedure TForm3.Button1Click(Sender: TObject); begin if Edit1.text = '' then exit; Edit2.text := Base64Encode(Edit1.text); end; procedure TForm3.Button2Click(Sender: TObject); begin if Edit2.text = '' then exit; Edit1.text := Base64Decode(Edit2.text); end; end.
Aplicación:

Espero que os guste el algoritmo, ya que en mi opinión creo que hay que tenerlo siempre a mano.
- Enlaces de interés:
Hola Jordi, hace unos días que utilicé el código de ésta función (Base64Encode) para incorporarlo en una UDF que hice para Firebird, te agradezco este código. Te comento que me topé con un problema al ejecutarla ya que vi que era necesario iniciar a ceros el Inbuf antes de asignarle los datos de S, ya que si no lo hacía, el Inbuf se llevaba en la segunda y siguiente o en la tercera posición el byte del ciclo anterior y la cadena que regresaba era incorrecta en el último byte. Espero haberme explicado. Saludos y te vuelvo a dar las gracias por este magnífico pedazo de código.
ReplyDelete