{
pascalx.io.charset.unicode — поддержка уникода.
Copyright © 2021, 2026 Малик Разработчик
Это свободная программа: вы можете перераспространять её и/или изменять
её на условиях Меньшей Стандартной общественной лицензии GNU в том виде,
в каком она была опубликована Фондом свободного программного обеспечения;
либо версии 3 лицензии, либо (по вашему выбору) любой более поздней версии.
Эта программа распространяется в надежде, что она будет полезной,
но БЕЗО ВСЯКИХ ГАРАНТИЙ; даже без неявной гарантии ТОВАРНОГО ВИДА
или ПРИГОДНОСТИ ДЛЯ ОПРЕДЕЛЁННЫХ ЦЕЛЕЙ. Подробнее см. в Меньшей Стандартной
общественной лицензии GNU.
Вы должны были получить копию Меньшей Стандартной общественной лицензии GNU
вместе с этой программой. Если это не так, см.
<https://www.gnu.org/licenses/>.
}
unit pascalx.io.charset.unicode;
{$MODE DELPHI}
interface
{%region} uses
pascalx.lang,
pascalx.io,
pascalx.io.charset,
pascalx.io.charset.eightbit;
{%endregion}
{$TYPEINFO ON}
{$CALLING REGISTER}
const UNIT_NAME = 'pascalx.io.charset.unicode';
{%region} type
UTF8 = class;
UTF16BE = class;
UTF16LE = class;
UTF8 = class sealed(Charset)
public
constructor create();
function newDecoder(): CharDecoder; override;
function newEncoder(): CharEncoder; override;
end;
UTF16BE = class sealed(Charset)
public
constructor create();
function newDecoder(): CharDecoder; override;
function newEncoder(): CharEncoder; override;
end;
UTF16LE = class sealed(Charset)
public
constructor create();
function newDecoder(): CharDecoder; override;
function newEncoder(): CharEncoder; override;
end;
{%endregion}
implementation
{$TYPEINFO OFF}
{$CALLING REGISTER}
{%region} type
UTF8Decoder = class;
UTF8Encoder = class;
UTF16BEDecoder = class;
UTF16BEEncoder = class;
UTF16LEDecoder = class;
UTF16LEEncoder = class;
UTF8Decoder = class sealed(CharDecoder)
private
fldBytesReaded: int;
fldByte0Data: int;
fldByte1Data: int;
procedure writeChar(dst: UCharWriter); overload;
procedure writeChar(dst: UCharWriter; lastByteData: int); overload;
protected
procedure decode(src: ByteReader; length: int; dst: UCharWriter); override;
end;
UTF8Encoder = class sealed(CharEncoder)
protected
procedure encode(src: UCharReader; length: int; dst: ByteWriter); override;
end;
UTF16BEDecoder = class sealed(CharDecoder)
private
fldByteReaded: boolean;
fldByteData: int;
protected
procedure decode(src: ByteReader; length: int; dst: UCharWriter); override;
end;
UTF16BEEncoder = class sealed(CharEncoder)
protected
procedure encode(src: UCharReader; length: int; dst: ByteWriter); override;
end;
UTF16LEDecoder = class sealed(CharDecoder)
private
fldByteReaded: boolean;
fldByteData: int;
protected
procedure decode(src: ByteReader; length: int; dst: UCharWriter); override;
end;
UTF16LEEncoder = class sealed(CharEncoder)
protected
procedure encode(src: UCharReader; length: int; dst: ByteWriter); override;
end;
{%endregion}
{%region UTF8 }
constructor UTF8.create();
begin
inherited create('UTF-8', [ 'UTF8', 'UTF' ]);
end;
function UTF8.newDecoder(): CharDecoder;
begin
result := UTF8Decoder.create(self);
end;
function UTF8.newEncoder(): CharEncoder;
begin
result := UTF8Encoder.create(self);
end;
{%endregion}
{%region UTF16BE }
constructor UTF16BE.create();
begin
inherited create('UTF-16 BE', [ 'UTF-16BE', 'UTF16 BE', 'UTF16BE', 'UCS-2 BE', 'UCS-2BE', 'UCS2 BE', 'UCS2BE' ]);
end;
function UTF16BE.newDecoder(): CharDecoder;
begin
result := UTF16BEDecoder.create(self);
end;
function UTF16BE.newEncoder(): CharEncoder;
begin
result := UTF16BEEncoder.create(self);
end;
{%endregion}
{%region UTF16LE }
constructor UTF16LE.create();
begin
inherited create('UTF-16 LE', [ 'UTF-16LE', 'UTF16 LE', 'UTF16LE', 'UTF-16', 'UTF16', 'UCS-2 LE', 'UCS-2LE', 'UCS2 LE', 'UCS2LE', 'UCS-2', 'UCS2' ]);
end;
function UTF16LE.newDecoder(): CharDecoder;
begin
result := UTF16LEDecoder.create(self);
end;
function UTF16LE.newEncoder(): CharEncoder;
begin
result := UTF16LEEncoder.create(self);
end;
{%endregion}
{%region UTF8Decoder }
procedure UTF8Decoder.writeChar(dst: UCharWriter);
var
b0: int;
b1: int;
begin
b0 := 0;
b1 := 0;
case fldBytesReaded of
2: begin
b0 := fldByte0Data;
b1 := fldByte1Data;
end;
1: begin
b0 := fldByte0Data;
end;
else
exit;
end;
fldBytesReaded := 0;
case b0 shr 4 of
$0c..$0d: begin
dst.write(((b0 and $1f) shl 6) or (b1 and $3f));
end;
$0e: begin
dst.write(((b0 and $0f) shl 12) or ((b1 and $3f) shl 6));
end;
end;
end;
procedure UTF8Decoder.writeChar(dst: UCharWriter; lastByteData: int);
var
b0: int;
b1: int;
b2: int;
begin
b0 := 0;
b1 := 0;
b2 := 0;
case fldBytesReaded of
2: begin
b0 := fldByte0Data;
b1 := fldByte1Data;
b2 := lastByteData;
end;
1: begin
b0 := fldByte0Data;
b1 := lastByteData;
end;
else
exit;
end;
fldBytesReaded := 0;
case b0 shr 4 of
$0c..$0d: begin
dst.write(((b0 and $1f) shl 6) or (b1 and $3f));
end;
$0e: begin
dst.write(((b0 and $0f) shl 12) or ((b1 and $3f) shl 6) or (b2 and $3f));
end;
end;
end;
procedure UTF8Decoder.decode(src: ByteReader; length: int; dst: UCharWriter);
var
byteData: int;
begin
while length > 0 do begin
dec(length);
byteData := src.read();
if (byteData < $00) or (byteData > $ff) then break;
case byteData shr 4 of
$00..$07: begin
writeChar(dst);
dst.write(byteData);
continue;
end;
$0c..$0e: begin
writeChar(dst);
fldByte0Data := byteData;
fldBytesReaded := 1;
continue;
end;
$08..$0b: begin
case fldBytesReaded of
1: begin
if (fldByte0Data shr 4) <> $0e then begin
writeChar(dst, byteData);
continue;
end;
fldByte1Data := byteData;
fldBytesReaded := 2;
continue;
end;
2: begin
if (fldByte0Data shr 4) = $0e then begin
writeChar(dst, byteData);
continue;
end;
end;
end;
end;
end;
writeChar(dst);
case errorAction of
eaException: begin
raise EightBitCharsetCharacterDecodingException.create(charset.name, byteData);
end;
eaReport: begin
report();
break;
end;
eaReplace: begin
dst.write($003f);
end;
end;
end;
end;
{%endregion}
{%region UTF8Encoder }
procedure UTF8Encoder.encode(src: UCharReader; length: int; dst: ByteWriter);
var
ucharData: int;
begin
while length > 0 do begin
dec(length);
ucharData := src.read();
if (ucharData < $0000) or (ucharData > $ffff) then break;
if (ucharData > $0000) and (ucharData < $0080) then begin
dst.write(ucharData);
continue;
end;
if ucharData < $0800 then begin
dst.write($c0 or ((ucharData shr 6) and $1f));
dst.write($80 or (ucharData and $3f));
continue;
end;
dst.write($e0 or ((ucharData shr 12) and $0f));
dst.write($80 or ((ucharData shr 6) and $3f));
dst.write($80 or (ucharData and $3f));
end;
end;
{%endregion}
{%region UTF16BEDecoder }
procedure UTF16BEDecoder.decode(src: ByteReader; length: int; dst: UCharWriter);
var
b0: int;
b1: int;
byteData: int;
begin
while length > 0 do begin
dec(length);
byteData := src.read();
if (byteData < $00) or (byteData > $ff) then break;
if fldByteReaded then begin
b0 := byteData;
b1 := fldByteData;
fldByteReaded := false;
dst.write((b1 shl 8) or b0);
continue;
end;
fldByteData := byteData;
fldByteReaded := true;
end;
end;
{%endregion}
{%region UTF16BEEncoder }
procedure UTF16BEEncoder.encode(src: UCharReader; length: int; dst: ByteWriter);
var
ucharData: int;
begin
while length > 0 do begin
dec(length);
ucharData := src.read();
if (ucharData < $0000) or (ucharData > $ffff) then break;
dst.write(ucharData shr 8);
dst.write(ucharData);
end;
end;
{%endregion}
{%region UTF16LEDecoder }
procedure UTF16LEDecoder.decode(src: ByteReader; length: int; dst: UCharWriter);
var
b0: int;
b1: int;
byteData: int;
begin
while length > 0 do begin
dec(length);
byteData := src.read();
if (byteData < $00) or (byteData > $ff) then break;
if fldByteReaded then begin
b1 := byteData;
b0 := fldByteData;
fldByteReaded := false;
dst.write((b1 shl 8) or b0);
continue;
end;
fldByteData := byteData;
fldByteReaded := true;
end;
end;
{%endregion}
{%region UTF16LEEncoder }
procedure UTF16LEEncoder.encode(src: UCharReader; length: int; dst: ByteWriter);
var
ucharData: int;
begin
while length > 0 do begin
dec(length);
ucharData := src.read();
if (ucharData < $0000) or (ucharData > $ffff) then break;
dst.write(ucharData);
dst.write(ucharData shr 8);
end;
end;
{%endregion}
end.
