SRC: DELPHI: Декодер кодировок на базе MLang.dll
От: Sinclair Россия https://github.com/evilguest/
Дата: 11.11.02 22:50
Оценка: 3 (1)
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.
Уйдемте отсюда, Румата! У вас слишком богатые погреба.
 
Подождите ...
Wait...
Пока на собственное сообщение не было ответов, его можно удалить.