lazutils: added WinCPToUTF8 and UTF8ToWinCP

git-svn-id: trunk@46904 -

components/lazutils/lazutf8.pas

@@ -35,6 +35,11 @@ function UTF8ToSys(const s: string): string;// as UTF8ToAnsi but more independen
 function SysToUTF8(const s: string): string;// as AnsiToUTF8 but more independent of widestringmanager
 function ConsoleToUTF8(const s: string): string;// converts OEM encoded string to UTF8 (used with some Windows specific functions)
 function UTF8ToConsole(const s: string): string;// converts UTF8 string to console encoding (used by Write, WriteLn)
+{$IFDEF MSWindows}
+// for all Windows supporting 8bit codepages (e.g. not WinCE)
+function WinCPToUTF8(const s: string): string;// converts string in Windows code page to UTF8 (used with some Windows specific functions)
+function UTF8ToWinCP(const s: string): string;// converts UTF8 string to Windows code page encoding (used by Write, WriteLn)
+{$ENDIF}
 
 function ParamStrUTF8(Param: Integer): string;
 
@@ -145,6 +150,14 @@ uses
 {$IFDEF Darwin}, MacOSAll{$ENDIF}
   ;
 
+function IsASCII(const s: string): boolean; inline;
+var
+  i: Integer;
+begin
+  for i:=1 to length(s) do if ord(s[i])>127 then exit(false);
+  Result:=true;
+end;
+
 {$ifdef windows}
   {$i winlazutf8.inc}
 {$else}
@@ -171,7 +184,11 @@ begin
   if FNeedRTLAnsiValid then
     exit(FNeedRTLAnsi);
   {$IFDEF Windows}
-  FNeedRTLAnsi:=GetACP<>CP_UTF8;
+    {$IF FPC_FULLVERSION>=20701}
+    FNeedRTLAnsi:=DefaultSystemCodePage<>CP_UTF8;
+    {$ELSE}
+    FNeedRTLAnsi:=GetACP<>CP_UTF8;
+    {$ENDIF}
   {$ELSE}
   FNeedRTLAnsi:=false;
   Lang := SysUtils.GetEnvironmentVariable('LC_ALL');
@@ -200,14 +217,6 @@ begin
   FNeedRTLAnsiValid:=true;
 end;
 
-function IsASCII(const s: string): boolean; inline;
-var
-  i: Integer;
-begin
-  for i:=1 to length(s) do if ord(s[i])>127 then exit(false);
-  Result:=true;
-end;
-
 function UTF8ToSys(const s: string): string;
 begin
   if NeedRTLAnsi and (not IsASCII(s)) then

components/lazutils/winlazutf8.inc

@@ -211,8 +211,10 @@ end;
 
 
 function ConsoleToUTF8(const s: string): string;// converts UTF8 string to console encoding (used by Write, WriteLn)
+{$ifNdef WinCE}
 var
   Dst: PChar;
+{$endif}
 begin
   {$ifdef WinCE}
   Result := SysToUTF8(s);
@@ -228,8 +230,10 @@ begin
 end;
 
 function UTF8ToConsole(const s: string): string;
+{$ifNdef WinCE}
 var
   Dst: PChar;
+{$endif}
 begin
   {$ifdef WinCE}
   Result := UTF8ToSys(s);
@@ -242,6 +246,65 @@ begin
   {$endif}
 end;
 
+{$IFDEF MSWindows}
+// for all Windows supporting 8bit codepages (e.g. not WinCE)
+function WinCPToUTF8(const s: string): string;
+// result has codepage CP_ACP
+var
+  UTF16WordCnt: SizeInt;
+  UTF16Str: UnicodeString;
+begin
+  Result:=s;
+  if IsASCII(Result) then begin
+    {$ifdef FPC_HAS_CPSTRING}
+    // prevent codepage conversion magic
+    SetCodePage(RawByteString(Result), CP_ACP, False);
+    {$endif}
+    exit;
+  end;
+  UTF16WordCnt:=MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, Pointer(s), length(s), nil, 0);
+  // this will null-terminate
+  if UTF16WordCnt>0 then
+  begin
+    setlength(UTF16Str, UTF16WordCnt);
+    MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, Pointer(s), length(s), @UTF16Str[1], UTF16WordCnt);
+    Result:=UTF8Encode(UTF16Str);
+    {$ifdef FPC_HAS_CPSTRING}
+    // prevent codepage conversion magic
+    SetCodePage(RawByteString(Result), CP_ACP, False);
+    {$endif}
+  end;
+end;
+
+function UTF8ToWinCP(const s: string): string;
+// result has codepage CP_ACP
+var
+  src: UnicodeString;
+  len: LongInt;
+begin
+  Result:=s;
+  if IsASCII(Result) then begin
+    {$ifdef FPC_HAS_CPSTRING}
+    // prevent codepage conversion magic
+    SetCodePage(RawByteString(Result), CP_ACP, False);
+    {$endif}
+    exit;
+  end;
+  src:=UTF8Decode(s);
+  if src='' then
+    exit;
+  len:=WideCharToMultiByte(CP_ACP,0,PUnicodeChar(src),length(src),nil,0,nil,nil);
+  SetLength(Result,len);
+  if len>0 then begin
+    WideCharToMultiByte(CP_ACP,0,PUnicodeChar(src),length(src),@Result[1],length(Result),nil,nil);
+    {$ifdef FPC_HAS_CPSTRING}
+    // prevent codepage conversion magic
+    SetCodePage(RawByteString(Result), CP_ACP, False);
+    {$endif}
+  end;
+end;
+{$ENDIF}
+
 {$ifdef debugparamstrutf8}
 procedure ParamStrUtf8Error;
 var