📄 synachar.pas
字号:
ul := BinToInt(s);
w1 := ul div 65536;
w2 := ul mod 65536;
Result := Result + WriteMulti(Lo(w2), Hi(w2), Lo(w1), Hi(w1), 4, false);
end;
end;
end;
{==============================================================================}
function UCS4toUTF8(const Value: AnsiString): AnsiString;
var
s, l, k: AnsiString;
b1, b2, b3, b4: Byte;
n, m, x, y: Integer;
b: Byte;
begin
Result := '';
n := 1;
while Length(Value) >= n do
begin
ReadMulti(Value, n, 4, b1, b2, b3, b4, false);
if (b2 = 0) and (b3 = 0) and (b4 = 0) and (b1 < 128) then
Result := Result + AnsiChar(b1)
else
begin
x := (b1 + 256 * b2) + (b3 + 256 * b4) * 65536;
l := IntToBin(x, 0);
y := Length(l) div 6;
s := '';
for m := 1 to y do
begin
k := Copy(l, Length(l) - 5, 6);
l := Copy(l, 1, Length(l) - 6);
b := BinToInt(k) or $80;
s := AnsiChar(b) + s;
end;
b := BinToInt(l);
case y of
5:
b := b or $FC;
4:
b := b or $F8;
3:
b := b or $F0;
2:
b := b or $E0;
1:
b := b or $C0;
end;
s := AnsiChar(b) + s;
Result := Result + s;
end;
end;
end;
{==============================================================================}
function UTF7toUCS2(const Value: AnsiString; Modified: Boolean): AnsiString;
var
n, i: Integer;
c: AnsiChar;
s, t: AnsiString;
shift: AnsiChar;
table: String;
begin
Result := '';
n := 1;
if modified then
begin
shift := '&';
table := TableBase64mod;
end
else
begin
shift := '+';
table := TableBase64;
end;
while Length(Value) >= n do
begin
c := Value[n];
Inc(n);
if c <> shift then
Result := Result + WriteMulti(Ord(c), 0, 0, 0, 2, false)
else
begin
s := '';
while Length(Value) >= n do
begin
c := Value[n];
Inc(n);
if c = '-' then
Break;
if (c = '=') or (Pos(c, table) < 1) then
begin
Dec(n);
Break;
end;
s := s + c;
end;
if s = '' then
s := WriteMulti(Ord(shift), 0, 0, 0, 2, false)
else
begin
if modified then
t := DecodeBase64mod(s)
else
t := DecodeBase64(s);
if not odd(length(t)) then
s := t
else
begin //ill-formed sequence
t := s;
s := WriteMulti(Ord(shift), 0, 0, 0, 2, false);
for i := 1 to length(t) do
s := s + WriteMulti(Ord(t[i]), 0, 0, 0, 2, false);
end;
end;
Result := Result + s;
end;
end;
end;
{==============================================================================}
function UCS2toUTF7(const Value: AnsiString; Modified: Boolean): AnsiString;
var
s: AnsiString;
b1, b2, b3, b4: Byte;
n, m: Integer;
shift: AnsiChar;
begin
Result := '';
n := 1;
if modified then
shift := '&'
else
shift := '+';
while Length(Value) >= n do
begin
ReadMulti(Value, n, 2, b1, b2, b3, b4, false);
if (b2 = 0) and (b1 < 128) then
if AnsiChar(b1) = shift then
Result := Result + shift + '-'
else
Result := Result + AnsiChar(b1)
else
begin
s := AnsiChar(b2) + AnsiChar(b1);
while Length(Value) >= n do
begin
ReadMulti(Value, n, 2, b1, b2, b3, b4, false);
if (b2 = 0) and (b1 < 128) then
begin
Dec(n, 2);
Break;
end;
s := s + AnsiChar(b2) + AnsiChar(b1);
end;
if modified then
s := EncodeBase64mod(s)
else
s := EncodeBase64(s);
m := Pos('=', s);
if m > 0 then
s := Copy(s, 1, m - 1);
Result := Result + shift + s + '-';
end;
end;
end;
{==============================================================================}
function CharsetConversion(const Value: AnsiString; CharFrom: TMimeChar;
CharTo: TMimeChar): AnsiString;
begin
Result := CharsetConversionEx(Value, CharFrom, CharTo, Replace_None);
end;
{==============================================================================}
function CharsetConversionEx(const Value: AnsiString; CharFrom: TMimeChar;
CharTo: TMimeChar; const TransformTable: array of Word): AnsiString;
begin
Result := CharsetConversionTrans(Value, CharFrom, CharTo, TransformTable, True);
end;
{==============================================================================}
function CharsetConversionTrans(Value: AnsiString; CharFrom: TMimeChar;
CharTo: TMimeChar; const TransformTable: array of Word; Translit: Boolean): AnsiString;
var
uni: Word;
n, m: Integer;
b: Byte;
b1, b2, b3, b4: Byte;
SourceTable, TargetTable: array[128..255] of Word;
mbf, mbt: Byte;
lef, let: Boolean;
ucsstring, s, t: AnsiString;
cd: iconv_t;
f: Boolean;
NotNeedTransform: Boolean;
FromID, ToID: string;
begin
NotNeedTransform := (High(TransformTable) = 0);
if (CharFrom = CharTo) and NotNeedTransform then
begin
Result := Value;
Exit;
end;
FromID := GetIDFromCP(CharFrom);
ToID := GetIDFromCP(CharTo);
cd := Iconv_t(-1);
//do two-pass conversion. Transform to UCS-2 first.
if CharFrom = UCS_2 then
ucsstring := Value
else
begin
if not DisableIconv then
cd := SynaIconvOpenIgnore('UCS-2BE', FromID);
try
if cd <> iconv_t(-1) then
SynaIconv(cd, Value, ucsstring)
else
begin
s := Value;
if CharFrom = UTF_8 then
s := UTF8toUCS4(Value)
else
if CharFrom = UTF_7 then
s := UTF7toUCS2(Value, False)
else
if CharFrom = UTF_7mod then
s := UTF7toUCS2(Value, True);
GetArray(CharFrom, SourceTable);
mbf := 1;
if CharFrom in SetTwo then
mbf := 2;
if CharFrom in SetFour then
mbf := 4;
lef := CharFrom in SetLe;
ucsstring := '';
n := 1;
while Length(s) >= n do
begin
ReadMulti(s, n, mbf, b1, b2, b3, b4, lef);
//handle BOM
if (b3 = 0) and (b4 = 0) then
begin
if (b1 = $FE) and (b2 = $FF) then
begin
lef := not lef;
continue;
end;
if (b1 = $FF) and (b2 = $FE) then
continue;
end;
if mbf = 1 then
if b1 > 127 then
begin
uni := SourceTable[b1];
b1 := Lo(uni);
b2 := Hi(uni);
end;
ucsstring := ucsstring + WriteMulti(b1, b2, b3, b4, 2, False);
end;
end;
finally
SynaIconvClose(cd);
end;
end;
//here we allways have ucstring with UCS-2 encoding
//second pass... from UCS-2 to target encoding.
if not DisableIconv then
if translit then
cd := SynaIconvOpenTranslit(ToID, 'UCS-2BE')
else
cd := SynaIconvOpenIgnore(ToID, 'UCS-2BE');
try
if (cd <> iconv_t(-1)) and NotNeedTransform then
begin
if CharTo = UTF_7 then
ucsstring := ucsstring + #0 + '-';
//when transformtable is not needed and Iconv know target charset,
//do it fast by one call.
SynaIconv(cd, ucsstring, Result);
if CharTo = UTF_7 then
Delete(Result, Length(Result), 1);
end
else
begin
GetArray(CharTo, TargetTable);
mbt := 1;
if CharTo in SetTwo then
mbt := 2;
if CharTo in SetFour then
mbt := 4;
let := CharTo in SetLe;
b3 := 0;
b4 := 0;
Result := '';
for n:= 0 to (Length(ucsstring) div 2) - 1 do
begin
s := Copy(ucsstring, n * 2 + 1, 2);
b2 := Ord(s[1]);
b1 := Ord(s[2]);
uni := b2 * 256 + b1;
if not NotNeedTransform then
begin
uni := ReplaceUnicode(uni, TransformTable);
b1 := Lo(uni);
b2 := Hi(uni);
s[1] := AnsiChar(b2);
s[2] := AnsiChar(b1);
end;
if cd <> iconv_t(-1) then
begin
if CharTo = UTF_7 then
s := s + #0 + '-';
SynaIconv(cd, s, t);
if CharTo = UTF_7 then
Delete(t, Length(t), 1);
Result := Result + t;
end
else
begin
f := True;
if mbt = 1 then
if uni > 127 then
begin
f := False;
b := 0;
for m := 128 to 255 do
if TargetTable[m] = uni then
begin
b := m;
f := True;
Break;
end;
b1 := b;
b2 := 0;
end
else
b1 := Lo(uni);
if not f then
if translit then
begin
b1 := Ord(NotFoundChar);
b2 := 0;
f := True;
end;
if f then
Result := Result + WriteMulti(b1, b2, b3, b4, mbt, let)
end;
end;
if cd = iconv_t(-1) then
begin
if CharTo = UTF_7 then
Result := UCS2toUTF7(Result, false);
if CharTo = UTF_7mod then
Result := UCS2toUTF7(Result, true);
if CharTo = UTF_8 then
Result := UCS4toUTF8(Result);
end;
end;
finally
SynaIconvClose(cd);
end;
end;
{==============================================================================}
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -