UNICODE/UTF-8とShift-JIS文字コード相互変換(2003/11/30)

　Unicode(Little Endian/Big Endian)，UTF-8/8Nの文字コードチェックとShift-JISとの相互変換をおこなうためのユニットです。
　池田氏作jconvert [Copyright(C) 1998 EarthWave Soft(IKEDA Takahiro)]の使用を前提とした拡張ユニットとして使用します。

注１）
　UTF8はWindows98以降で追加されたAPIを使用しているためWindows95では動作しないと思わます。
注２）
　UNICODEは１バイト文字も２バイトに拡張しており、文字列中に#0を含むためString型では取り扱うことができません。そのため、UNICODEからSJISに変換する際はPWideChar型を，SJISからUNICODEに変換する際にはver渡しのTMemoryStreamを使用するものしました。
　変換したものをファイルに保存する事を考えると、MemoryStreamに書き込んで貰ったほうが楽だと思わます。
　　　sjisToUniLE(ms, s);
　　　ms.SaveToFile(FileName);
　で済んでしまいます．．．

　使用する際は、Uses節にjconvertとjconvexを追加してください。jconvertのInCodeCheckの代りにInCodeCheckExを使用すると、文字コードがUnicodeかUTF-8かのチェックも出来るようになります。もっともまじめにチェックしているのはUTF-8だけで、UnicodeとUTF-8Nは先頭のBOMをチェックしているだけなので誤作動の可能性があります(^^;

ここから下をjconvex.pasとして保存し、ライブラリパスの通ったフォルダに保存して下さい。

unit jconvex;

interface

uses
  Windows, SysUtils, jconvert, Classes;

const
  UNILE_IN   = 7; // Unicode Little Endian(Intel CPU)
  UNIBE_IN   = 8; // Unicode Big Endian
  UTF8_IN    = 9; // UTF8(TTF8NのBOM付き)
  UTF8N_IN   = 10;// UTF8N

  UNILE_OUT  = 7;
  UNIBE_OUT  = 8;
  UTF8_OUT   = 9;
  UTF8N_OUT  = 10;

// 拡張文字コードチェック
function InCodeCheckEx(const s: string): integer;
// UNICODE(Little Endian)をSJISに変換する
function uniLETosjis(const s: PWideChar): string;
// UNICODE(Big Endian)をSJISに変換する
function uniBETosjis(const s: PWideChar): string;
// UTF8をSJISに変換する
function Utf8Tosjis(const s: String): string;
// UTF8NをSJISに変換する
function Utf8NTosjis(const s: String): string;

// SJISをUNICODE(LE)に変換する
procedure sjisToUniLE(var ms: TMemoryStream; const s: string);
// SJISをUNICODE(BE)に変換する
procedure sjisToUniBE(var ms: TMemoryStream; const s: string);
// SJISをUNICODE(UTF8)に変換する
function sjisToUtf8(const s: string): string;
// SJISをUNICODE(UTF8N)に変換する
function sjisToUtf8N(const s: string): string;


implementation

// 拡張文字コードチェック
// UNICODEとUTF8をチェックし、そのどれらでもなかった場合には
// jconvertのInCodeCheckを戻り値にする
function InCodeCheckEx(const s: string): integer;
var
  index, c, size: Integer;
  utfk: Boolean;
begin
  size := Length(s);
  { Size = 0 }
  if size = 0 then
  begin
    Result := BINARY;
    Exit;
  end;
  { Unicodeをチェックする }
  { 先頭のBOMしかチェックしていないので誤作動の可能性あり }
  if (size >= 2 ) then
  begin
    { UNICODE(Little Endian)チェック }
    if (s[1] = #$FF) and (s[2] = #$FE) then
    begin
      Result := UNILE_IN;
      Exit;
    end;
    { UNICODE(Big Endian)チェック }
    if (s[1] = #$FE) and (s[2] = #$FF) then
    begin
      Result := UNIBE_IN;
      Exit;
    end;
  end;
  { UTF-8をチェックする }
  if size > 3 then
  begin
    { UTF-8N(BOMあり)チェック }
    { 先頭のBOMしかチェックしていないので誤作動の可能性あり }
    if (s[1] = #$EF) and (s[2] = #$BB) and (s[3] = #$BF) then
    begin
      Result := UTF8_IN;
      Exit;
    end;
  end;
  {UTF-8(BOMなし)チェック}
  index := 1;
  utfk := False;
  while (index <= STRICT_CHECK_LEN) and (index < size - 4) do
  begin
    c := Ord(s[index]);
    if (c in [$C0..$DF]) or (c > $EF) then
    begin
      utfk := False;
      Break;
    end;
    if c in [0..$7F] then
    begin
      ;
    end else if c = $E0 then
    begin
      Inc(index);
      c := Ord(s[index]);
      if c in [$A0..$BF] then
      begin
        Inc(index);
        c := Ord(s[index]);
        if c in [$80..$BF] then
          utfk := True
        else begin
          utfk := False;
          Break;
        end;
      end else begin
        utfk := False;
        Break;
      end;
    end else if c in [$E1..$EF] then
    begin
      Inc(index);
      c := Ord(s[index]);
      if c in [$80..$BF] then
      begin
        Inc(index);
        c := Ord(s[index]);
        if c in [$80..$BF] then
          utfk := True
        else begin
          utfk := False;
          Break;
        end;
      end else begin
        utfk := False;
        Break;
      end;
    end else begin
      utfk := False;
      Break;
    end;
    Inc(index);
  end;
  { 漢字があったらUTF }
  if utfk then
    Result := UTF8N_IN
  { UnicdeでもUTF8でもなければJconvertでチェック }
  else
    Result := InCodeCheck(s);
end;

function UniLETosjis(const s: PWideChar): string;
begin
  Result := WideCharToString(s);
end;

function UniBETosjis(const s: PWideChar): string;
var
  Pc: PChar;
  c: char;
  n: integer;
begin
  Pc := PChar(s);
  n := 0;
  while True do
  begin
    if (Pc[n] = #0) and (Pc[n+1] = #0) then
      Break;
    c := Pc[n];
    Pc[n] := Pc[n+1];
    Pc[n+1] := c;
    Inc(n, 2);
  end;
  Result := WideCharToString(PWideChar(Pc));
end;

procedure sjisToUniLE(var ms: TMemoryStream; const s: string);
var
  PWs: PWideChar;
  Len: integer;
begin
  if not Assigned(ms) then
    raise Exception.Create('無効なMemoryStream.');
  Len := Length(s) * 2;
  PWs := AllocMem(Len + 2);
  try
    StringToWideChar(s, PWs, Len);
    ms.Write(#$FF#$FE, 2);
    ms.Write(PWs^, Length(Pws) * 2);
  finally
    FreeMem(PWs);
  end;
end;

procedure sjisToUniBE(var ms: TMemoryStream; const s: string);
var
  PWs: PWideChar;
  Pc: PChar;
  len, n: integer;
  Tc: Char;
begin
  if not Assigned(ms) then
    raise Exception.Create('無効なMemoryStream.');
  Len := Length(s) * 2;
  PWs := AllocMem(Len + 2);
  try
    StringToWideChar(s, PWs, Len);
    Pc := PChar(PWs);
    n := 0;
    while n < len do
    begin
      Tc := (Pc+n)^;
      (Pc+n)^ := (Pc+n+1)^;
      (Pc+n+1)^ := Tc;
      Inc(n, 2);
    end;
    ms.Write(#$FE#$FF, 2);
    ms.Write(PWs^, Length(Pws) * 2);
  finally
    FreeMem(PWs);
  end;
end;

function Utf8NTosjis(const s: string): string;
var
  Len: integer;
  OutStr: PWideChar;
  SIn, SOut: string;
begin
  Result := '';
  // ゴミ防止
  SIn := S + #0#0;
  Len := MultiByteToWideChar(CP_UTF8, 0, PChar(SIn), Length(SIn), nil, 0);
  if Len = 0 then
    raise Exception.Create('UTF8の文字列変換に失敗しました.');
  // Lenで良いはずだが、なぜかエラーとなるため２倍
  OutStr := AllocMem(Len * 2);
  try
    MultiByteToWideChar(CP_UTF8, 0, PChar(SIn), Length(SIn), OutStr, Len);
    WideCharToStrVar(OutStr, SOut);
    Result := SOut;
  finally
    FreeMem(OutStr);
  end;
end;

function Utf8Tosjis(const s: string): string;
var
  s2: string;
begin
  s2 := s;
  Delete(s2, 1, 3);
  Result := Utf8NTosjis(s2);
end;

function SjisToUtf8N(const s: string): string;
var
  Len: integer;
  InStr: PWideChar;
  OutStr: PChar;
begin
  Result := '';
  Len := Length(s) * 2 + 2;
  InStr := AllocMem(Len);
  try
    StringToWideChar(s, InStr, Len);
    OutStr := AllocMem(Len);
    try
      WideCharToMultiByte(CP_UTF8, 0, InStr, Length(InStr) * 2, OutStr, Len, nil, nil);
      Result := OutStr;
    finally
      FreeMem(OutStr);
    end;
  finally
    FreeMem(InStr);
  end;
end;

function SjisToUtf8(const s: string): string;
begin
  Result := #$EF#$BB#$BF + SjisToUtf8N(s);
end;

end.