ファイル名を与えると文字コード判定する関数 ～Delphiソースコード集

• ホーム
• Delphiでお手軽プログラミング
• ファイル名を与えると文字コード判定する関数 ～Delphiソースコード集

ファイル名を与えると文字コード判定する関数 ～Delphiソースコード集

文字コードを判定したいテキストファイル名を与えると文字コードをなるべく推察し、文字コードの判定結果を文字列で返す関数のユニットファイル「UJudgeCharCode.pas」

使い方

uses UJudgeCharCode;
ret:=JudgeCharCodeFromFile('判定したいファイル名.txt');
で変数ret（String型)に以下の何れかの文字列が返ってきます。
デフォルトでは最大で先頭から1024バイトで判断します。オプションの第2引数に判定したい最大バイト数を指定することもできます。
ret:=JudgeCharCodeFromFile('判定したいファイル名.txt', 4096);
厳密に判定することは難しいので間違えることがあります。ご了承ください。

uses UJudgeCharCode;

//・・・

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(
    JudgeCharCodeFromFile('c:\判定したいファイル名.txt')
  );
end;

UJudgeCharCode.pas ユニット ファイル

unit UJudgeCharCode;

interface
uses System.SysUtils ,System.Classes;

//引数  filename:ファイル名 len:先頭から何バイトまでで判定するか
//戻値  文字列 UTF16LE UTF16BE UTF8 EUCJP JIS SJIS UNKNOWN のどれか
//      但し指定したファイルが無い場合は NOFILE を返す
function JudgeCharCodeFromFile(Filename:String;Len:UInt16=1024):String;


implementation

function IsISO2022JP(b:TBytes):boolean;
var i:Integer;
begin
  result:=false;
  i:=0;
  while (i<(Length(b)-2))do
  begin
    if b[i]>=$80 then
    begin
      //0x80以上の値があるとその時点でJISではない
      result:=false;
      break;
    end;
    if (b[i]=$1b) and (b[i+1]=$28) and (b[i+2]=$42) then
    begin
      //ASCIIエスケープシーケンスがある場合
      result:=true;
      Break;
    end;
    if (b[i]=$1b) and (b[i+1]=$28) and (b[i+2]=$49) then
    begin
      //JISカナ字エスケープシーケンスがある場合
      result:=true;
      Break;
    end;
    if (b[i]=$1b) and (b[i+1]=$28) and (b[i+2]=$4a) then
    begin
      //ローマ字エスケープシーケンスがある場合
      result:=true;
      Break;
    end;
    if (b[i]=$1b) and (b[i+1]=$24) and (b[i+2]=$40) then
    begin
      //旧JIS漢字エスケープシーケンスがある場合
      result:=true;
      Break;
    end;
    if (b[i]=$1b) and (b[i+1]=$24) and (b[i+2]=$42) then
    begin
      //新JIS漢字エスケープシーケンスがある場合
      result:=true;
      Break;
    end;
    if (b[i]=$1b) and (b[i+1]=$24) and (b[i+2]=$44) then
    begin
      //JIS補助漢字エスケープシーケンスがある場合
      result:=true;
      Break;
    end;
    inc(i);
  end;
end;

function IsUTF8(b:TBytes):boolean;
var i:Integer;
begin
  result:=false;
  i:=0;
  while (i<(Length(b)-3))do
  begin
    //2バイト文字
    if ((b[i] and $e0)=$c0) and ((b[i+1] and $c0)=$80) then
    begin
      result:=true;
      break;
    end;
    //3バイト文字
    if ((b[i] and $f0)=$e0) and ((b[i+1] and $c0)=$80) and
       ((b[i+2] and $c0)=$80) then
    begin
      result:=true;
      break;
    end;
    //4バイト文字
    if ((b[i] and $f8)=$f0) and ((b[i+1] and $c0)=$80) and
       ((b[i+2] and $c0)=$80) and ((b[i+3] and $c0)=$80) then
    begin
      result:=true;
      break;
    end;
    inc(i);
  end;
end;

function IsUTF16LE(b:TBytes):boolean;
var i:Integer;
begin
  i:=1;
  result:=true;
  while i<Length(b) do
  begin
    //2バイト目だけで判定する
    if ((b[i]>=$34) and (b[i]<=$4d)) or
       ((b[i]>=$a0) and (b[i]<=$d7)) or
       ((b[i]>=$e0) and (b[i]<=$f7)) then
    begin
      result:=false;
      break;
    end;
    inc(i,2);
  end;
end;

function IsUTF16BE(b:TBytes):boolean;
var i:Integer;
begin
  i:=0;
  result:=true;
  while i<Length(b) do
  begin
    //1バイト目だけで判定する
    if ((b[i]>=$34) and (b[i]<=$4d)) or
       ((b[i]>=$a0) and (b[i]<=$d7)) or
       ((b[i]>=$e0) and (b[i]<=$f7)) then
    begin
      result:=false;
      break;
    end;
    inc(i,2);
  end;
end;


function isEUCJP(b:TBytes):boolean;
var i:Integer;
begin
  i:=0;
  result:=true;
  while i<(Length(b)-2) do
  begin
    if (b[i]<=$7f) then
    begin
      //1バイト文字
      inc(i);
      continue;
    end;
    if (b[i]=$8e) and (b[i+1]>=$a1) and (b[i+1]<=$df) then
    begin
      //2バイト文字
      inc(i,2);
      continue;
    end;
    if (b[i]>=$a1) and (b[i]<=$fe) and (b[i+1]>=$a1) and (b[i+1]<=$fe) then
    begin
      //2バイト文字
      inc(i,2);
      continue;
    end;
    if (b[i]=$8f) and (b[i+1]>=$a1) and (b[i+1]<=$fe) and
                      (b[i+2]>=$a1) and (b[i+2]<=$fe) then
    begin
      //3バイト文字
      inc(i,3);
      continue;
    end;
    result:=false;
    break;
  end;
end;

function isSJIS(b:TBytes):boolean;
var i:Integer;
begin
  i:=0;
  result:=true;
  while i<(Length(b)-1) do
  begin
    if(b[i]<$7f)or((b[i]>=$a1)and(b[i]<=$df))then
    begin
      //1バイト文字
      inc(i);
      continue;
    end;
    if (b[i]>=$81) and (b[i]<=$9f) and (b[i+1]>=$40) and (b[i+1]<=$7e) then
    begin
      //2バイト文字
      inc(i,2);
      continue;
    end;
    if (b[i]>=$81) and (b[i]<=$9f) and (b[i+1]>=$80) and (b[i+1]<=$fc) then
    begin
      //2バイト文字
      inc(i,2);
      continue;
    end;
    if (b[i]>=$e0) and (b[i]<=$fc) and (b[i+1]>=$40) and (b[i+1]<=$7e) then
    begin
      //2バイト文字
      inc(i,2);
      continue;
    end;
    if (b[i]>=$e0) and (b[i]<=$fc) and (b[i+1]>=$80) and (b[i+1]<=$fc) then
    begin
      //2バイト文字
      inc(i,2);
      continue;
    end;
    result:=false;
    break;
  end;
end;


function JudgeCharCodeFromFile(Filename:String;Len:UInt16=1024):String;
var b:TBytes;
    strm:TFileStream;
begin
  Result:='';
  if Len<4 then Len:=4;
  if not FileExists(Filename) then
  begin
    Result:='NOFILE';
    exit;
  end;
  strm:=TFileStream.Create(Filename,fmOpenRead OR fmShareDenyNone);
  try
    if strm.Size<4 then
    begin
      //4バイト未満だと判定しない
      Result:='UNKNOWN';//不明
    end
    else
    begin
      if strm.Size<Len then Len:=strm.Size;

      SetLength(b,Len);
      strm.Read(b,Len);
    end;
  finally
    strm.Free;
  end;
  if Result<>'' then exit;

  //BOMの判定
  if (b[0]=$ff) and (b[1]=$fe) then
  begin
    if (b[2]=$00) and (b[3]=$00) then
    begin
      //UTF-32LE BOM付
      Result:='UTF32LE';
      Exit;
    end
    else
    begin
      //UTF-16LE BOM付
      Result:='UTF16LE';
      Exit;
    end;
  end;
  if (b[0]=$fe) and (b[1]=$ff) then
  begin
    //UTF-16BE BOM付
    Result:='UTF16BE';
    Exit;
  end;
  if (b[0]=$00) and (b[1]=$00) and (b[2]=$fe) and (b[3]=$ff) then
  begin
    //UTF-32BE BOM付
    Result:='UTF32BE';
    Exit;
  end;
  if (b[0]=$ef) and (b[1]=$bb) and (b[2]=$bf) then
  begin
    //UTF-8 BOM付
    Result:='UTF8';
    Exit;
  end;

  if IsISO2022JP(b) then
  begin
    Result:='JIS';
    Exit;
  end;
  if IsUTF8(b) then
  begin
    Result:='UTF8';
    Exit;
  end;
  if IsUTF16LE(b) then
  begin
    Result:='UTF16LE';
    Exit;
  end;
  if IsUTF16BE(b) then
  begin
    Result:='UTF16BE';
    Exit;
  end;
  //Shift-JISとEUC-JPの判定は微妙なので最後に持っていく
  if IsEUCJP(b) then
  begin
    Result:='EUCJP';
    Exit;
  end;
  if IsSJIS(b) then
  begin
    Result:='SJIS';
    Exit;
  end;

  Result:='UNKNOWN';
end;

end.