UTF-8とShift-JIS文字コード自力変換(2004/4/24)

　Windows95ではWideCharToMultiByte APIが使用出来ないため、自力で変換するためのユニットを作成しました。一応確認しましたが、バグが潜んでいるかも知れませんので、使用される方は各自で充分確認をお願いします。
　Delphi 6あたりから標準でUTF-8コードを変換する関数が追加されていますが、Delphi 3〜5では使いみちがあると思います。
　ソースはポインタとビット演算を多用しているため、かなり読みづらいかと思います。コード変換に興味がある方は、以下のURLを参照して下さい。
　http://homepage1.nifty.com/nomenclator/unicode/ucs_utf.htm

　ここから下をutftosjis.pasとして保存し、ライブラリパスの通ったフォルダに保存して下さい。尚、使用する際はUses節にutftosjisを追加してください。

(*
  UTF-8 <-> SJIS 相互変換
  Windows95ではWideCharToMultiByte APIが使用出来ないため、自力変換
  を行なう。
  コード変換はいきなりSJISに変換するよりも、一旦Unicode(USC-2)に
  変換する方が楽そうだったのでそうした。
  以下が参考にした貞廣知行氏のページです。感謝m(__)m
  http://homepage1.nifty.com/nomenclator/unicode/ucs_utf.htm
  Unicodeにしてしまえば、あとはString型に代入するだけでDelphiが自動
  的にSJISにしてくれるのでとっても楽。

  Copyright(c) 2004/4/24 M&I

*)

unit Utf8tosjis;

interface

uses
  Windows, Sysutils;

// UTF-8(BOM付き) -> SJIS
function UTFtoSJIS(UTFStr: string): string;
// UTF-8N -> SJIS
function UTFNtoSJIS(UTFStr: string): string;
// SJIS -> UTF-8(BOM付き)
function SJIStoUTF(Str: string): string;
// SJIS -> UTF-8N
function SJIStoUTFN(Str: string): string;

implementation

// UTF-8をSJISに変換する
function UTF82Sjis(UTFStr: string): string;
var
  usc2, uc: PChar;
  pwc: PWideChar;
  len: integer;
  un: WORD;
begin
  Result := '';
  len := Length(UTFStr);
  // 文字列の終わりを検出するために番兵４人を立てる
  uc := PChar(UTFStr + #0#0#0#0);
  // 安全を見て４倍のメモリを確保
  usc2 := AllocMem(len * 4);
  // usc2はポインタとして使うのでpwcに先頭アドレスを保存
  pwc := PWideChar(usc2);
  try
    while uc^ <> #0 do
    begin
      // ASCII
      if uc^ in [#0..#$7F] then
      begin
        usc2^ := uc^;
        (usc2+1)^ := #0;
        Inc(usc2, 2);
        Inc(uc);
      // 2byte文字その１
      end else if uc^ in [#$C0.. #$DF] then
      begin
        un := (Ord(uc^) and $1F) shl 6 + Ord((uc+1)^) and $3F;
        usc2^ := Char(Lo(un));
        (usc2+1)^ := Char(Hi(un));
        Inc(usc2, 2);
        Inc(uc, 2);
      // 2byte文字その２
      end else if uc^ in [#$E0..#$EF] then
      begin
        un := (Ord(uc^) and $0F) shl 12 + (Ord((uc+1)^) and $3F) shl 6 
              + (Ord((uc+2)^) and $3F);
        usc2^ := Char(Lo(un));
        (usc2+1)^ := Char(Hi(un));
        Inc(usc2, 2);
        Inc(uc, 3);
      // 4byte文字(USC-4のみ)
      end else if uc^ in [#$F0..#$F7] then
      begin
        un := (Ord(uc^) and $07) shl 2 + (Ord((uc+1)^) shr 4) and $03;
        usc2^ := Char(Lo(un));
        (usc2+1)^ := Char(Hi(un));
        Inc(usc2, 2);
        Inc(uc);
        un := ((Ord(uc^) shl 4) and $F0) + (Ord((uc+1)^) and $3F) shl 6 
              + (Ord((uc+2)^) and $3F);
        usc2^ := Char(Lo(un));
        (usc2+1)^ := Char(Hi(un));
        Inc(usc2, 2);
        Inc(uc, 3);
      end else
        raise Exception.Create('UTF-8 Unknown code.');
    end;
    // UTFから変換したUnicodeをString型で返す。これだけでSjisになっちゃう
    Result := pwc;
  finally
    FreeMem(pwc);
  end;
end;

// SJISをUTF-8に変換する
function SJIS2UTF(Str: string): string;
var
  uc, sc: PChar;
  usc2: PWideChar;
  pw: ^Word;
  //w1, w2: Word;
  len: integer;
begin
  Result := '';
  len := Length(Str);
  usc2 := AllocMem(len * 4 + 4);
  pw := Pointer(usc2);
  try
    uc := AllocMem(len * 3 + 3);
    sc := uc;
    try
      // 一旦Unicodeに変換
      StringToWideChar(Str, usc2, len * 4);
      while pw^ <> 0 do
      begin
        {ここはUSC-4の処理。Uninode(USC-2)では不要。ついでながら未確認。
        // 00000000-000wwwxx-xxxxyyyy-yyzzzzzz
        if ((pw^ and $FFE0) = 0) and ((pw2^ and $F800) <> 0) then
        begin
          w1 := pw^;
          Inc(pw);
          w2 := pw^;
          Inc(pw);
          // 11110www
          uc^ := Char($F0 + (w2 shr 2));
          Inc(uc);
          // 10xxxxxx
          uc^ := Char($80 + ((w2 and $03) shl 4) + (w1 shr 12));
          Inc(uc);
          // 10yyyyyy
          uc^ := Char($80 + ((w1 shr 6) and $3F));
          Inc(uc^);
          // 10zzzzzz
          uc^ := Char($80 + (w1 and $3F));
          Inc(uc);
        // 00000000-0xxxxxxx
        end else }
        if (pw^ and $FF80) = 0 then
        begin
          uc^ := Char(Lo(pw^));
          Inc(uc);
          Inc(pw);
        // 00000xxx-xxyyyyyy
        end else if (pw^ and $F800) = 0 then      
        begin
          // 110xxxxx
          uc^ := Char($C0 + (pw^ shr 6));
          Inc(uc);
          // 10yyyyyy
          uc^ := Char($80 + (pw^ and $3F));
          Inc(uc);
          Inc(pw);
        // xxxxyyyy-yyzzzzzz
        end else begin
          // 1110xxxx
          uc^ := Char($E0 + (pw^ shr 12));
          Inc(uc);
          // 10yyyyyy
          uc^ := Char($80 + ((pw^ shr 6) and $3F));
          Inc(uc);
          // 10zzzzzz
          uc^ := Char($80 + (pw^ and $3F));
          Inc(uc);
          Inc(pw);
        end;
      end;
      uc^ := #0;
      Result := sc;
    finally
      Freemem(sc);
    end;
  finally
    FreeMem(usc2);
  end;
end;

// UTF-8(BOM付き) -> SJIS
function UTFtoSJIS(UTFStr: string): string;
begin
  Delete(UTFStr, 1, 3);
  Result := UTF82Sjis(UTFStr);
end;

// UTF-8N -> SJIS
function UTFNtoSJIS(UTFStr: string): string;
begin
  Result := UTF82SJIS(UTFStr);
end;

// SJIS -> UTF-8(BOM付き)
function SJIStoUTF(Str: string): string;
begin
  Result := #$EF#$BB#$BF + SJIS2UTF(Str);
end;

// SJIS -> UTF-8N
function SJIStoUTFN(Str: string): string;
begin
  Result := SJIS2UTF(Str);
end;

end.