unit CharsetDecoder;
interface
uses Windows, ActiveX, MultiLanguage;
type
TCharsetDecoder = class
private
FCPInfo: tagMIMECPINFO;
procedure SetCharsetName(const Value: String);
function GetCharsetName: String;
procedure SetCodePage(const Value: DWORD);
function GetCodePage: DWORD;
protected
FMultiLanguage: IMultiLanguage;
function Recode(Source: String; ToNative: boolean): String;
constructor Create; overload;
public
constructor Create(CharsetName: String); overload;
constructor Create(CodePage: DWORD); overload;
property CharsetName: String read GetCharsetName write SetCharsetName;
property CodePage: DWORD read GetCodePage write SetCodePage;
// Returns
function NativeCodePage: DWORD;
// Decodes the string in the specified encoding to the windows-native code page
// for example from DOS (cp: 866, charset: 'cp866') to Windows (cp:1251)
function Decode(Source: String): String;
// Encodes the string in the windows-native encoding to the specified code page
// for example to DOS (cp: 866, charset: 'cp866') from Windows (cp:1251)
function Encode(Source: String): String;
end;
implementation
uses SysUtils;
{ TCharsetDecoder }
constructor TCharsetDecoder.Create;
var
hr: HRESULT;
begin
inherited Create;
hr := CoCreateInstance(Class_CMultiLanguage, nil, CLSCTX_INPROC_SERVER, IID_IMultiLanguage, FMultiLanguage);
Assert(Succeeded(Hr), 'Failed to create the Multilanguage class instance');
end;
constructor TCharsetDecoder.Create(CharsetName: String);
begin
Create;
SetCharsetName(Charsetname);
end;
constructor TCharsetDecoder.Create(CodePage: DWORD);
begin
Create;
SetCodePage(CodePage);
end;
function TCharsetDecoder.Decode(Source: String): String;
begin
Result:= Recode(Source, True);
end;
function TCharsetDecoder.Encode(Source: String): String;
begin
Result:= Recode(Source, False);
end;
function TCharsetDecoder.GetCharsetName: String;
begin
Result:= WideCharToString(@FCPInfo.wszWebCharset);
end;
function TCharsetDecoder.GetCodePage: DWORD;
begin
Result:= FCPInfo.uiCodePage;
end;
function TCharsetDecoder.NativeCodePage: DWORD;
begin
Result:= FCPInfo.uiFamilyCodePage;
end;
function TCharsetDecoder.Recode(Source: String; ToNative: boolean): String;
var
HR: HRESULT;
dwMode: DWORD;
SrcSize, DstSize: UINT;
begin
dwMode:=0;
SrcSize:= Length(Source);
DstSize:= SrcSize;
SetLength(Result, DstSize);
if ToNative
then
HR:= FMultiLanguage.ConvertString(dwMode, FCPInfo.uiCodePage,
FCPInfo.uiFamilyCodePage, BYTE(Source[1]), SrcSize, BYTE(Result[1]), DstSize)
else
HR:= FMultiLanguage.ConvertString(dwMode, FCPInfo.uiFamilyCodePage,
FCPInfo.uiCodePage, BYTE(Source[1]), SrcSize, BYTE(Result[1]), DstSize);
Assert(Succeeded(HR), 'Couldn''t convert the string');
end;
procedure TCharsetDecoder.SetCharsetName(const Value: String);
var
CSInfo: tagMIMECSETINFO;
HR: HRESULT;
begin
if GetCharsetName <> Value
then begin
HR:= FMultiLanguage.GetCharsetInfo(WideString(Value), CSInfo);
if Succeeded(hr)
then begin
FMultiLanguage.GetCodePageInfo(CSInfo.uiInternetEncoding, FCPInfo);
end;
end;
end;
procedure TCharsetDecoder.SetCodePage(const Value: DWORD);
begin
if GetCodePage <> Value
then begin
FMultiLanguage.GetCodePageInfo(Value, FCPInfo);
end;
end;
end.