const
MB_CUR_MAX = 10;
type
TFoT = (Falso, Verdadero);
wint_t = longint;
clonglong = wint_t;
mbstate_t = record
case byte of
0: (__mbstate8: array[0..127] of char);
1: (_mbstateL: clonglong); { for alignment }
end;
size_t = qword;
wchar_t = longint;
pmbstate_t = ^mbstate_t;
function wcrtomb(s: pchar; wc: wchar_t; ps: pmbstate_t): size_t; cdecl; external clib name 'wcrtomb';
procedure EnsureAnsiLen(var S: AnsiString; const len: SizeInt); inline;
begin
if (len>length(s)) then
if (length(s) < 10*256) then
setlength(s,length(s)+10)
else
setlength(s,length(s)+length(s) shr 8);
end;
procedure ConcatCharToAnsiStr(const c: char; var S: AnsiString; var index: SizeInt);
begin
EnsureAnsiLen(s,index);
pchar(@s[index])^:=c;
inc(index);
end;
{ concatenates an utf-32 char to a widestring. S *must* be unique when entering. }
{$if not(defined(beos) and not defined(haiku))}
procedure ConcatUTF32ToAnsiStr(const nc: wint_t; var S: AnsiString; var index: SizeInt; var mbstate: mbstate_t);
{$else not beos}
procedure ConcatUTF32ToAnsiStr(const nc: wint_t; var S: AnsiString; var index: SizeInt);
{$endif beos}
var
p : pchar;
mblen : size_t;
begin
{ we know that s is unique -> avoid uniquestring calls}
p:=@s[index];
if (nc<=127) then
ConcatCharToAnsiStr(char(nc),s,index)
else
begin
EnsureAnsiLen(s,index+MB_CUR_MAX);
{$if not(defined(beos) and not defined(haiku))}
mblen:=wcrtomb(p,wchar_t(nc),@mbstate);
{$else not beos}
mblen:=wctomb(p,wchar_t(nc));
{$endif not beos}
if (mblen<>size_t(-1)) then
inc(index,mblen)
else
begin
{ invalid wide char }
p^:='?';
inc(index);
end;
end;
end;
function UpperAnsiString(const s : AnsiString) : AnsiString;
var
i, slen,
resindex : SizeInt;
mblen : size_t;
{$if not(defined(beos) and not defined(haiku))}
ombstate,
nmbstate : mbstate_t;
{$endif beos}
wc : wchar_t;
begin
{$if not(defined(beos) and not defined(haiku))}
fillchar(ombstate,sizeof(ombstate),0);
fillchar(nmbstate,sizeof(nmbstate),0);
{$endif beos}
slen:=length(s);
SetLength(result,slen+10);
i:=1;
resindex:=1;
while (i<=slen) do
begin
if (s[i]<=#127) then
begin
wc:=wchar_t(s[i]);
mblen:= 1;
end
else
{$if not(defined(beos) and not defined(haiku))}
mblen:=mbrtowc(@wc, pchar(@s[i]), slen-i+1, @ombstate);
{$else not beos}
mblen:=mbtowc(@wc, pchar(@s[i]), slen-i+1);
{$endif beos}
case mblen of
size_t(-2):
begin
{ partial invalid character, copy literally }
while (i<=slen) do
begin
ConcatCharToAnsiStr(s[i],result,resindex);
inc(i);
end;
end;
size_t(-1), 0:
begin
{ invalid or null character }
ConcatCharToAnsiStr(s[i],result,resindex);
inc(i);
end;
else
begin
{ a valid sequence }
{ even if mblen = 1, the uppercase version may have a }
{ different length }
{ We can't do anything special if wchar_t is 16 bit... }
{$if not(defined(beos) and not defined(haiku))}
ConcatUTF32ToAnsiStr(towupper(wint_t(wc)),result,resindex,nmbstate);
{$else not beos}
ConcatUTF32ToAnsiStr(towupper(wint_t(wc)),result,resindex);
{$endif not beos}
inc(i,mblen);
end;
end;
end;
SetLength(result,resindex-1);
end;
function StrCompAnsiIntern(s1,s2 : PChar; len1, len2: PtrInt; canmodifys1, canmodifys2: boolean): PtrInt;
var
a,b: pchar;
i: PtrInt;
begin
if not(canmodifys1) then
getmem(a,len1+1)
else
a:=s1;
for i:=0 to len1-1 do
if s1[i]<>#0 then
a[i]:=s1[i]
else
a[i]:=#32;
a[len1]:=#0;
if not(canmodifys2) then
getmem(b,len2+1)
else
b:=s2;
for i:=0 to len2-1 do
if s2[i]<>#0 then
b[i]:=s2[i]
else
b[i]:=#32;
b[len2]:=#0;
result:=strcoll(a,b);
if not(canmodifys1) then
freemem(a);
if not(canmodifys2) then
freemem(b);
end;
function AnsiCompareText(const S1, S2: ansistring): PtrInt;
var
a, b: AnsiString;
begin
a:=UpperAnsistring(s1);
b:=UpperAnsistring(s2);
result:=StrCompAnsiIntern(pchar(a),pchar(b),length(a),length(b),true,true);
end;