paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 21:29:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ support for CP_OEMCP

Browse Source 
* changed all mappings from CP_ACP to DefaultSystemCodePage to calls to the
    new TranslatePlaceholderCP() routine (which also handles CP_OEMCP)
  * removed unnecessary CP_ACP adaptations in fpc_AnsiStr_Concat_multi()
    for JVM target (now handled in the ansistring to unicodestring conversion
    routine)

git-svn-id: branches/cpstrrtl@25091 -
This commit is contained in:
Jonas Maebe 2013-07-12 17:18:24 +00:00
parent 44f4bdfb2e
commit a5273abc9c
10 changed files with 97 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
rtl/inc/astrings.inc
View File

@ -59,6 +59,20 @@ Const
Internal functions, not in interface. Internal functions, not in interface.
****************************************************************************} ****************************************************************************}
{$ifndef FPC_HAS_TRANSLATEPLACEHOLDERCP}
{$define FPC_HAS_TRANSLATEPLACEHOLDERCP}
function TranslatePlaceholderCP(cp: TSystemCodePage): TSystemCodePage; {$ifdef SYSTEMINLINE}inline;{$endif}
begin
TranslatePlaceholderCP:=cp;
case cp of
CP_OEMCP,
CP_ACP:
TranslatePlaceholderCP:=DefaultSystemCodePage;
end;
end;
{$endif FPC_HAS_TRANSLATEPLACEHOLDERCP}
{$ifndef FPC_HAS_PCHAR_ANSISTR_INTERN_CHARMOVE} {$ifndef FPC_HAS_PCHAR_ANSISTR_INTERN_CHARMOVE}
{$define FPC_HAS_PCHAR_ANSISTR_INTERN_CHARMOVE} {$define FPC_HAS_PCHAR_ANSISTR_INTERN_CHARMOVE}
procedure fpc_pchar_ansistr_intern_charmove(const src: pchar; const srcindex: sizeint; var dst: rawbytestring; const dstindex, len: sizeint); {$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif} {$ifdef SYSTEMINLINE}inline;{$endif} procedure fpc_pchar_ansistr_intern_charmove(const src: pchar; const srcindex: sizeint; var dst: rawbytestring; const dstindex, len: sizeint); {$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif} {$ifdef SYSTEMINLINE}inline;{$endif}
@ -207,8 +221,7 @@ begin
{$else FPC_HAS_CPSTRING} {$else FPC_HAS_CPSTRING}
DestCP:=StringCodePage(DestS); DestCP:=StringCodePage(DestS);
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
if (DestCP=CP_ACP) then DestCP:=TranslatePlaceholderCP(DestCP);
DestCP:=DefaultSystemCodePage;
{ if codepages are different then concat using unicodestring, { if codepages are different then concat using unicodestring,
but avoid conversions if either addend is empty (StringCodePage will return but avoid conversions if either addend is empty (StringCodePage will return
DefaultSystemCodePage in that case, which may differ from other addend/dest) } DefaultSystemCodePage in that case, which may differ from other addend/dest) }
@ -216,14 +229,12 @@ begin
S1CP:=DestCP S1CP:=DestCP
else else
S1CP:=StringCodePage(S1); S1CP:=StringCodePage(S1);
if (S1CP=CP_ACP) then S1CP:=TranslatePlaceholderCP(S1CP);
S1CP:=DefaultSystemCodePage;
if S2='' then if S2='' then
S2CP:=DestCP S2CP:=DestCP
else else
S2CP:=StringCodePage(S2); S2CP:=StringCodePage(S2);
if (S2CP=CP_ACP) then S2CP:=TranslatePlaceholderCP(S2CP);
S2CP:=DefaultSystemCodePage;
if (S1CP<>DestCP) or (S2CP<>DestCP) then if (S1CP<>DestCP) or (S2CP<>DestCP) then
begin begin
ansistr_concat_complex(DestS,S1,S2,DestCP); ansistr_concat_complex(DestS,S1,S2,DestCP);
@ -296,15 +307,12 @@ begin
{$else FPC_HAS_CPSTRING} {$else FPC_HAS_CPSTRING}
DestCP:=StringCodePage(DestS); DestCP:=StringCodePage(DestS);
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
if (DestCP=CP_ACP) then DestCP:=TranslatePlaceholderCP(DestCP);
DestCP:=DefaultSystemCodePage;
sameCP:=true; sameCP:=true;
lowstart:=low(sarr); lowstart:=low(sarr);
for i:=lowstart to high(sarr) do for i:=lowstart to high(sarr) do
begin begin
tmpCP:=StringCodePage(sarr[i]); tmpCP:=TranslatePlaceholderCP(StringCodePage(sarr[i]));
if tmpCP=CP_ACP then
tmpCP:=DefaultSystemCodePage;
if (DestCP<>tmpCp) then if (DestCP<>tmpCp) then
begin begin
sameCP:=false; sameCP:=false;
@ -408,11 +416,8 @@ begin
Size:=Length(S); Size:=Length(S);
if Size>0 then if Size>0 then
begin begin
if (cp=CP_ACP) then cp:=TranslatePlaceholderCP(cp);
cp:=DefaultSystemCodePage; orgcp:=TranslatePlaceholderCP(StringCodePage(S));
orgcp:=StringCodePage(S);
if (orgcp=CP_ACP) then
orgcp:=DefaultSystemCodePage;
if (orgcp=cp) or (orgcp=CP_NONE) then if (orgcp=cp) or (orgcp=CP_NONE) then
begin begin
SetLength(result,Size); SetLength(result,Size);
@ -469,8 +474,7 @@ Var
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
begin begin
{$ifdef FPC_HAS_CPSTRING} {$ifdef FPC_HAS_CPSTRING}
if (cp=CP_ACP) then cp:=TranslatePlaceholderCP(cp);
cp:=DefaultSystemCodePage;
{$else FPC_HAS_CPSTRING} {$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
@ -497,8 +501,7 @@ var
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
begin begin
{$ifdef FPC_HAS_CPSTRING} {$ifdef FPC_HAS_CPSTRING}
if (cp=CP_ACP) then cp:=TranslatePlaceholderCP(cp);
cp:=DefaultSystemCodePage;
{$else FPC_HAS_CPSTRING} {$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
@ -527,8 +530,7 @@ begin
if L > 0 then if L > 0 then
begin begin
{$ifdef FPC_HAS_CPSTRING} {$ifdef FPC_HAS_CPSTRING}
if (cp=CP_ACP) then cp:=TranslatePlaceholderCP(cp);
cp:=DefaultSystemCodePage;
{$else FPC_HAS_CPSTRING} {$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
@ -565,8 +567,7 @@ begin
if i > 0 then if i > 0 then
begin begin
{$ifdef FPC_HAS_CPSTRING} {$ifdef FPC_HAS_CPSTRING}
if (cp=CP_ACP) then cp:=TranslatePlaceholderCP(cp);
cp:=DefaultSystemCodePage;
{$else FPC_HAS_CPSTRING} {$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
@ -626,12 +627,8 @@ begin
result:=Length(S1); result:=Length(S1);
exit; exit;
end; end;
cp1:=StringCodePage(S1); cp1:=TranslatePlaceholderCP(StringCodePage(S1));
if cp1=CP_ACP then cp2:=TranslatePlaceholderCP(StringCodePage(S2));
cp1:=DefaultSystemCodePage;
cp2:=StringCodePage(S2);
if cp2=CP_ACP then
cp2:=DefaultSystemCodePage;
if cp1=cp2 then if cp1=cp2 then
begin begin
Maxi:=Length(S1); Maxi:=Length(S1);
@ -690,12 +687,8 @@ begin
result:=1; result:=1;
exit; exit;
end; end;
cp1:=StringCodePage(S1); cp1:=TranslatePlaceholderCP(StringCodePage(S1));
if cp1=CP_ACP then cp2:=TranslatePlaceholderCP(StringCodePage(S2));
cp1:=DefaultSystemCodePage;
cp2:=StringCodePage(S2);
if cp2=CP_ACP then
cp2:=DefaultSystemCodePage;
if cp1=cp2 then if cp1=cp2 then
begin begin
Maxi:=Length(S1); Maxi:=Length(S1);
@ -776,8 +769,7 @@ begin
Pointer(S):=Temp; Pointer(S):=Temp;
end; end;
{$ifdef FPC_HAS_CPSTRING} {$ifdef FPC_HAS_CPSTRING}
if (cp=CP_ACP) then cp:=TranslatePlaceholderCP(cp);
cp:=DefaultSystemCodePage;
PAnsiRec(Pointer(S)-AnsiFirstOff)^.CodePage:=cp; PAnsiRec(Pointer(S)-AnsiFirstOff)^.CodePage:=cp;
{$else} {$else}
PAnsiRec(Pointer(S)-AnsiFirstOff)^.CodePage:=DefaultSystemCodePage; PAnsiRec(Pointer(S)-AnsiFirstOff)^.CodePage:=DefaultSystemCodePage;
@ -1278,9 +1270,7 @@ begin
index := LS+1; index := LS+1;
Dec(Index); Dec(Index);
SetLength(Temp,Length(Source)+LS); SetLength(Temp,Length(Source)+LS);
cp:=StringCodePage(S); cp:=TranslatePlaceholderCP(StringCodePage(S));
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
SetCodePage(Temp,cp,false); SetCodePage(Temp,cp,false);
If Index>0 then If Index>0 then
fpc_pchar_ansistr_intern_charmove(pchar(S),0,Temp,0,Index); fpc_pchar_ansistr_intern_charmove(pchar(S),0,Temp,0,Index);

22
rtl/inc/systemh.inc
View File

@ -84,6 +84,17 @@
Global Types and Constants Global Types and Constants
****************************************************************************} ****************************************************************************}
{ some values which are used in RTL for TSystemCodePage type }
const
CP_ACP = 0; // default to ANSI code page
CP_OEMCP = 1; // default to OEM (console) code page
CP_UTF16 = 1200; // utf-16
CP_UTF16BE = 1201; // unicodeFFFE
CP_UTF7 = 65000; // utf-7
CP_UTF8 = 65001; // utf-8
CP_ASCII = 20127; // us-ascii
CP_NONE = $FFFF; // rawbytestring encoding
Type Type
{ The compiler has all integer types defined internally. Here { The compiler has all integer types defined internally. Here
we define only aliases } we define only aliases }
@ -370,17 +381,6 @@ Type
PPChar = ^PChar; PPChar = ^PChar;
PPPChar = ^PPChar; PPPChar = ^PPChar;
{ some values which are used in RTL for TSystemCodePage type }
const
CP_ACP = 0; // default to ANSI code page
CP_UTF16 = 1200; // utf-16
CP_UTF16BE = 1201; // unicodeFFFE
CP_UTF7 = 65000; // utf-7
CP_UTF8 = 65001; // utf-8
CP_ASCII = 20127; // us-ascii
CP_NONE = $FFFF; // rawbytestring encoding
type
{ AnsiChar is equivalent of Char, so we need { AnsiChar is equivalent of Char, so we need
to use type renamings } to use type renamings }
TAnsiChar = Char; TAnsiChar = Char;

3
rtl/inc/text.inc
View File

@ -148,8 +148,7 @@ Begin
TextRec(t).bufend:=0; TextRec(t).bufend:=0;
{$ifdef FPC_HAS_CPSTRING} {$ifdef FPC_HAS_CPSTRING}
{ if no codepage is yet assigned then assign default ansi codepage } { if no codepage is yet assigned then assign default ansi codepage }
if TextRec(t).CodePage=CP_ACP then TextRec(t).CodePage:=TranslatePlaceholderCP(TextRec(t).CodePage);
TextRec(t).CodePage:=DefaultSystemCodePage;
{$endif} {$endif}
FileFunc(TextRec(t).OpenFunc)(TextRec(t)); FileFunc(TextRec(t).OpenFunc)(TextRec(t));
{ reset the mode to closed when an error has occured } { reset the mode to closed when an error has occured }

10
rtl/inc/ustrings.inc
View File

@ -312,8 +312,7 @@ begin
Size:=Length(S2); Size:=Length(S2);
if Size>0 then if Size>0 then
begin begin
if (cp=CP_ACP) then cp:=TranslatePlaceholderCP(cp);
cp:=DefaultSystemCodePage;
widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(Pointer(S2)),result,cp,Size); widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(Pointer(S2)),result,cp,Size);
end; end;
end; end;
@ -334,9 +333,7 @@ begin
Size:=Length(S2); Size:=Length(S2);
if Size>0 then if Size>0 then
begin begin
cp:=StringCodePage(S2); cp:=TranslatePlaceholderCP(StringCodePage(S2));
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
widestringmanager.Ansi2UnicodeMoveProc(PChar(S2),cp,result,Size); widestringmanager.Ansi2UnicodeMoveProc(PChar(S2),cp,result,Size);
end; end;
end; end;
@ -641,8 +638,7 @@ begin
{$ifndef FPC_HAS_CPSTRING} {$ifndef FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
if (cp=CP_ACP) then cp:=TranslatePlaceholderCP(cp);
cp:=DefaultSystemCodePage;
widestringmanager.Unicode2AnsiMoveProc(@c, fpc_UChar_To_AnsiStr, cp, 1); widestringmanager.Unicode2AnsiMoveProc(@c, fpc_UChar_To_AnsiStr, cp, 1);
end; end;
{$endif FPC_HAS_UCHAR_TO_ANSISTR} {$endif FPC_HAS_UCHAR_TO_ANSISTR}

7
rtl/inc/wstrings.inc
View File

@ -194,8 +194,7 @@ begin
Size:=Length(S2); Size:=Length(S2);
if Size>0 then if Size>0 then
begin begin
if (cp=CP_ACP) then cp:=TranslatePlaceholderCP(cp);
cp:=DefaultSystemCodePage;
widestringmanager.Wide2AnsiMoveProc(PWideChar(Pointer(S2)),result,cp,Size); widestringmanager.Wide2AnsiMoveProc(PWideChar(Pointer(S2)),result,cp,Size);
end; end;
end; end;
@ -213,9 +212,7 @@ begin
Size:=Length(S2); Size:=Length(S2);
if Size>0 then if Size>0 then
begin begin
cp:=StringCodePage(S2); cp:=TranslatePlaceholderCP(StringCodePage(S2));
if (cp=CP_ACP) then
cp:=DefaultSystemCodePage;
widestringmanager.Ansi2WideMoveProc(PChar(S2),cp,result,Size); widestringmanager.Ansi2WideMoveProc(PChar(S2),cp,result,Size);
end; end;
end; end;

59
rtl/java/jastrings.inc
View File

@ -17,6 +17,18 @@
{ This will release some functions for special shortstring support } { This will release some functions for special shortstring support }
{ define EXTRAANSISHORT} { define EXTRAANSISHORT}
{$define FPC_HAS_TRANSLATEPLACEHOLDERCP}
function TranslatePlaceholderCP(cp: TSystemCodePage): TSystemCodePage; {$ifdef SYSTEMINLINE}inline;{$endif}
begin
TranslatePlaceholderCP:=cp;
case cp of
CP_OEMCP,
CP_ACP:
TranslatePlaceholderCP:=DefaultSystemCodePage;
end;
end;
constructor AnsistringClass.Create(len: longint; cp: TSystemCodePage); constructor AnsistringClass.Create(len: longint; cp: TSystemCodePage);
begin begin
fElementSize:=1; fElementSize:=1;
@ -146,7 +158,7 @@ end;
function AnsistringClass.toUnicodeString: unicodestring; function AnsistringClass.toUnicodeString: unicodestring;
begin begin
widestringmanager.Ansi2UnicodeMoveProc(pchar(fdata),fCodePage,result,system.length(fdata)-1); widestringmanager.Ansi2UnicodeMoveProc(pchar(fdata),TranslatePlaceholderCP(fCodePage),result,system.length(fdata)-1);
end; end;
@ -302,11 +314,8 @@ begin
Size:=Length(S); Size:=Length(S);
if Size>0 then if Size>0 then
begin begin
if (cp=CP_ACP) then cp:=TranslatePlaceholderCP(cp);
cp:=DefaultSystemCodePage; orgcp:=TranslatePlaceholderCP(StringCodePage(S));
orgcp:=StringCodePage(S);
if (orgcp=CP_ACP) then
orgcp:=DefaultSystemCodePage;
if (orgcp=cp) or (orgcp=CP_NONE) then if (orgcp=cp) or (orgcp=CP_NONE) then
begin begin
result:=RawByteString(AnsistringClass.Create(S,cp)); result:=RawByteString(AnsistringClass.Create(S,cp));
@ -333,7 +342,6 @@ Var
DestCP : TSystemCodePage; DestCP : TSystemCodePage;
U : UnicodeString; U : UnicodeString;
sameCP : Boolean; sameCP : Boolean;
tmpStr : RawByteString;
tmpCP : TSystemCodePage; tmpCP : TSystemCodePage;
begin begin
if high(sarr)=0 then if high(sarr)=0 then
@ -349,15 +357,12 @@ begin
{$else FPC_HAS_CPSTRING} {$else FPC_HAS_CPSTRING}
DestCP:=StringCodePage(DestS); DestCP:=StringCodePage(DestS);
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
if (DestCP=CP_ACP) then DestCP:=TranslatePlaceholderCP(DestCP);
DestCP:=DefaultSystemCodePage;
sameCP:=true; sameCP:=true;
lowstart:=low(sarr); lowstart:=low(sarr);
for i:=lowstart to high(sarr) do for i:=lowstart to high(sarr) do
begin begin
tmpCP:=StringCodePage(sarr[i]); tmpCP:=TranslatePlaceholderCP(StringCodePage(sarr[i]));
if tmpCP=CP_ACP then
tmpCP:=DefaultSystemCodePage;
if (DestCP<>tmpCp) then if (DestCP<>tmpCp) then
begin begin
sameCP:=false; sameCP:=false;
@ -367,17 +372,8 @@ begin
if not sameCP then if not sameCP then
begin begin
U:=''; U:='';
for i:=lowstart to high(sarr) do begin for i:=lowstart to high(sarr) do
tmpCP:=StringCodePage(sarr[i]); U:=U+UnicodeString(sarr[i]);
if (tmpCP=CP_ACP) then
begin
tmpStr:=sarr[i];
SetCodePage(tmpStr,DefaultSystemCodePage,False);
U:=U+UnicodeString(tmpStr);
end
else
U:=U+UnicodeString(sarr[i]);
end;
DestS:=''; DestS:='';
widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(JLString(U).toCharArray),DestS,DestCP,Length(U)); widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(JLString(U).toCharArray),DestS,DestCP,Length(U));
@ -468,8 +464,7 @@ begin
if L > 0 then if L > 0 then
begin begin
{$ifdef FPC_HAS_CPSTRING} {$ifdef FPC_HAS_CPSTRING}
if (cp=CP_ACP) then cp:=TranslatePlaceholderCP(cp);
cp:=DefaultSystemCodePage;
{$else FPC_HAS_CPSTRING} {$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
@ -552,10 +547,11 @@ begin
else else
begin begin
r1:=S1; r1:=S1;
if (cp1=CP_ACP) then cp1:=TranslatePlaceholderCP(cp1);
if (cp1<>StringCodePage(r1)) then
SetCodePage(r1,DefaultSystemCodePage,false); SetCodePage(r1,DefaultSystemCodePage,false);
r2:=S2; r2:=S2;
if (cp2=CP_ACP) then if (cp2<>StringCodePage(r2)) then
SetCodePage(r2,DefaultSystemCodePage,false); SetCodePage(r2,DefaultSystemCodePage,false);
//convert them to utf8 then compare //convert them to utf8 then compare
SetCodePage(r1,65001); SetCodePage(r1,65001);
@ -599,10 +595,12 @@ begin
if cp1<>cp2 then if cp1<>cp2 then
begin begin
r1:=S1; r1:=S1;
if (cp1=CP_ACP) then cp1:=TranslatePlaceholderCP(cp1);
if (cp1<>StringCodePage(r1)) then
SetCodePage(r1,DefaultSystemCodePage,false); SetCodePage(r1,DefaultSystemCodePage,false);
r2:=S2; r2:=S2;
if (cp2=CP_ACP) then cp2:=TranslatePlaceholderCP(cp2);
if (cp2<>StringCodePage(r2)) then
SetCodePage(r2,DefaultSystemCodePage,false); SetCodePage(r2,DefaultSystemCodePage,false);
//convert them to utf8 then compare //convert them to utf8 then compare
SetCodePage(r1,65001); SetCodePage(r1,65001);
@ -631,8 +629,7 @@ var
oldlen: longint; oldlen: longint;
result: RawByteString; result: RawByteString;
begin begin
if (cp=CP_ACP) then cp:=TranslatePlaceholderCP(cp);
cp:=DefaultSystemCodePage;
{ no explicit reference counting possible -> can't reuse S because we don't { no explicit reference counting possible -> can't reuse S because we don't
know how many references exist to it } know how many references exist to it }
result:=RawByteString(AnsistringClass.Create(l,cp)); result:=RawByteString(AnsistringClass.Create(l,cp));

1
rtl/java/jsystemh_types.inc
View File

@ -295,6 +295,7 @@ Type
{ some values which are used in RTL for TSystemCodePage type } { some values which are used in RTL for TSystemCodePage type }
const const
CP_ACP = 0; // default to ANSI code page CP_ACP = 0; // default to ANSI code page
CP_OEMCP = 1; // default to OEM (console) code page
CP_UTF16 = 1200; // utf-16 CP_UTF16 = 1200; // utf-16
CP_UTF16BE = 1201; // unicodeFFFE CP_UTF16BE = 1201; // unicodeFFFE
CP_UTF7 = 65000; // utf-7 CP_UTF7 = 65000; // utf-7

12
rtl/java/justrings.inc
View File

@ -122,8 +122,7 @@ Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString{$ifdef FPC_HAS_CPST
Var Var
Size : SizeInt; Size : SizeInt;
begin begin
if (cp=CP_ACP) then cp:=TranslatePlaceholderCP(cp);
cp:=DefaultSystemCodePage;
{ avoid codepage conversion -- why isn't the result rawbytestring? } { avoid codepage conversion -- why isn't the result rawbytestring? }
pointer(result):=pointer(AnsistringClass.Create(s2,cp)); pointer(result):=pointer(AnsistringClass.Create(s2,cp));
end; end;
@ -185,8 +184,7 @@ begin
if (p=nil) or if (p=nil) or
(p^=#0) then (p^=#0) then
exit; exit;
if (cp=CP_ACP) then cp:=TranslatePlaceholderCP(cp);
cp:=DefaultSystemCodePage;
pointer(result):=pointer(AnsistringClass.Create(unicodestring(p),cp)); pointer(result):=pointer(AnsistringClass.Create(unicodestring(p),cp));
end; end;
@ -317,8 +315,7 @@ var
arr: array[0..0] of unicodechar; arr: array[0..0] of unicodechar;
begin begin
arr[0]:=c; arr[0]:=c;
if (cp=CP_ACP) then cp:=TranslatePlaceholderCP(cp);
cp:=DefaultSystemCodePage;
widestringmanager.Unicode2AnsiMoveProc(punicodechar(@arr), RawByteString(fpc_UChar_To_AnsiStr), cp, 1); widestringmanager.Unicode2AnsiMoveProc(punicodechar(@arr), RawByteString(fpc_UChar_To_AnsiStr), cp, 1);
end; end;
@ -351,8 +348,7 @@ begin
{$ifndef FPC_HAS_CPSTRING} {$ifndef FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
if (cp=CP_ACP) then cp:=TranslatePlaceholderCP(cp);
cp:=DefaultSystemCodePage;
arr[0]:=c; arr[0]:=c;
widestringmanager.Unicode2AnsiMoveProc(punicodechar(@arr[0]), fpc_UChar_To_AnsiStr, cp, 1); widestringmanager.Unicode2AnsiMoveProc(punicodechar(@arr[0]), fpc_UChar_To_AnsiStr, cp, 1);
end; end;

16
rtl/win/sysos.inc
View File

@ -318,6 +318,8 @@ threadvar
stdcall;external KernelDLL name 'GetConsoleMode'; stdcall;external KernelDLL name 'GetConsoleMode';
function GetConsoleOutputCP : UINT; function GetConsoleOutputCP : UINT;
stdcall; external KernelDLL name 'GetConsoleOutputCP'; stdcall; external KernelDLL name 'GetConsoleOutputCP';
function GetOEMCP: UINT;
stdcall; external KernelDLL name 'GetOEMCP';
function SysAllocStringLen(psz:pointer;len:dword):pointer; function SysAllocStringLen(psz:pointer;len:dword):pointer;
stdcall; external 'oleaut32.dll' name 'SysAllocStringLen'; stdcall; external 'oleaut32.dll' name 'SysAllocStringLen';
@ -392,3 +394,17 @@ threadvar
SetString(widestring(pointer(result)),PWideChar(source),length(source)); SetString(widestring(pointer(result)),PWideChar(source),length(source));
end; end;
{$ifndef WINCE}
{$define FPC_HAS_TRANSLATEPLACEHOLDERCP}
function TranslatePlaceholderCP(cp: TSystemCodePage): TSystemCodePage; {$ifdef SYSTEMINLINE}inline;{$endif}
begin
TranslatePlaceholderCP:=cp;
case cp of
CP_OEMCP:
TranslatePlaceholderCP:=GetOEMCP;
CP_ACP:
TranslatePlaceholderCP:=DefaultSystemCodePage;
end;
end;
{$endif not WINCE}

1
rtl/wince/system.pp
View File

@ -307,7 +307,6 @@ const
MB_COMPOSITE = 2; MB_COMPOSITE = 2;
MB_ERR_INVALID_CHARS = 8; MB_ERR_INVALID_CHARS = 8;
MB_USEGLYPHCHARS = 4; MB_USEGLYPHCHARS = 4;
CP_OEMCP = 1;
function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar; cchMultiByte:longint; lpWideCharStr:PWideChar;cchWideChar:longint):longint; function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar; cchMultiByte:longint; lpWideCharStr:PWideChar;cchWideChar:longint):longint;
cdecl; external 'coredll' name 'MultiByteToWideChar'; cdecl; external 'coredll' name 'MultiByteToWideChar';