１・バイナリで３バイト読みこむ。（足りなければゼロで埋める）
　２・その２４ビットを６ビットの４バイトにバラす。
　３・その４バイトを下記表に従いアスキー化する。

         0 A            17 R            34 i            51 z
         1 B            18 S            35 j            52 0
         2 C            19 T            36 k            53 1
         3 D            20 U            37 l            54 2
         4 E            21 V            38 m            55 3
         5 F            22 W            39 n            56 4
         6 G            23 X            40 o            57 5
         7 H            24 Y            41 p            58 6
         8 I            25 Z            42 q            59 7
         9 J            26 a            43 r            60 8
        10 K            27 b            44 s            61 9
        11 L            28 c            45 t            62 +
        12 M            29 d            46 u            63 /
        13 N            30 e            47 v
        14 O            31 f            48 w         (pad) =
        15 P            32 g            49 x
        16 Q            33 h            50 y

　　例）バイナリ2バイト「$00, $FF」をエンコード。先ず読みこみは３バイト
　　　　でないとならないので穴埋めパッド「$00」を足してエンコード開始。

　　●●●●●●●●┃○○○○○○○○┃●●●●●●●●
　　↓
　　●●●●●●┃●●○○○○┃○○○○●●┃●●●●●●
　　↓
　　0,15,60,pad → AP8=



　原典たるRFC1341を精読したわけではないのですが、改行は無視されるので
一行の長さは4で割り切れる適当な長さで切ってください。下記ソースのキー
は「3 byte -> 4 char」のセクションです。MyEnc.dpr というファイル名で
保存してコンパイルします。



program MyEnc;

uses Windows, SysUtils;

{$APPTYPE CONSOLE}


{ ---------- Error ---------- }

procedure ShowError(Mes: string);
begin
  WriteLn(Mes);
  Halt(1);
end;

{ --------- 3 byte -> 4 char ---------- }

type TBuf= array[0..2]of byte;

const
  Table = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';

function EncBuf(Buf: TBuf; BufSize: integer): string;
var
  Ret: array[0..3]of char;
begin
  case BufSize of
    2: Buf[2]:= 0;
    1: begin Buf[1]:= 0; Buf[2]:= 0; end;
  end;
  Ret[0]:= Table[(Buf[0] shr 2)+1];
  Ret[1]:= Table[(((Buf[0] shl 4) and $30) or ((Buf[1] shr 4) and $0F))+1];
  Ret[2]:= Table[(((Buf[1] and $0F) shl 2) or ((Buf[2] shr 6) and $03))+1];
  Ret[3]:= Table[(Buf[2] and $3F)+1];
  case BufSize of
    2: Ret[3]:= '=';
    1: begin Ret[2]:= '='; Ret[3]:= '='; end;
  end;
  Result:= string(Ret);
end;

{ ---------- Main ---------- }
var
  buf: TBuf;
  F: file;
  count: integer;
  s: string;
begin
  if ParamCount=0 then ShowError('This is a file encoder of Base64.');
  if not FileExists(ParamStr(1)) then ShowError('Not found: '+ParamStr(1));

  s:= '';
  AssignFile(F, ParamStr(1));
  Reset(F, 1);
  BlockRead(F, buf, 3, count);
  while count>0 do begin
    s:= s+ EncBuf(buf, count);
    if Length(s)= 76 then begin
      WriteLn(s);
      s:= '';
    end;
    BlockRead(F, buf, 3, count);
  end;
  if s<>'' then WriteLn(s);
  CloseFile(F);
end.


Original document by 折井　哲        氏 ID:(VZX00324)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。