paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-06 15:47:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

merge r13483 from cpstrnew branch by florian:

Browse Source 
+ Win32Unicode2AnsiMove and Win32Wide2AnsiMove support code page parameter
+ Win32Ansi2UnicodeMove and Win32Ansi2WideMove support code page parameter
+ code page parameter added for several compilerprocs
* unified more code between win32 and win64 (widestring conversion routines

git-svn-id: trunk@19082 -
This commit is contained in:
paul 2011-09-17 10:54:00 +00:00
parent 42832675d8
commit 28627482c5
5 changed files with 62 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
rtl/inc/ustringh.inc
View File

@ -50,7 +50,7 @@ Type
{ hooks for internationalization
please add new procedures at the end, it makes it easier to detect new procedures }
TUnicodeStringManager = record
Wide2AnsiMoveProc : procedure(source:pwidechar;var dest:ansistring;len:SizeInt);
Wide2AnsiMoveProc : procedure(source:pwidechar;var dest:ansistring;cp : TSystemCodePage;len:SizeInt);
Ansi2WideMoveProc : procedure(source:pchar;var dest:widestring;len:SizeInt);
// UpperUTF8 : procedure(p:PUTF8String);
@ -92,7 +92,7 @@ Type
ThreadFiniProc : procedure;
{ this is only different on windows }
Unicode2AnsiMoveProc : procedure(source:punicodechar;var dest:ansistring;len:SizeInt);
Unicode2AnsiMoveProc : procedure(source:punicodechar;var dest:ansistring;cp : TSystemCodePage;len:SizeInt);
Ansi2UnicodeMoveProc : procedure(source:pchar;var dest:unicodestring;len:SizeInt);
UpperUnicodeStringProc : function(const S: UnicodeString): UnicodeString;
LowerUnicodeStringProc : function(const S: UnicodeString): UnicodeString;

62
rtl/inc/ustrings.inc
View File

@ -59,7 +59,7 @@ Const
These routines can be overwritten for the Current Locale
}
procedure DefaultUnicode2AnsiMove(source:punicodechar;var dest:ansistring;len:SizeInt);
procedure DefaultUnicode2AnsiMove(source:punicodechar;var dest:ansistring;cp : TSystemCodePage;len:SizeInt);
var
i : SizeInt;
p : PAnsiChar;
@ -188,7 +188,7 @@ begin
PUnicodeRec(P)^.Len:=Len*2; { Initial length }
PUnicodeRec(P)^.Ref:=1; { Initial Refcount }
PUnicodeRec(P)^.CodePage:=DefaultUnicodeCodePage;
PUnicodeRec(P)^.ElementSize:=SizeOf(UnicodeChar);
PUnicodeRec(P)^.ElementSize:=SizeOf(UnicodeChar);
PUnicodeRec(P)^.First:=#0; { Terminating #0 }
inc(p,UnicodeFirstOff); { Points to string now }
end
@ -286,7 +286,7 @@ begin
begin
If Size>high(res) then
Size:=high(res);
widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(S2),temp,Size);
widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(S2),temp,DefaultSystemCodePage,Size);
res:=temp;
end;
end;
@ -311,7 +311,7 @@ begin
end;
Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString): AnsiString; compilerproc;
Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString;cp : TSystemCodePage): AnsiString; compilerproc;
{
Converts a UnicodeString to an AnsiString
}
@ -321,7 +321,7 @@ begin
result:='';
Size:=Length(S2);
if Size>0 then
widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(Pointer(S2)),result,Size);
widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(Pointer(S2)),result,cp,Size);
end;
@ -353,7 +353,7 @@ Function fpc_WideStr_To_UnicodeStr (Const S2 : WideString): UnicodeString; compi
end;
Function fpc_PUnicodeChar_To_AnsiStr(const p : punicodechar): ansistring; compilerproc;
Function fpc_PUnicodeChar_To_AnsiStr(const p : punicodechar;cp : TSystemCodePage): ansistring; compilerproc;
var
Size : SizeInt;
begin
@ -362,7 +362,7 @@ begin
exit;
Size := IndexWord(p^, -1, 0);
if Size>0 then
widestringmanager.Unicode2AnsiMoveProc(P,result,Size);
widestringmanager.Unicode2AnsiMoveProc(P,result,cp,Size);
end;
@ -430,14 +430,14 @@ begin
Size:=IndexWord(p^, high(PtrInt), 0);
if Size>0 then
begin
widestringmanager.Unicode2AnsiMoveProc(p,temp,Size);
widestringmanager.Unicode2AnsiMoveProc(p,temp,DefaultSystemCodePage,Size);
res:=temp;
end;
end;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_PWideChar_To_AnsiStr(const p : pwidechar): ansistring; compilerproc;
Function fpc_PWideChar_To_AnsiStr(const p : pwidechar;cp : TSystemCodePage): ansistring; compilerproc;
var
Size : SizeInt;
begin
@ -446,7 +446,7 @@ begin
exit;
Size := IndexWord(p^, -1, 0);
if Size>0 then
widestringmanager.Wide2AnsiMoveProc(P,result,Size);
widestringmanager.Wide2AnsiMoveProc(P,result,cp,Size);
end;
@ -478,7 +478,7 @@ begin
Size:=IndexWord(p^, high(PtrInt), 0);
if Size>0 then
begin
widestringmanager.Wide2AnsiMoveProc(p,temp,Size);
widestringmanager.Wide2AnsiMoveProc(p,temp,DefaultSystemCodePage,Size);
res:=temp;
end;
end;
@ -696,7 +696,7 @@ Function fpc_UChar_To_Char(const c : UnicodeChar): Char; compilerproc;
var
s: ansistring;
begin
widestringmanager.Unicode2AnsiMoveProc(@c, s, 1);
widestringmanager.Unicode2AnsiMoveProc(@c, s, DefaultSystemCodePage, 1);
if length(s)=1 then
fpc_UChar_To_Char:= s[1]
else
@ -730,7 +730,7 @@ Function fpc_WChar_To_Char(const c : WideChar): Char; compilerproc;
var
s: ansistring;
begin
widestringmanager.Wide2AnsiMoveProc(@c, s, 1);
widestringmanager.Wide2AnsiMoveProc(@c, s, DefaultSystemCodePage, 1);
if length(s)=1 then
fpc_WChar_To_Char:= s[1]
else
@ -757,7 +757,7 @@ procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compil
var
s: ansistring;
begin
widestringmanager.Wide2AnsiMoveProc(@c,s,1);
widestringmanager.Wide2AnsiMoveProc(@c,s,DefaultSystemCodePage,1);
res:=s;
end;
{$endif FPC_STRTOSHORTSTRINGPROC}
@ -773,12 +773,12 @@ begin
end;
Function fpc_UChar_To_AnsiStr(const c : UnicodeChar): AnsiString; compilerproc;
Function fpc_UChar_To_AnsiStr(const c : UnicodeChar;cp : TSystemCodePage): AnsiString; compilerproc;
{
Converts a UnicodeChar to a AnsiString;
}
begin
widestringmanager.Unicode2AnsiMoveProc(@c, fpc_UChar_To_AnsiStr, 1);
widestringmanager.Unicode2AnsiMoveProc(@c, fpc_UChar_To_AnsiStr, cp, 1);
end;
@ -801,7 +801,7 @@ procedure fpc_UChar_To_ShortStr(out res : shortstring;const c : UnicodeChar) com
var
s: ansistring;
begin
widestringmanager.Unicode2AnsiMoveProc(@c,s,1);
widestringmanager.Unicode2AnsiMoveProc(@c,s,DefaultSystemCodePage,1);
res:=s;
end;
{$endif FPC_STRTOSHORTSTRINGPROC}
@ -892,12 +892,12 @@ begin
end
else
len:=l;
widestringmanager.Unicode2AnsiMoveProc (punicodechar(@arr),temp,len);
widestringmanager.Unicode2AnsiMoveProc (punicodechar(@arr),temp,DefaultSystemCodePage,len);
res:=temp;
end;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_UnicodeCharArray_To_AnsiStr(const arr: array of unicodechar; zerobased: boolean = true): AnsiString; compilerproc;
Function fpc_UnicodeCharArray_To_AnsiStr(const arr: array of unicodechar; cp : TSystemCodePage;zerobased: boolean = true): AnsiString; compilerproc;
var
i : SizeInt;
begin
@ -910,7 +910,7 @@ begin
else
i := high(arr)+1;
SetLength(fpc_UnicodeCharArray_To_AnsiStr,i);
widestringmanager.Unicode2AnsiMoveProc (punicodechar(@arr),fpc_UnicodeCharArray_To_AnsiStr,i);
widestringmanager.Unicode2AnsiMoveProc (punicodechar(@arr),fpc_UnicodeCharArray_To_AnsiStr,cp,i);
end;
@ -999,12 +999,12 @@ begin
end
else
len:=l;
widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),temp,len);
widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),temp,DefaultSystemCodePage,len);
res:=temp;
end;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; zerobased: boolean = true): AnsiString; compilerproc;
Function fpc_WideCharArray_To_AnsiStr(const arr: array of widechar; cp : TSystemCodePage; zerobased: boolean = true): AnsiString; compilerproc;
var
i : SizeInt;
begin
@ -1017,7 +1017,7 @@ begin
else
i := high(arr)+1;
SetLength(fpc_WideCharArray_To_AnsiStr,i);
widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),fpc_WideCharArray_To_AnsiStr,i);
widestringmanager.Wide2AnsiMoveProc (pwidechar(@arr),fpc_WideCharArray_To_AnsiStr,cp,i);
end;
Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; compilerproc;
@ -1134,7 +1134,7 @@ begin
len := length(src);
{ make sure we don't dereference src if it can be nil (JM) }
if len > 0 then
widestringmanager.unicode2ansimoveproc(punicodechar(@src[1]),temp,len);
widestringmanager.unicode2ansimoveproc(punicodechar(@src[1]),temp,DefaultSystemCodePage,len);
len := length(temp);
if len > length(res) then
len := length(res);
@ -1437,7 +1437,7 @@ function StringToWideChar(const Src : AnsiString;Dest : PWideChar;DestSize : Siz
end;
function UnicodeCharLenToString(S : PUnicodeChar;Len : SizeInt) : AnsiString;
function UnicodeCharLenToString(S : PUnicodeChar;Len : SizeInt) : UnicodeString;
begin
//SetLength(result,Len);
widestringmanager.Unicode2AnsiMoveproc(S,result,Len);
@ -1456,7 +1456,7 @@ procedure UnicodeCharToStrVar(S : PUnicodeChar;out Dest : AnsiString);
end;
function WideCharLenToString(S : PWideChar;Len : SizeInt) : AnsiString;
function WideCharLenToString(S : PWideChar;Len : SizeInt) : UnicodeString;
begin
//SetLength(result,Len);
widestringmanager.Wide2AnsiMoveproc(S,result,Len);
@ -2527,7 +2527,7 @@ procedure unimplementedunicodestring;
HandleErrorFrame(233,get_frame);
end;
function StringElementSize(const S: UnicodeString): Word; overload;
begin
if assigned(S) then
@ -2535,8 +2535,8 @@ function StringElementSize(const S: UnicodeString): Word; overload;
else
Result:=SizeOf(UnicodeChar);
end;
function StringRefCount(const S: UnicodeString): SizeInt; overload;
begin
if assigned(S) then
@ -2545,7 +2545,7 @@ function StringRefCount(const S: UnicodeString): SizeInt; overload;
Result:=SizeOf(UnicodeChar);
end;
function StringCodePage(const S: UnicodeString): TSystemCodePage; overload;
begin
if assigned(S) then
@ -2554,7 +2554,7 @@ function StringCodePage(const S: UnicodeString): TSystemCodePage; overload;
Result:=SizeOf(UnicodeChar);
end;
{$warnings off}
function GenericUnicodeCase(const s : UnicodeString) : UnicodeString;
begin

14
rtl/inc/wstrings.inc
View File

@ -50,7 +50,7 @@ Const
These routines can be overwritten for the Current Locale
}
procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;cp : TSystemCodePage;len:SizeInt);
var
i : SizeInt;
destp: PChar;
@ -236,7 +236,7 @@ begin
begin
If Size>high(res) then
Size:=high(res);
widestringmanager.Wide2AnsiMoveProc(PWideChar(S2),temp,Size);
widestringmanager.Wide2AnsiMoveProc(PWideChar(S2),temp,DefaultSystemCodePage,Size);
res:=temp;
end;
end;
@ -261,7 +261,7 @@ begin
end;
Function fpc_WideStr_To_AnsiStr (const S2 : WideString): AnsiString; compilerproc;
Function fpc_WideStr_To_AnsiStr (const S2 : WideString;cp : TSystemCodePage): AnsiString; compilerproc;
{
Converts a WideString to an AnsiString
}
@ -271,7 +271,7 @@ begin
result:='';
Size:=Length(S2);
if Size>0 then
widestringmanager.Wide2AnsiMoveProc(PWideChar(Pointer(S2)),result,Size);
widestringmanager.Wide2AnsiMoveProc(PWideChar(Pointer(S2)),result,cp,Size);
end;
@ -498,12 +498,12 @@ begin
end;
Function fpc_WChar_To_AnsiStr(const c : WideChar): AnsiString; compilerproc;
Function fpc_WChar_To_AnsiStr(const c : WideChar;cp : TSystemCodePage): AnsiString; compilerproc;
{
Converts a WideChar to a AnsiString;
}
begin
widestringmanager.Wide2AnsiMoveProc(@c, fpc_WChar_To_AnsiStr, 1);
widestringmanager.Wide2AnsiMoveProc(@c, fpc_WChar_To_AnsiStr, cp, 1);
end;
@ -651,7 +651,7 @@ begin
len := length(src);
{ make sure we don't dereference src if it can be nil (JM) }
if len > 0 then
widestringmanager.wide2ansimoveproc(pwidechar(@src[1]),temp,len);
widestringmanager.wide2ansimoveproc(pwidechar(@src[1]),temp,DefaultSystemCodePage,len);
len := length(temp);
if len > length(res) then
len := length(res);

31
rtl/win/syswin.inc
View File

@ -302,28 +302,28 @@ function GetProcessID: SizeUInt;
function CharLowerBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD;
stdcall; external 'user32' name 'CharLowerBuffW';
procedure Win32Unicode2AnsiMove(source:punicodechar;var dest:ansistring;len:SizeInt);
procedure Win32Unicode2AnsiMove(source:punicodechar;var dest:ansistring;cp : TSystemCodePage;len:SizeInt);
var
destlen: SizeInt;
begin
// retrieve length including trailing #0
// not anymore, because this must also be usable for single characters
destlen:=WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, nil, 0, nil, nil);
destlen:=WideCharToMultiByte(cp, WC_NO_BEST_FIT_CHARS, source, len, nil, 0, nil, nil);
// this will null-terminate
setlength(dest, destlen);
WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, source, len, @dest[1], destlen, nil, nil);
WideCharToMultiByte(cp, WC_NO_BEST_FIT_CHARS, source, len, @dest[1], destlen, nil, nil);
end;
procedure Win32Ansi2UnicodeMove(source:pchar;var dest:UnicodeString;len:SizeInt);
procedure Win32Ansi2UnicodeMove(source:pchar;cp : TSystemCodePage;var dest:UnicodeString;len:SizeInt);
var
destlen: SizeInt;
begin
// retrieve length including trailing #0
// not anymore, because this must also be usable for single characters
destlen:=MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, nil, 0);
destlen:=MultiByteToWideChar(MB_PRECOMPOSED, source, len, nil, 0);
// this will null-terminate
setlength(dest, destlen);
MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, @dest[1], destlen);
MultiByteToWideChar(cp, MB_PRECOMPOSED, source, len, @dest[1], destlen);
end;
@ -348,16 +348,29 @@ function Win32UnicodeLower(const s : UnicodeString) : UnicodeString;
Widestring
******************************************************************************}
procedure Win32Ansi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
procedure Win32Wide2AnsiMove(source:pwidechar;var dest:ansistring;cp : TSystemCodePage;len:SizeInt);
var
destlen: SizeInt;
begin
// retrieve length including trailing #0
// not anymore, because this must also be usable for single characters
destlen:=MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, nil, 0);
destlen:=WideCharToMultiByte(cp, WC_NO_BEST_FIT_CHARS, source, len, nil, 0, nil, nil);
// this will null-terminate
setlength(dest, destlen);
MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, @dest[1], destlen);
WideCharToMultiByte(cp, WC_NO_BEST_FIT_CHARS, source, len, @dest[1], destlen, nil, nil);
end;
procedure Win32Ansi2WideMove(source:pchar;cp : TSystemCodePage;var dest:widestring;len:SizeInt);
var
destlen: SizeInt;
begin
// retrieve length including trailing #0
// not anymore, because this must also be usable for single characters
destlen:=MultiByteToWideChar(cp, MB_PRECOMPOSED, source, len, nil, 0);
// this will null-terminate
setlength(dest, destlen);
MultiByteToWideChar(cp, MB_PRECOMPOSED, source, len, @dest[1], destlen);
end;

1
rtl/win32/system.pp
View File

@ -829,7 +829,6 @@ end;
{$endif Set_i386_Exception_handler}
{******************************************************************************}
{ include code common with win64 }