unit uCode;
interface
function gfniCodePageGet(pBuff: PAnsiChar; iCount: Integer): Integer;
implementation
uses
Windows,
ActiveX;
//------------------------------------------------------------------------------
//文字コードの自動判定
//http://mrxray.on.coocan.jp/Delphi/plSamples/886_ChangeCodePage.htm
//http://www.delphikingdom.com/asp/answer.asp?IDAnswer=16895
//https://groups.google.com/group/delphicbuilder-ml-archive/msg/9c9767ff7e738d3a?hl=ja&
const
IID_IMultiLanguage2 : TGUID = '{DCCFC164-2B38-11D2-B7EC-00C04F8F5D9A}';
CLASS_CMultiLanguage : TGUID = '{275C23E2-3747-11D0-9FEA-00AA003F8646}';
type
tagMIMECPINFO =
packed record
dwFlags : LongWord;
uiCodePage : SYSUINT;
uiFamilyCodePage : SYSUINT;
wszDescription :
array[0..63]
of Word;
wszWebCharset :
array[0..49]
of Word;
wszHeaderCharset :
array[0..49]
of Word;
wszBodyCharset :
array[0..49]
of Word;
wszFixedWidthFont :
array[0..31]
of Word;
wszProportionalFont :
array[0..31]
of Word;
bGDICharset : Byte;
end;
tagMIMECSETINFO =
packed record
uiCodePage : SYSUINT;
uiInternetEncoding : SYSUINT;
wszCharset :
array[0..49]
of Word;
end;
tagRFC1766INFO =
packed record
lcid : LongWord;
wszRfc1766 :
array[0..5]
of Word;
wszLocaleName :
array[0..31]
of Word;
end;
tagDetectEncodingInfo = packed record
nLangID : SYSUINT;
nCodePage : SYSUINT;
nDocPercent : SYSINT;
nConfidence : SYSINT;
end;
tagSCRIPTINFO = packed record
ScriptId : Byte;
uiCodePage : SYSUINT;
wszDescription :
array[0..47]
of Word;
wszFixedWidthFont :
array[0..31]
of Word;
wszProportionalFont :
array[0..31]
of Word;
end;
__MIDL_IWinTypes_0009 =
record
case Integer
of
0 : (hInproc : Integer);
1 : (hRemote : Integer);
end;
_RemotableHandle = packed
record
fContext : Integer;
u : __MIDL_IWinTypes_0009;
end;
tagMIMECONTF = TOleEnum;
// *********************************************************************//
// Interface: IEnumCodePage
// Flags: (0)
// GUID: {275C23E3-3747-11D0-9FEA-00AA003F8646}
// *********************************************************************//
IEnumCodePage =
interface(IUnknown)
['{275C23E3-3747-11D0-9FEA-00AA003F8646}']
function Clone(
out ppEnum: IEnumCodePage): HResult;
stdcall;
function Next(celt: LongWord;
out rgelt: tagMIMECPINFO;
out pceltFetched: LongWord): HResult;
stdcall;
function Reset: HResult;
stdcall;
function Skip(celt: LongWord): HResult;
stdcall;
end;
// *********************************************************************//
// Interface: IEnumRfc1766
// Flags: (0)
// GUID: {3DC39D1D-C030-11D0-B81B-00C04FC9B31F}
// *********************************************************************//
IEnumRfc1766 =
interface(IUnknown)
['{3DC39D1D-C030-11D0-B81B-00C04FC9B31F}']
function Clone(
out ppEnum: IEnumRfc1766): HResult;
stdcall;
function Next(celt: LongWord;
out rgelt: tagRFC1766INFO;
out pceltFetched: LongWord): HResult;
stdcall;
function Reset: HResult;
stdcall;
function Skip(celt: LongWord): HResult;
stdcall;
end;
// *********************************************************************//
// Interface: IMLangConvertCharset
// Flags: (0)
// GUID: {D66D6F98-CDAA-11D0-B822-00C04FC9B31F}
// *********************************************************************//
IMLangConvertCharset =
interface(IUnknown)
['{D66D6F98-CDAA-11D0-B822-00C04FC9B31F}']
function Initialize(uiSrcCodePage: SYSUINT; uiDstCodePage: SYSUINT; dwProperty:
LongWord): HResult;
stdcall;
function GetSourceCodePage(
out puiSrcCodePage: SYSUINT): HResult;
stdcall;
function GetDestinationCodePage(
out puiDstCodePage: SYSUINT): HResult;
stdcall;
function GetProperty(
out pdwProperty: LongWord): HResult;
stdcall;
//*****
// function DoConversion(var pSrcStr: Byte; var pcSrcSize: SYSUINT; var pDstStr: Byte;
// var pcDstSize: SYSUINT): HResult; stdcall;
function DoConversion(
pSrcStr : PAnsiChar;
var pcSrcSize : SYSUINT;
pDstStr : PAnsiChar;
var pcDstSize : SYSUINT
) : HResult;
stdcall;
function DoConversionToUnicode(
var pSrcStr: Shortint;
var pcSrcSize: SYSUINT;
var pDstStr: Word;
var pcDstSize: SYSUINT): HResult;
stdcall;
function DoConversionFromUnicode(
var pSrcStr: Word;
var pcSrcSize: SYSUINT;
var pDstStr: Shortint;
var pcDstSize: SYSUINT): HResult;
stdcall;
end;
// *********************************************************************//
// Interface: IEnumScript
// Flags: (0)
// GUID: {AE5F1430-388B-11D2-8380-00C04F8F5DA1}
// *********************************************************************//
IEnumScript =
interface(IUnknown)
['{AE5F1430-388B-11D2-8380-00C04F8F5DA1}']
function Clone(
out ppEnum: IEnumScript): HResult;
stdcall;
function Next(celt: LongWord;
out rgelt: tagSCRIPTINFO;
out pceltFetched: LongWord): HResult;
stdcall;
function Reset: HResult;
stdcall;
function Skip(celt: LongWord): HResult;
stdcall;
end;
// *********************************************************************//
// Interface: IMultiLanguage2
// Flags: (0)
// GUID: {DCCFC164-2B38-11D2-B7EC-00C04F8F5D9A}
// *********************************************************************//
IMultiLanguage2 =
interface(IUnknown)
['{DCCFC164-2B38-11D2-B7EC-00C04F8F5D9A}']
function GetNumberOfCodePageInfo(
out pcCodePage: SYSUINT): HResult;
stdcall;
function GetCodePageInfo(uiCodePage: SYSUINT; LangId: Word;
out pCodePageInfo: tagMIMECPINFO): HResult;
stdcall;
function GetFamilyCodePage(uiCodePage: SYSUINT;
out puiFamilyCodePage: SYSUINT): HResult;
stdcall;
function EnumCodePages(grfFlags: LongWord; LangId: Word;
out ppEnumCodePage: IEnumCodePage): HResult;
stdcall;
function GetCharsetInfo(
const Charset: WideString;
out pCharsetInfo: tagMIMECSETINFO): HResult;
stdcall;
function IsConvertible(dwSrcEncoding: LongWord; dwDstEncoding: LongWord): HResult; stdcall;
//*****
// function ConvertString(var pdwMode: LongWord; dwSrcEncoding: LongWord; dwDstEncoding: LongWord;
// var pSrcStr: Byte; var pcSrcSize: SYSUINT; var pDstStr: Byte;
// var pcDstSize: SYSUINT): HResult; stdcall;
function ConvertString(
var pdwMode : LongWord;
dwSrcEncoding : LongWord;
dwDstEncoding : LongWord;
var pSrcStr : Byte;
var pcSrcSize : SYSUINT;
var pDstStr : Byte;
var pcDstSize : SYSUINT
) : HResult;
stdcall;
//*****
// function ConvertStringToUnicode(var pdwMode: LongWord; dwEncoding: LongWord;
// var pSrcStr: Shortint; var pcSrcSize: SYSUINT;
// var pDstStr: Word; var pcDstSize: SYSUINT): HResult; stdcall;
function ConvertStringToUnicode(
var pdwMode : DWORD;
dwEncoding : DWORD;
pSrcStr : PAnsiChar;
var pcSrcSize : SYSUINT;
pDstStr : PWideChar;
var pcDstSize : SYSUINT
) : HResult;
stdcall;
//*****
// function ConvertStringFromUnicode(var pdwMode: LongWord; dwEncoding: LongWord;
// var pSrcStr: Word; var pcSrcSize: SYSUINT;
// var pDstStr: Shortint; var pcDstSize: SYSUINT): HResult; stdcall;
function ConvertStringFromUnicode(
var pdwMode : DWORD;
dwEncoding : DWORD;
pSrcStr : PWideChar;
var pcSrcSize : SYSUINT;
pDstStr : PAnsiChar;
var pcDstSize : SYSUINT
) : HResult;
stdcall;
function ConvertStringReset: HResult;
stdcall;
function GetRfc1766FromLcid(locale: LongWord;
out pbstrRfc1766: WideString): HResult;
stdcall;
function GetLcidFromRfc1766(
out plocale: LongWord; const bstrRfc1766: WideString): HResult;
stdcall;
function EnumRfc1766(LangId: Word;
out ppEnumRfc1766: IEnumRfc1766): HResult;
stdcall;
function GetRfc1766Info(locale: LongWord; LangId: Word;
out pRfc1766Info: tagRFC1766INFO): HResult;
stdcall;
function CreateConvertCharset(uiSrcCodePage: SYSUINT; uiDstCodePage: SYSUINT;
dwProperty: LongWord;
out ppMLangConvertCharset: IMLangConvertCharset): HResult;
stdcall;
function ConvertStringInIStream(
var pdwMode: LongWord; dwFlag: LongWord;
var lpFallBack: Word;
dwSrcEncoding: LongWord; dwDstEncoding: LongWord;
const pstmIn: ISequentialStream;
const pstmOut: ISequentialStream): HResult;
stdcall;
function ConvertStringToUnicodeEx(
var pdwMode: LongWord; dwEncoding: LongWord;
var pSrcStr: Shortint;
var pcSrcSize: SYSUINT;
var pDstStr: Word;
var pcDstSize: SYSUINT; dwFlag: LongWord;
var lpFallBack: Word): HResult;
stdcall;
function ConvertStringFromUnicodeEx(
var pdwMode: LongWord; dwEncoding: LongWord;
var pSrcStr: Word;
var pcSrcSize: SYSUINT;
var pDstStr: Shortint;
var pcDstSize: SYSUINT;
dwFlag:
LongWord;
var lpFallBack: Word): HResult;
stdcall;
function DetectCodepageInIStream(dwFlag: LongWord; dwPrefWinCodePage: LongWord;
const pstmIn: ISequentialStream;
var lpEncoding: tagDetectEncodingInfo;
var pnScores: SYSINT): HResult;
stdcall;
//*****
// function DetectInputCodepage(dwFlag: LongWord; dwPrefWinCodePage: LongWord;
// var pSrcStr: Shortint; var pcSrcSize: SYSINT;
// var lpEncoding: tagDetectEncodingInfo; var pnScores: SYSINT): HResult; stdcall;
function DetectInputCodepage(
dwFlag : DWORD;
dwPrefWinCodePage : DWORD;
pSrcStr : PAnsiChar;
var pcSrcSize : SYSINT;
var lpEncoding : tagDetectEncodingInfo;
var pnScores : SYSINT
) : HResult;
stdcall;
function ValidateCodePage(uiCodePage: SYSUINT;
var hwnd: _RemotableHandle): HResult;
stdcall;
function GetCodePageDescription(uiCodePage: SYSUINT; lcid: LongWord; lpWideCharStr:
PWideChar;
cchWideChar: SYSINT):
HResult;
stdcall;
function IsCodePageInstallable(uiCodePage: SYSUINT): HResult;
stdcall;
function SetMimeDBSource(dwSource: tagMIMECONTF): HResult;
stdcall;
function GetNumberOfScripts(
out pnScripts: SYSUINT): HResult;
stdcall;
function EnumScripts(dwFlags: LongWord; LangId: Word;
out ppEnumScript: IEnumScript): HResult;
stdcall;
function ValidateCodePageEx(uiCodePage: SYSUINT;
var hwnd: _RemotableHandle;
dwfIODControl: LongWord): HResult;
stdcall;
end;
{
Mlang.dllを利用して文字列の文字コードを自動判定するためにIMultiLanguage2インター
フェースのDetectInputCodepageメソッドを使用。
そのためだけにこの宣言が必要。
}
//------------------------------------------------------------------------------
function gfniCodePageGet(pBuff: PAnsiChar; iCount: Integer): Integer;
var
l_IMultiLanguage : IMultiLanguage2;
l_Encoding : tagDetectEncodingInfo;
li_Source : SYSINT;
lb_LE : Boolean;
lb_BE : Boolean;
i : Integer;
begin
Result := 1252;
if (Succeeded(CoCreateInstance(
CLASS_CMultiLanguage,
//オブジェクトのCLSID
nil,
//複数オブジェクトの一部の時はIUnknownインターフェイスのポインタ
CLSCTX_INPROC_SERVER,
//管理コードを実行するコンテキスト
IID_IMultiLanguage2,
//取得するIID
l_IMultiLanguage
//生成オブジェクトの変数アドレス
)))
then
begin
li_Source := 1;
if (Succeeded(l_IMultiLanguage.DetectInputCodepage(0, 0, pBuff, iCount, l_Encoding,
li_Source)))
then
begin
//BOMなしのUTF-16は正しく判定できないようだ。
Result := l_Encoding.nCodePage;
end;
l_IMultiLanguage :=
nil;
end;
if (Result = 1252)
then
begin
lb_LE := False;
lb_BE := False;
for i := 0
to iCount-1
do
begin
if (pBuff[i] = #0)
then
begin
//#0があったのでUTF-16とする。
//半角の英数記号の半分のバイトは0x00なので#0があればUTF-16と判定するというかなり適当な処理。
if (Odd(i))
then
begin
//リトルエンデアン
if (lb_BE)
then
begin
//既にビッグエンディアンとして推定していた→UTF-16ではない(おそらくバイナリデータ)
lb_BE := False;
Break;
end;
lb_LE := True;
end else
begin
//ビッグエンディアン
if (lb_LE)
then
begin
//既にリトルエンディアンとして推定していた→UTF-16ではない(おそらくバイナリデータ)
lb_LE := False;
Break;
end;
lb_BE := True;
end;
end;
end;
if (lb_LE
or lb_BE)
then
begin
if (lb_LE)
then
begin
Result := 1200;
end else
if (lb_BE)
then
begin
Result := 1201;
end;
end;
end;
end;
end.
ただしBOMのないUTF-16はこのDetectInputCodepageメソッドでは判定できないようで1252(Windows-1252)が返ってきてしまいます。
そこで1252が返ってきたらBOMなしのUTF-16である可能性を考えた対処をします。
と言っても判定するデータの中に
読み込んだデータ中にShift_JISの範囲外の文字があったりShift_JISの第1バイトに続く第2バイト目が正しくなかった場合はShift_JISではないと判定します。
これにより半角英数のないUTF-16のファイルも正しく判定できる可能性が高まります。
またUTF-16のエンディアンについては、とりあえずリトルエンディアンとして仮定しひらがなもしくはカタカナがあるかを1文字ずつ見ていきます。
そしてひらがなとカタカナの比率が1%未満であればエンディアンが違うものとして判定しています。
このあたりの判定の仕方は色々工夫のしがいがあるかと思います。
function gfniFileSizeGet(sFile:
WideString): Int64;
//sWFileのサイズをByte単位で返す。
var
lh_File : Cardinal;
lr_Info : TWin32FindDataW;
begin
Result := 0;
lh_File := FindFirstFileW(PWideChar(sFile), lr_Info);
try
if (lh_File <> INVALID_HANDLE_VALUE)
then
begin
repeat
if not(BOOL(lr_Info.dwFileAttributes
and FILE_ATTRIBUTE_DIRECTORY))
then
begin
Result := lr_Info.nFileSizeHigh * (Int64(MAXDWORD)
+ 1) + lr_Info.nFileSizeLow;
Break;
end;
until not(FindNextFileW(lh_File, lr_Info));
end;
finally
Windows.FindClose(lh_File);
end;
end;
function gfnsFileReadText(sFile:
WideString):
WideString;
//Unicode対応テキストファイル読み込み。
//文字コードは自動判定
//http://www.xmleditor.jp/blog/archives/40
var
lh_Handle : THandle;
lp_Buff : PAnsiChar;
li_Count : DWORD;
li_Size : DWORD;
li_Len : Integer;
lp_Endian : PWideChar;
begin
li_Size :=
gfniFileSizeGet(sFile);
lp_Buff := AllocMem(li_Size +2);
//WideString(lp_Buff)としても問題ないように+2
try
lh_Handle := CreateFileW(
PWideChar(sFile),
//ファイル名
GENERIC_READ,
//アクセスモード
FILE_SHARE_READ,
//共有モード
nil,
//セキュリティ
OPEN_EXISTING,
//作成方法
FILE_ATTRIBUTE_NORMAL,
//ファイル属性
0
//テンプレート
);
ReadFile(lh_Handle, lp_Buff^, li_Size, li_Count,
nil);
CloseHandle(lh_Handle);
if (li_Count <= 0)
then
begin
Result := '';
end else
begin
case gfniCodePageGet(lp_Buff, li_Count)
of
65001
//UTF-8
:
begin
Result :=
gfnsUtf8ToWide(Utf8String(PAnsiChar(lp_Buff)));
end;
1200
//UTF-16 LE (リトルエンディアン)
:
begin
Result :=
WideString(PWideChar(lp_Buff));
end;
1201
//UTF-16 BE (ビッグエンディアン)
:
begin
Result :=
WideString(PWideChar(lp_Buff));
//ビッグエンディアンなのでエンディアン入れ替え
li_Len := LCMapStringW(GetUserDefaultLCID(),
LCMAP_BYTEREV, PWideChar(Result), -1,
nil, 0);
lp_Endian := AllocMem((li_Len +1) *
2);
try
LCMapStringW(GetUserDefaultLCID(),
LCMAP_BYTEREV, PWideChar(Result), -1, lp_Endian, li_Len);
Result :=
WideString(lp_Endian);
finally
FreeMem(lp_Endian);
end;
end;
65000
//UTF-7
:
begin
Result :=
gfnsUtf7ToWide(AnsiString(lp_Buff));
end;
50220,
//日本語 (JIS) iso-2022-jp
50221,
//日本語 (JIS 1 バイト カタカナ可) csISO2022JP
50222,
//日本語 (JIS 1 バイト カタカナ可 - SO/SI) iso-2022-jp
50225,
//韓国語 (ISO) iso-2022-kr
50227
//簡体字中国語 (ISO-2022) x-cp50227
:
begin
Result :=
gfnsJisToWide(AnsiString(lp_Buff));
end;
20932,
//日本語 (JIS 0208-1990 および 0212-1990) EUC-JP
51932,
//日本語 (EUC) euc-jp
51936,
//簡体字中国語 (EUC) EUC-CN
51949
//韓国語 (EUC) euc-kr
:
begin
Result :=
gfnsEucToWide(AnsiString(lp_Buff));
end;
else
begin
//その他はShift-JISとして処理する
Result := AnsiString(lp_Buff);
end;
end;
//BOMがあれば取り除く
if (PAnsiChar(PWideChar(Result))[0] = #$FF)
or (PAnsiChar(PWideChar(Result))[1] = #$FE)
then
begin
Result := Copy(Result, 2, MAXINT);
end;
end;
finally
FreeMem(lp_Buff);
end;
end;