mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-05 04:23:46 +02:00
400 lines
10 KiB
ObjectPascal
400 lines
10 KiB
ObjectPascal
{
|
|
*****************************************************************************
|
|
* *
|
|
* This file is part of the LazUtils package *
|
|
* *
|
|
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
}
|
|
unit paswstring;
|
|
|
|
{$mode objfpc}
|
|
{$inline on}
|
|
//{$define PASWSTRING_VERBOSE}
|
|
|
|
interface
|
|
|
|
uses SysUtils, lazutf8, lconvencoding;
|
|
|
|
procedure SetPasWidestringManager;
|
|
|
|
implementation
|
|
|
|
procedure fpc_rangeerror; [external name 'FPC_RANGEERROR'];
|
|
|
|
procedure Wide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
|
|
var
|
|
widestr: widestring;
|
|
begin
|
|
{$ifdef PASWSTRING_VERBOSE}WriteLn('Wide2AnsiMove START');{$endif}
|
|
// Copy the originating string taking into account the specified length
|
|
SetLength(widestr, len+1);
|
|
System.Move(source^, widestr, len);
|
|
PWideChar(@widestr)[len] := #0; // Avoid UniqueString by using PWideChar
|
|
|
|
// Now convert it, using UTF-8 -> UTF-16
|
|
dest := UTF16ToUTF8(widestr);
|
|
{$ifdef PASWSTRING_VERBOSE}WriteLn('Wide2AnsiMove END');{$endif}
|
|
end;
|
|
|
|
procedure Ansi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
|
|
var
|
|
ansistr: ansistring;
|
|
begin
|
|
{$ifdef PASWSTRING_VERBOSE}WriteLn('Ansi2WideMove START');{$endif}
|
|
// Copy the originating string taking into account the specified length
|
|
SetLength(ansistr, len+1);
|
|
System.Move(source^, ansistr, len);
|
|
ansistr[len+1] := #0;
|
|
|
|
// Now convert it, using UTF-16 -> UTF-8
|
|
dest := UTF8ToUTF16(ansistr);
|
|
end;
|
|
|
|
function LowerWideString(const s : WideString) : WideString;
|
|
var
|
|
str: utf8string;
|
|
begin
|
|
{$ifdef PASWSTRING_VERBOSE}WriteLn('LowerWideString START');{$endif}
|
|
str := UTF16ToUTF8(s);
|
|
str := UTF8LowerCase(str);
|
|
Result := UTF8ToUTF16(str);
|
|
end;
|
|
|
|
function UpperWideString(const s : WideString) : WideString;
|
|
var
|
|
str: utf8string;
|
|
begin
|
|
{$ifdef PASWSTRING_VERBOSE}WriteLn('UpperWideString START');{$endif}
|
|
str := UTF16ToUTF8(s);
|
|
str := UTF8UpperCase(str);
|
|
Result := UTF8ToUTF16(str);
|
|
end;
|
|
|
|
procedure EnsureAnsiLen(var S: AnsiString; const len: SizeInt); inline;
|
|
begin
|
|
{$ifdef PASWSTRING_VERBOSE}WriteLn('EnsureAnsiLen START');{$endif}
|
|
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
|
|
{$ifdef PASWSTRING_VERBOSE}WriteLn('ConcatCharToAnsiStr START');{$endif}
|
|
EnsureAnsiLen(s,index);
|
|
pchar(@s[index])^:=c;
|
|
inc(index);
|
|
end;
|
|
|
|
function LowerAnsiString(const s : AnsiString) : AnsiString;
|
|
var
|
|
Str: utf8string;
|
|
begin
|
|
{$ifdef PASWSTRING_VERBOSE}WriteLn('LowerAnsiString START');{$endif}
|
|
Str := SysToUTF8(s);
|
|
Str := UTF8LowerCase(Str);
|
|
Result := UTF8ToSys(Str);
|
|
end;
|
|
|
|
function UpperAnsiString(const s : AnsiString) : AnsiString;
|
|
var
|
|
Str: utf8string;
|
|
begin
|
|
{$ifdef PASWSTRING_VERBOSE}WriteLn('UpperAnsiString START');{$endif}
|
|
Str := SysToUTF8(s);
|
|
Str := UTF8UpperCase(Str);
|
|
Result := UTF8ToSys(Str);
|
|
end;
|
|
|
|
// Just do a simple byte comparison
|
|
// A more complex analysis would require normalization
|
|
function WideCompareStr(const s1, s2 : WideString) : PtrInt;
|
|
var
|
|
count, count1, count2: integer;
|
|
begin
|
|
result := 0;
|
|
Count1 := Length(S1);
|
|
Count2 := Length(S2);
|
|
if Count1>Count2 then
|
|
Count:=Count2
|
|
else
|
|
Count:=Count1;
|
|
result := SysUtils.CompareMemRange(Pointer(S1),Pointer(S2), Count*2);
|
|
if result=0 then
|
|
result:=Count1-Count2;
|
|
end;
|
|
|
|
function WideCompareText(const s1, s2 : WideString): PtrInt;
|
|
var
|
|
a, b: WideString;
|
|
begin
|
|
a:=LowerWidestring(s1);
|
|
b:=LowerWidestring(s2);
|
|
result := WideCompareStr(a,b);
|
|
end;
|
|
|
|
function CharLengthPChar(const Str: PChar): PtrInt;
|
|
begin
|
|
Result := UTF8CharacterLength(Str);
|
|
end;
|
|
|
|
function AnsiCompareStr(const s1, s2: ansistring): PtrInt;
|
|
begin
|
|
Result := SysUtils.CompareStr(s1, s2);
|
|
end;
|
|
|
|
// Similar to AnsiCompareStr, but with PChar
|
|
function StrCompAnsi(s1,s2 : PChar): PtrInt;
|
|
var
|
|
ansi1, ansi2: ansistring;
|
|
begin
|
|
ansi1 := StrPas(S1);
|
|
ansi2 := StrPas(S2);
|
|
Result := SysUtils.CompareStr(ansi1, ansi2);
|
|
end;
|
|
|
|
|
|
function AnsiCompareText(const S1, S2: ansistring): PtrInt;
|
|
var
|
|
str1, str2: utf8string;
|
|
begin
|
|
str1 := SysToUTF8(S1);
|
|
str2 := SysToUTF8(S2);
|
|
Result := UTF8CompareText(str1, str2);
|
|
end;
|
|
|
|
|
|
function AnsiStrIComp(S1, S2: PChar): PtrInt;
|
|
begin
|
|
Result := AnsiCompareText(StrPas(s1),StrPas(s2));
|
|
end;
|
|
|
|
|
|
function AnsiStrLComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
|
|
var
|
|
a, b: pchar;
|
|
begin
|
|
Result := 0;
|
|
if (maxlen=0) then
|
|
exit(0);
|
|
if (s1[maxlen]<>#0) then
|
|
begin
|
|
getmem(a,maxlen+1);
|
|
move(s1^,a^,maxlen);
|
|
a[maxlen]:=#0;
|
|
end
|
|
else
|
|
a:=s1;
|
|
if (s2[maxlen]<>#0) then
|
|
begin
|
|
getmem(b,maxlen+1);
|
|
move(s2^,b^,maxlen);
|
|
b[maxlen]:=#0;
|
|
end
|
|
else
|
|
b:=s2;
|
|
result:=StrCompAnsi(a,b);
|
|
if (a<>s1) then
|
|
freemem(a);
|
|
if (b<>s2) then
|
|
freemem(b);
|
|
end;
|
|
|
|
|
|
function AnsiStrLIComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt;
|
|
var
|
|
a, b: ansistring;
|
|
begin
|
|
if (maxlen=0) then
|
|
exit(0);
|
|
setlength(a,maxlen);
|
|
move(s1^,a[1],maxlen);
|
|
setlength(b,maxlen);
|
|
move(s2^,b[1],maxlen);
|
|
result:=AnsiCompareText(a,b);
|
|
end;
|
|
|
|
|
|
procedure ansi2pchar(const s: ansistring; const orgp: pchar; out p: pchar);
|
|
var
|
|
newlen: sizeint;
|
|
begin
|
|
newlen:=length(s);
|
|
if newlen>strlen(orgp) then
|
|
fpc_rangeerror;
|
|
p:=orgp;
|
|
if (newlen>0) then
|
|
move(s[1],p[0],newlen);
|
|
p[newlen]:=#0;
|
|
end;
|
|
|
|
|
|
function AnsiStrLower(Str: PChar): PChar;
|
|
var
|
|
temp: ansistring;
|
|
begin
|
|
temp:=loweransistring(str);
|
|
ansi2pchar(temp,str,result);
|
|
end;
|
|
|
|
|
|
function AnsiStrUpper(Str: PChar): PChar;
|
|
var
|
|
temp: ansistring;
|
|
begin
|
|
temp:=upperansistring(str);
|
|
ansi2pchar(temp,str,result);
|
|
end;
|
|
|
|
|
|
procedure InitThread;
|
|
begin
|
|
end;
|
|
|
|
|
|
procedure FiniThread;
|
|
begin
|
|
end;
|
|
|
|
{ Unicode }
|
|
|
|
procedure Unicode2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
|
|
var
|
|
widestr: unicodestring;
|
|
begin
|
|
// Copy the originating string taking into account the specified length
|
|
SetLength(widestr, len+1);
|
|
System.Move(source^, widestr, len);
|
|
widestr[len+1] := #0;
|
|
|
|
// Now convert it, using UTF-8 -> UTF-16
|
|
dest := UTF16ToUTF8(widestr);
|
|
end;
|
|
|
|
procedure Ansi2UnicodeMove(source:pchar;var dest:UnicodeString;len:SizeInt);
|
|
var
|
|
ansistr: ansistring;
|
|
begin
|
|
// Copy the originating string taking into account the specified length
|
|
SetLength(ansistr, len+1);
|
|
System.Move(source^, ansistr, len);
|
|
ansistr[len+1] := #0;
|
|
|
|
// Now convert it, using UTF-16 -> UTF-8
|
|
dest := UTF8ToUTF16(ansistr);
|
|
end;
|
|
|
|
function UpperUnicodeString(const s : UnicodeString) : UnicodeString;
|
|
var
|
|
str: utf8string;
|
|
begin
|
|
str := UTF16ToUTF8(s);
|
|
str := UTF8UpperCase(str);
|
|
Result := UTF8ToUTF16(str);
|
|
end;
|
|
|
|
function LowerUnicodeString(const s : UnicodeString) : UnicodeString;
|
|
var
|
|
str: utf8string;
|
|
begin
|
|
str := UTF16ToUTF8(s);
|
|
str := UTF8LowerCase(str);
|
|
Result := UTF8ToUTF16(str);
|
|
end;
|
|
|
|
// Just do a simple byte comparison
|
|
// A more complex analysis would require normalization
|
|
function PasUnicodeCompareStr(const s1, s2 : unicodestring) : PtrInt;
|
|
var
|
|
count, count1, count2: integer;
|
|
begin
|
|
result := 0;
|
|
Count1 := Length(S1);
|
|
Count2 := Length(S2);
|
|
if Count1>Count2 then
|
|
Count:=Count2
|
|
else
|
|
Count:=Count1;
|
|
result := SysUtils.CompareMemRange(Pointer(S1),Pointer(S2), Count*2);
|
|
if result=0 then
|
|
result:=Count1-Count2;
|
|
end;
|
|
|
|
function PasUnicodeCompareText(const s1, s2 : unicodestring): PtrInt;
|
|
var
|
|
a, b: unicodestring;
|
|
begin
|
|
a:=LowerWidestring(s1);
|
|
b:=LowerWidestring(s2);
|
|
result := WideCompareStr(a,b);
|
|
end;
|
|
|
|
Procedure SetPasWideStringManager;
|
|
Var
|
|
PasWideStringManager : TUnicodeStringManager;
|
|
begin
|
|
PasWideStringManager:=widestringmanager;
|
|
PasWideStringManager.Wide2AnsiMoveProc:=@Wide2AnsiMove;
|
|
PasWideStringManager.Ansi2WideMoveProc:=@Ansi2WideMove;
|
|
|
|
// UpperUTF8 : procedure(p:PUTF8String);
|
|
PasWideStringManager.UpperWideStringProc:=@UpperWideString;
|
|
// UpperUCS4 : procedure(p:PUCS4Char);
|
|
// LowerUTF8 : procedure(p:PUTF8String);
|
|
PasWideStringManager.LowerWideStringProc:=@LowerWideString;
|
|
// LowerUCS4 : procedure(p:PUCS4Char);
|
|
|
|
{
|
|
CompUTF8 : function(p1,p2:PUTF8String) : shortint;
|
|
CompUCS2 : function(p1,p2:PUCS2Char) : shortint;
|
|
CompUCS4 : function(p1,p2:PUC42Char) : shortint;
|
|
}
|
|
PasWideStringManager.CompareWideStringProc:=@WideCompareStr;
|
|
PasWideStringManager.CompareTextWideStringProc:=@WideCompareText;
|
|
|
|
{ return value: number of code points in the string. Whenever an invalid
|
|
code point is encountered, all characters part of this invalid code point
|
|
are considered to form one "character" and the next character is
|
|
considered to be the start of a new (possibly also invalid) code point }
|
|
PasWideStringManager.CharLengthPCharProc:=@CharLengthPChar;
|
|
|
|
{ Ansi }
|
|
PasWideStringManager.UpperAnsiStringProc:=@UpperAnsiString;
|
|
PasWideStringManager.LowerAnsiStringProc:=@LowerAnsiString;
|
|
PasWideStringManager.CompareStrAnsiStringProc:=@AnsiCompareStr;
|
|
PasWideStringManager.CompareTextAnsiStringProc:=@AnsiCompareText;
|
|
PasWideStringManager.StrCompAnsiStringProc:=@StrCompAnsi;
|
|
PasWideStringManager.StrICompAnsiStringProc:=@AnsiStrIComp;
|
|
PasWideStringManager.StrLCompAnsiStringProc:=@AnsiStrLComp;
|
|
PasWideStringManager.StrLICompAnsiStringProc:=@AnsiStrLIComp;
|
|
PasWideStringManager.StrLowerAnsiStringProc:=@AnsiStrLower;
|
|
PasWideStringManager.StrUpperAnsiStringProc:=@AnsiStrUpper;
|
|
PasWideStringManager.ThreadInitProc:=@InitThread;
|
|
PasWideStringManager.ThreadFiniProc:=@FiniThread;
|
|
|
|
{ Unicode }
|
|
PasWideStringManager.Unicode2AnsiMoveProc:=@Unicode2AnsiMove;
|
|
PasWideStringManager.Ansi2UnicodeMoveProc:=@Ansi2UnicodeMove;
|
|
PasWideStringManager.UpperUnicodeStringProc:=@UpperUnicodeString;
|
|
PasWideStringManager.LowerUnicodeStringProc:=@LowerUnicodeString;
|
|
PasWideStringManager.CompareUnicodeStringProc:=@PasUnicodeCompareStr;
|
|
PasWideStringManager.CompareTextUnicodeStringProc:=@PasUnicodeCompareText;
|
|
|
|
SetUnicodeStringManager(PasWideStringManager);
|
|
end;
|
|
|
|
|
|
initialization
|
|
SetPasWideStringManager;
|
|
end.
|