From 31b978f3b72332560eade5abd34fc77177584470 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Micha=C3=ABl=20Van=20Canneyt?= <michael@freepascal.org>
Date: Tue, 20 Feb 2024 17:09:35 +0100
Subject: [PATCH] * Add UnicodeFromLocaleChars for Delphi compatibility

---
 rtl/inc/ustringh.inc | 17 ++++++++++++++
 rtl/inc/ustrings.inc | 55 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 72 insertions(+)

diff --git a/rtl/inc/ustringh.inc b/rtl/inc/ustringh.inc
index d2a72f11ba..eb44d7043f 100644
--- a/rtl/inc/ustringh.inc
+++ b/rtl/inc/ustringh.inc
@@ -50,6 +50,14 @@ procedure UnicodeCharLenToStrVar(Src : PUnicodeChar;Len : SizeInt;out Dest : Uni
 procedure UnicodeCharLenToStrVar(Src : PUnicodeChar;Len : SizeInt;out Dest : AnsiString);
 procedure UnicodeCharToStrVar(S : PUnicodeChar;out Dest : AnsiString);
 
+function UnicodeFromLocaleChars(CodePage, Flags: Cardinal; LocaleStr: PAnsiChar;
+  LocaleStrLen: Integer; UnicodeStr: PWideChar; UnicodeStrLen: Integer): Integer; overload;
+
+function UnicodeFromLocaleChars(const LocaleName: AnsiString; Flags: Cardinal;
+  LocaleStr: PAnsiChar; LocaleStrLen: Integer; UnicodeStr: PWideChar;
+  UnicodeStrLen: Integer): Integer; overload;
+
+
 procedure DefaultUnicode2AnsiMove(source:punicodechar;var dest:RawByteString;cp : TSystemCodePage;len:SizeInt);
 procedure DefaultAnsi2UnicodeMove(source:pansichar;cp : TSystemCodePage;var dest:unicodestring;len:SizeInt);
 
@@ -177,3 +185,12 @@ function StringCodePage(const S : UnicodeString): TSystemCodePage; overload;
 Function ToSingleByteFileSystemEncodedFileName(const Str: UnicodeString): RawByteString;
 Function ToSingleByteFileSystemEncodedFileName(const arr: array of widechar): RawByteString;
 Function ToSingleByteFileSystemEncodedFileName(const Str: RawByteString): RawByteString;
+
+Type
+  TLocaleNameToCodePageCallBack = Procedure (const localename : shortstring; out codepage : TSystemCodePage; aHandled : Boolean);
+  
+
+Var
+  LocaleNameToCodePageCallBack : TLocaleNameToCodePageCallBack;
+  
+Function LocaleNameToCodePage(const localename : shortstring; out codepage : TSystemCodePage) : Boolean;
\ No newline at end of file
diff --git a/rtl/inc/ustrings.inc b/rtl/inc/ustrings.inc
index 7dd84fc2c0..5197044f47 100644
--- a/rtl/inc/ustrings.inc
+++ b/rtl/inc/ustrings.inc
@@ -1047,6 +1047,40 @@ function StringToWideChar(const Src : RawByteString;Dest : PWideChar;DestSize :
   end;
 {$endif FPC_HAS_STRING_LEN_TO_WIDECHAR}
 
+function UnicodeFromLocaleChars(CodePage, Flags: Cardinal; LocaleStr: PAnsiChar;
+  LocaleStrLen: Integer; UnicodeStr: PWideChar; UnicodeStrLen: Integer): Integer; overload;
+
+var
+  temp: widestring;
+  Len: SizeInt;
+begin
+  widestringmanager.Ansi2WideMoveProc(LocaleStr,CodePage,temp,LocaleStrLen);
+  Len:=Length(temp);
+  // Only move when we have room.
+  if (UnicodeStrLen>0) then
+    begin  
+    if UnicodeStrLen<=Len then
+      Len:=UnicodeStrLen-1;
+    move(temp[1],UnicodeStr^,Len*SizeOf(WideChar));
+    UnicodeStr[Len]:=#0;
+    end;
+  // Return length  
+  result:=len;
+end;
+
+function UnicodeFromLocaleChars(const LocaleName: AnsiString; Flags: Cardinal;
+  LocaleStr: PAnsiChar; LocaleStrLen: Integer; UnicodeStr: PWideChar;
+  UnicodeStrLen: Integer): Integer; overload;
+
+var
+  CP : TSystemCodePage;
+
+begin
+  if not LocaleNameToCodePage(LocaleName,CP) then
+    Result:=0
+  else
+    Result:=UnicodeFromLocaleChars(CP,Flags,LocaleStr,LocaleStrLen,UnicodeStr,UnicodeStrLen);
+end;
 
 {$ifndef FPC_HAS_UNICODECHAR_LEN_TO_STRING}
 {$define FPC_HAS_UNICODECHAR_LEN_TO_STRING}
@@ -2416,3 +2450,24 @@ begin
   Result := UTF8ToString(rs);
 end;
 {$endif not CPUJVM}
+
+
+Function LocaleNameToCodePage(const localename : shortstring; out codepage : TSystemCodePage) : Boolean;
+
+begin
+  Result:=(localename='UTF-8') or (localename='UTF8');
+  if Result then
+    CodePage:=CP_UTF8
+  else 
+    begin
+    Result:=(localename='UTF-7') or (localename='UTF7');
+    if Result then  
+      CodePage:=CP_UTF7
+    else 
+      begin
+      Result:=Assigned(LocaleNameToCodePageCallBack);
+      If Result then
+        LocaleNameToCodePageCallBack(LocaleName,CodePage,Result);
+      end;
+    end;  
+end;