В Windows есть готовые функции для этого. Блокнот использует IsTextUnicode, Internet Explorer использует MLang.
Например, если использовать ComboBox с содержимым вида:
То можно использовать такой код:
procedure TForm1.btOpenClick(Sender: TObject);
var
Encoding: TEncoding;
Lines: TStringList;
begin
if not OpenDialog.Execute then
Exit;
// Определили кодировку
case cbEncoding.ItemIndex of
1: Encoding := TEncoding.ANSI;
2: Encoding := TEncoding.UTF8;
3: Encoding := TEncoding.Unicode;
else
Encoding := DetectEncoding(OpenDialog.FileName);
end;
// Загрузили файл в Memo
try
Lines := TStringList.Create;
try
Lines.LoadFromFile(OpenDialog.FileName, Encoding);
mmContent.Lines.Assign(Lines);
finally
FreeAndNil(Lines);
end;
finally
if not TEncoding.IsStandardEncoding(Encoding) then
FreeAndNil(Encoding);
end;
end;
Где DetectEncoding
- это наша функция. Например, если мы хотим поведение "как у Блокнота", то используем такой код:
function DetectEncoding(const AFileName: String): TEncoding;
const
MaxBufferSize = 256;
var
Buffer: RawByteString;
Stream: TStream;
Mask: Integer;
Len: Int64;
begin
// Загрузили начало файла в буфер Buffer для анализа
Stream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
try
Len := Stream.Size;
if Len > MaxBufferSize then
SetLength(Buffer, MaxBufferSize)
else
SetLength(Buffer, Len);
Stream.Position := 0;
Stream.ReadBuffer(Pointer(Buffer)^, Length(Buffer));
finally
FreeAndNil(Stream);
end;
// Явная проверка на UTF-8 с BOM,
// т.к. IsTextUnicode на UTF-8 не проверяет
if Copy(Buffer, 1, 3) = #$EF#$BB#$BF then
begin
Result := TEncoding.UTF8;
Exit;
end;
// Вызываем анализ "как в Блокноте"
// Это сможет отличить только UTF-16 от ANSI
Mask :=
IS_TEXT_UNICODE_UNICODE_MASK or
IS_TEXT_UNICODE_REVERSE_MASK or
IS_TEXT_UNICODE_NOT_UNICODE_MASK or
IS_TEXT_UNICODE_NOT_ASCII_MASK;
IsTextUnicode(Pointer(Buffer), Length(Buffer), @Mask);
// UTF-16
if (Len mod 2 = 0) and
(Mask and IS_TEXT_UNICODE_UNICODE_MASK <> 0) then
Result := TEncoding.Unicode
else
// UTF-16 (big endian)
if (Len mod 2 = 0) and
(Mask and IS_TEXT_UNICODE_REVERSE_MASK <> 0) then
Result := TEncoding.BigEndianUnicode
else
Result := TEncoding.ANSI;
end;
Если же мы хотим поведение "как в Internet Explorer", то используем такой код:
type
tagDetectEncodingInfo = packed record
nLangID: SYSUINT;
nCodePage: SYSUINT;
nDocPercent: SYSINT;
nConfidence: SYSINT;
end;
IMultiLanguage2 = interface(IUnknown)
['{DCCFC164-2B38-11D2-B7EC-00C04F8F5D9A}']
function GetNumberOfCodePageInfo(out pcCodePage: SYSUINT): HResult; stdcall;
function GetCodePageInfo(uiCodePage: SYSUINT; LangId: Word; out pCodePageInfo: Pointer): HResult; stdcall;
function GetFamilyCodePage(uiCodePage: SYSUINT; out puiFamilyCodePage: SYSUINT): HResult; stdcall;
function EnumCodePages(grfFlags: Cardinal; LangId: Word; out ppEnumCodePage: Pointer): HResult; stdcall;
function GetCharsetInfo(const Charset: WideString; out pCharsetInfo: Pointer): HResult; stdcall;
function IsConvertible(dwSrcEncoding: Cardinal; dwDstEncoding: Cardinal): HResult; stdcall;
function ConvertString(var pdwMode: Cardinal; dwSrcEncoding: Cardinal; dwDstEncoding: Cardinal; var pSrcStr: Byte; var pcSrcSize: SYSUINT; var pDstStr: Byte; var pcDstSize: SYSUINT): HResult; stdcall;
function ConvertStringToUnicode(var pdwMode: Cardinal; dwEncoding: Cardinal; pSrcStr: PAnsiChar; var pcSrcSize: SYSUINT; pDstStr: PWideChar; var pcDstSize: SYSUINT): HResult; stdcall;
function ConvertStringFromUnicode(var pdwMode: Cardinal; dwEncoding: Cardinal; pSrcStr: PWideChar; var pcSrcSize: SYSUINT; pDstStr: PAnsiChar; var pcDstSize: SYSUINT): HResult; stdcall;
function ConvertStringReset: HResult; stdcall;
function GetRfc1766FromLcid(locale: Cardinal; out pbstrRfc1766: WideString): HResult; stdcall;
function GetLcidFromRfc1766(out plocale: Cardinal; const bstrRfc1766: WideString): HResult; stdcall;
function EnumRfc1766(LangId: Word; out ppEnumRfc1766: Pointer): HResult; stdcall;
function GetRfc1766Info(locale: Cardinal; LangId: Word; out pRfc1766Info: Pointer): HResult; stdcall;
function CreateConvertCharset(uiSrcCodePage: SYSUINT; uiDstCodePage: SYSUINT; dwProperty: Cardinal; out ppMLangConvertCharset: Pointer): HResult; stdcall;
function ConvertStringInIStream(var pdwMode: Cardinal; dwFlag: Cardinal; var lpFallBack: Word; dwSrcEncoding: Cardinal; dwDstEncoding: Cardinal; const pstmIn: ISequentialStream; const pstmOut: ISequentialStream): HResult; stdcall;
function ConvertStringToUnicodeEx(var pdwMode: Cardinal; dwEncoding: Cardinal; pSrcStr: PAnsiChar; var pcSrcSize: SYSUINT; pDstStr: PWideChar; var pcDstSize: SYSUINT; dwFlag: Cardinal; var lpFallBack: Word): HResult; stdcall;
function ConvertStringFromUnicodeEx(var pdwMode: Cardinal; dwEncoding: Cardinal; pSrcStr: PWideChar; var pcSrcSize: SYSUINT; pDstStr: PAnsiChar; var pcDstSize: SYSUINT; dwFlag: Cardinal; var lpFallBack: Word): HResult; stdcall;
function DetectCodepageInIStream(dwFlag: Cardinal; dwPrefWinCodePage: Cardinal; const pstmIn: ISequentialStream; var lpEncoding: tagDetectEncodingInfo; var pnScores: SYSINT): HResult; stdcall;
function DetectInputCodepage(dwFlag: Cardinal; dwPrefWinCodePage: Cardinal; pSrcStr: PAnsiChar; var pcSrcSize: SYSINT; var lpEncoding: tagDetectEncodingInfo; var pnScores: SYSINT): HResult; stdcall;
function ValidateCodePage(uiCodePage: SYSUINT; hwnd: HWND): HResult; stdcall;
function GetCodePageDescription(uiCodePage: SYSUINT; lcid: Cardinal; lpWideCharStr: PWideChar; cchWideChar: SYSINT): HResult; stdcall;
function IsCodePageInstallable(uiCodePage: SYSUINT): HResult; stdcall;
function SetMimeDBSource(dwSource: Pointer): HResult; stdcall;
function GetNumberOfScripts(out pnScripts: SYSUINT): HResult; stdcall;
function EnumScripts(dwFlags: Cardinal; LangId: Word; out ppEnumScript: Pointer): HResult; stdcall;
function ValidateCodePageEx(uiCodePage: SYSUINT; hwnd: HWND; dwfIODControl: Cardinal): HResult; stdcall;
end;
TSequentialStreamAdapter = class(TStreamAdapter, IStream, ISequentialStream);
function DetectEncoding(const AFileName: String): TEncoding;
function DetectEncodingInternal(const AFileName: String): TEncoding;
const
CLSID_CMultiLanguage: TGUID = '{275C23E2-3747-11D0-9FEA-00AA003F8646}';
MLDETECTCP_NONE = 0;
MaxEncodings = 10;
var
Stream: ISequentialStream; // uses Winapi.ActiveX
MLang: IMultiLanguage2;
Encodings: array of tagDetectEncodingInfo;
Encoding: tagDetectEncodingInfo;
Count: Integer;
X: Integer;
HR: HRESULT;
begin
// Получаем интерфейс MLang
Result := nil;
try
MLang := CreateComObject(CLSID_CMultiLanguage) as IMultiLanguage2; // uses System.Win.ComObj
except
on EOleSysError do
Result := TEncoding.Default;
end;
if Result <> nil then
Exit;
// Определяем кодировку файла
Stream := TSequentialStreamAdapter.Create(TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone), soOwned);
Count := MaxEncodings;
SetLength(Encodings, Count);
FillChar(Encodings[0], Count * SizeOf(Encodings[0]), 0);
HR := MLang.DetectCodepageInIStream(MLDETECTCP_NONE, 0, Stream, Encodings[0], Count);
if Failed(HR) or (Count <= 0) then
begin
Result := TEncoding.Default;
Exit;
end;
// Выбираем самый вероятный вариант
Encoding := Encodings[0];
for X := 1 to Count - 1 do
begin
if Encodings[X].nConfidence > Encoding.nConfidence then
Encoding := Encodings[X]
else
if Encodings[X].nConfidence = Encoding.nConfidence then
if Encodings[X].nDocPercent > Encoding.nDocPercent then
Encoding := Encodings[X];
end;
Result := TEncoding.GetEncoding(Encoding.nCodePage);
end;
var
HR: HRESULT;
begin
HR := CoInitializeEx(nil, 0);
if (HR = RPC_E_CHANGED_MODE) or (not Succeeded(HR)) then
Result := DetectEncodingInternal(AFileName)
else
try
Result := DetectEncodingInternal(AFileName);
finally
CoUninitialize;
end;
end;