merge r13485 from cpstrnew branch by florian:

* fixed compilation of system unit after last changes

git-svn-id: trunk@19083 -
This commit is contained in:
paul 2011-09-17 11:01:42 +00:00
parent 28627482c5
commit ae0d732c8f
11 changed files with 177 additions and 106 deletions

View File

@ -357,7 +357,10 @@ implementation
(tstringdef(def_from).len=tstringdef(def_to).len)) and
{ for ansi- and unicodestrings also the encoding must match }
(not(tstringdef(def_from).stringtype in [st_ansistring,st_unicodestring]) or
(tstringdef(def_from).encoding=tstringdef(def_to).encoding))then
(tstringdef(def_from).encoding=tstringdef(def_to).encoding) or
{ RawByteString is compatible with everything }
(tstringdef(def_from).encoding=65535) or
(tstringdef(def_to).encoding=65535)) then
eq:=te_equal
else
begin

View File

@ -1036,23 +1036,28 @@ implementation
end
else
{ shortstrings are handled 'inline' (except for widechars) }
if (tstringdef(resultdef).stringtype <> st_shortstring) or
(torddef(left.resultdef).ordtype = uwidechar) then
if (tstringdef(resultdef).stringtype<>st_shortstring) or
(torddef(left.resultdef).ordtype=uwidechar) then
begin
if (tstringdef(resultdef).stringtype <> st_shortstring) then
if (tstringdef(resultdef).stringtype<>st_shortstring) then
begin
{ parameter }
para:=ccallparanode.create(left,nil);
{ create the procname }
if torddef(left.resultdef).ordtype<>uwidechar then
procname := 'fpc_char_to_'
procname:='fpc_char_to_'
else
procname := 'fpc_uchar_to_';
begin
{ encoding required? }
if tstringdef(resultdef).stringtype=st_ansistring then
para:=ccallparanode.create(cordconstnode.create(tstringdef(resultdef).encoding,u16inttype,true),para);
procname:='fpc_uchar_to_';
end;
procname:=procname+tstringdef(resultdef).stringtypname;
{ and the parameter }
para := ccallparanode.create(left,nil);
{ and finally the call }
result := ccallnode.createinternres(procname,para,resultdef);
result:=ccallnode.createinternres(procname,para,resultdef);
end
else
begin
@ -2871,8 +2876,15 @@ implementation
addstatement(newstat,ctemprefnode.create(restemp));
result:=newblock;
end
{ encoding parameter required? }
else if (tstringdef(resultdef).stringtype=st_ansistring) and
(tstringdef(left.resultdef).stringtype in [st_widestring,st_unicodestring]) then
result:=ccallnode.createinternres(procname,
ccallparanode.create(cordconstnode.create(tstringdef(resultdef).encoding,u16inttype,true),
ccallparanode.create(left,nil)),resultdef)
else
result := ccallnode.createinternres(procname,ccallparanode.create(left,nil),resultdef);
result:=ccallnode.createinternres(procname,ccallparanode.create(left,nil),resultdef);
left:=nil;
end;

View File

@ -566,7 +566,7 @@ begin
end;
{$endif VER2_4}
Procedure fpc_AnsiStr_SetLength (Var S : AnsiString; l : SizeInt);[Public,Alias : 'FPC_ANSISTR_SETLENGTH']; compilerproc;
Procedure fpc_AnsiStr_SetLength (Var S : RawByteString; l : SizeInt);[Public,Alias : 'FPC_ANSISTR_SETLENGTH']; compilerproc;
{
Sets The length of string S to L.
Makes sure S is unique, and contains enough room.
@ -1104,7 +1104,7 @@ end;
function StringCodePage(const S: RawByteString): TSystemCodePage; overload;
begin
if assigned(S) then
if assigned(Pointer(S)) then
Result:=PAnsiRec(pointer(S)-AnsiFirstOff)^.CodePage
else
Result:=SizeOf(AnsiChar);
@ -1113,7 +1113,7 @@ function StringCodePage(const S: RawByteString): TSystemCodePage; overload;
function StringElementSize(const S: RawByteString): Word; overload;
begin
if assigned(S) then
if assigned(Pointer(S)) then
Result:=PAnsiRec(pointer(S)-AnsiFirstOff)^.ElementSize
else
Result:=SizeOf(AnsiChar);
@ -1122,7 +1122,7 @@ function StringElementSize(const S: RawByteString): Word; overload;
function StringRefCount(const S: RawByteString): SizeInt; overload;
begin
if assigned(S) then
if assigned(Pointer(S)) then
Result:=PAnsiRec(pointer(S)-AnsiFirstOff)^.Ref
else
Result:=SizeOf(AnsiChar);

View File

@ -286,7 +286,7 @@ Procedure fpc_AnsiStr_CheckRange(len,index : SizeInt); compilerproc;
Procedure fpc_AnsiStr_CheckRange(p : Pointer; index : SizeInt); compilerproc;
{$endif VER2_4}
Procedure fpc_AnsiStr_SetLength (Var S : AnsiString; l : SizeInt); compilerproc;
Procedure fpc_AnsiStr_SetLength (Var S : RawByteString; l : SizeInt); compilerproc;
Function fpc_ansistr_Copy (Const S : AnsiString; Index,Size : SizeInt) : AnsiString;compilerproc;
{$ifdef EXTRAANSISHORT}
Function fpc_AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString): SizeInt; compilerproc;
@ -311,7 +311,7 @@ function fpc_WideStr_To_ShortStr (high_of_res: SizeInt;const S2 : WideString): s
procedure fpc_WideStr_To_ShortStr (out res: ShortString;const S2 : WideString); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_ShortStr_To_WideStr (Const S2 : ShortString): WideString; compilerproc;
Function fpc_WideStr_To_AnsiStr (const S2 : WideString): AnsiString; compilerproc;
Function fpc_WideStr_To_AnsiStr (const S2 : WideString;cp : TSystemCodePage): AnsiString; compilerproc;
Function fpc_AnsiStr_To_WideStr (Const S2 : AnsiString): WideString; compilerproc;
Procedure fpc_WideStr_Assign (Var S1 : Pointer;S2 : Pointer); compilerproc;
{$ifndef STR_CONCAT_PROCS}
@ -346,7 +346,7 @@ Function fpc_widestr_Copy (Const S : WideString; Index,Size : SizeInt) : WideSt
{$ifndef FPC_WINLIKEWIDESTRING}
function fpc_widestr_Unique(Var S : Pointer): Pointer; compilerproc;
{$endif FPC_WINLIKEWIDESTRING}
Function fpc_WChar_To_AnsiStr(const c : WideChar): AnsiString; compilerproc;
Function fpc_WChar_To_AnsiStr(const c : WideChar;cp : TSystemCodePage): AnsiString; compilerproc;
Function fpc_WChar_To_WideStr(const c : WideChar): WideString; compilerproc;
{$ifndef VER2_2}
Function fpc_UChar_To_WideStr(const c : WideChar): WideString; compilerproc;
@ -372,7 +372,7 @@ function fpc_UnicodeStr_To_ShortStr (high_of_res: SizeInt;const S2 : UnicodeStri
procedure fpc_UnicodeStr_To_ShortStr (out res: ShortString;const S2 : UnicodeString); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_ShortStr_To_UnicodeStr (Const S2 : ShortString): UnicodeString; compilerproc;
Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString): AnsiString; compilerproc;
Function fpc_UnicodeStr_To_AnsiStr (const S2 : UnicodeString;cp : TSystemCodePage): AnsiString; compilerproc;
Function fpc_AnsiStr_To_UnicodeStr (Const S2 : AnsiString): UnicodeString; compilerproc;
Function fpc_UnicodeStr_To_WideStr (const S2 : UnicodeString): WideString; compilerproc;
Function fpc_WideStr_To_UnicodeStr (Const S2 : WideString): UnicodeString; compilerproc;
@ -403,7 +403,7 @@ Function fpc_UnicodeCharArray_To_ShortStr(const arr: array of unicodechar; zerob
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_UnicodeCharArray_To_ShortStr(out res : shortstring;const arr: array of unicodechar; zerobased: boolean = true); compilerproc;
{$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;
Function fpc_UnicodeCharArray_To_UnicodeStr(const arr: array of unicodechar; zerobased: boolean = true): UnicodeString; compilerproc;
{$ifndef VER2_2}
{$ifndef FPC_STRTOSHORTSTRINGPROC}
@ -411,7 +411,7 @@ Function fpc_WideCharArray_To_ShortStr(const arr: array of widechar; zerobased:
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_WideCharArray_To_ShortStr(out res : shortstring;const arr: array of widechar; zerobased: boolean = true); compilerproc;
{$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;
Function fpc_WideCharArray_To_WideStr(const arr: array of widechar; zerobased: boolean = true): WideString; compilerproc;
Function fpc_WideCharArray_To_UnicodeStr(const arr: array of widechar; zerobased: boolean = true): UnicodeString; compilerproc;
{$ifndef FPC_STRTOCHARARRAYPROC}
@ -440,7 +440,7 @@ Function fpc_Char_To_UChar(const c : Char): UnicodeChar; compilerproc;
Function fpc_UChar_To_Char(const c : UnicodeChar): Char; compilerproc;
Function fpc_UChar_To_UnicodeStr(const c : UnicodeChar): UnicodeString; compilerproc;
Function fpc_WChar_To_UnicodeStr(const c : WideChar): UnicodeString; compilerproc;
Function fpc_UChar_To_AnsiStr(const c : UnicodeChar): AnsiString; compilerproc;
Function fpc_UChar_To_AnsiStr(const c : UnicodeChar;cp : TSystemCodePage): AnsiString; compilerproc;
{$ifndef FPC_STRTOSHORTSTRINGPROC}
Function fpc_WChar_To_ShortStr(const c : WideChar): ShortString; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
@ -450,7 +450,7 @@ procedure fpc_WChar_To_ShortStr(out res : shortstring;const c : WideChar) compil
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Function fpc_PUnicodeChar_To_AnsiStr(const p : punicodechar): ansistring; compilerproc;
Function fpc_PUnicodeChar_To_AnsiStr(const p : punicodechar;cp : TSystemCodePage): ansistring; compilerproc;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
Function fpc_PUnicodeChar_To_UnicodeStr(const p : punicodechar): unicodestring; compilerproc;
Function fpc_PWideChar_To_UnicodeStr(const p : pwidechar): unicodestring; compilerproc;
@ -463,7 +463,7 @@ procedure fpc_PUnicodeChar_To_ShortStr(out res : shortstring;const p : punicodec
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
Function fpc_PWideChar_To_AnsiStr(const p : pwidechar): ansistring; compilerproc;
Function fpc_PWideChar_To_AnsiStr(const p : pwidechar;cp : TSystemCodePage): ansistring; compilerproc;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifndef FPC_STRTOSHORTSTRINGPROC}
Function fpc_PWideChar_To_ShortStr(const p : pwidechar): shortstring; compilerproc;

View File

@ -31,27 +31,30 @@ Procedure Delete (Var S : UnicodeString; Index,Size: SizeInt);
Procedure SetString (Out S : UnicodeString; Buf : PUnicodeChar; Len : SizeInt);
Procedure SetString (Out S : UnicodeString; Buf : PChar; Len : SizeInt);
function WideCharToString(S : PWideChar) : AnsiString;
function WideCharToString(S : PWideChar) : UnicodeString;
function StringToWideChar(const Src : AnsiString;Dest : PWideChar;DestSize : SizeInt) : PWideChar;
function WideCharLenToString(S : PWideChar;Len : SizeInt) : AnsiString;
function WideCharLenToString(S : PWideChar;Len : SizeInt) : UnicodeString;
procedure WideCharLenToStrVar(Src : PWideChar;Len : SizeInt;out Dest : UnicodeString);
procedure WideCharLenToStrVar(Src : PWideChar;Len : SizeInt;out Dest : AnsiString);
procedure WideCharToStrVar(S : PWideChar;out Dest : UnicodeString);
procedure WideCharToStrVar(S : PWideChar;out Dest : AnsiString);
function UnicodeCharToString(S : PUnicodeChar) : AnsiString;
function UnicodeCharToString(S : PUnicodeChar) : UnicodeString;
function StringToUnicodeChar(const Src : AnsiString;Dest : PUnicodeChar;DestSize : SizeInt) : PUnicodeChar;
function UnicodeCharLenToString(S : PUnicodeChar;Len : SizeInt) : AnsiString;
function UnicodeCharLenToString(S : PUnicodeChar;Len : SizeInt) : UnicodeString;
procedure UnicodeCharLenToStrVar(Src : PUnicodeChar;Len : SizeInt;out Dest : UnicodeString);
procedure UnicodeCharLenToStrVar(Src : PUnicodeChar;Len : SizeInt;out Dest : AnsiString);
procedure UnicodeCharToStrVar(S : PUnicodeChar;out Dest : AnsiString);
procedure DefaultUnicode2AnsiMove(source:punicodechar;var dest:ansistring;len:SizeInt);
procedure DefaultAnsi2UnicodeMove(source:pchar;var dest:unicodestring;len:SizeInt);
procedure DefaultUnicode2AnsiMove(source:punicodechar;var dest:ansistring;cp : TSystemCodePage;len:SizeInt);
procedure DefaultAnsi2UnicodeMove(source:pchar;cp : TSystemCodePage;var dest:unicodestring;len:SizeInt);
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;cp : TSystemCodePage;len:SizeInt);
Ansi2WideMoveProc : procedure(source:pchar;var dest:widestring;len:SizeInt);
Ansi2WideMoveProc : procedure(source:pchar;cp : TSystemCodePage;var dest:widestring;len:SizeInt);
// UpperUTF8 : procedure(p:PUTF8String);
@ -93,7 +96,7 @@ Type
{ this is only different on windows }
Unicode2AnsiMoveProc : procedure(source:punicodechar;var dest:ansistring;cp : TSystemCodePage;len:SizeInt);
Ansi2UnicodeMoveProc : procedure(source:pchar;var dest:unicodestring;len:SizeInt);
Ansi2UnicodeMoveProc : procedure(source:pchar;cp : TSystemCodePage;var dest:unicodestring;len:SizeInt);
UpperUnicodeStringProc : function(const S: UnicodeString): UnicodeString;
LowerUnicodeStringProc : function(const S: UnicodeString): UnicodeString;
CompareUnicodeStringProc : function(const s1, s2 : UnicodeString) : PtrInt;
@ -110,8 +113,8 @@ function Utf8ToUnicode(Dest: PUnicodeChar; MaxDestChars: SizeUInt; Source: PChar
function UTF8Encode(const s : Ansistring) : UTF8String; inline;
function UTF8Encode(const s : UnicodeString) : UTF8String;
function UTF8Decode(const s : UTF8String): UnicodeString;
function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
function AnsiToUtf8(const s : RawByteString): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
function Utf8ToAnsi(const s : UTF8String) : RawByteString;{$ifdef SYSTEMINLINE}inline;{$endif}
function UnicodeStringToUCS4String(const s : UnicodeString) : UCS4String;
function UCS4StringToUnicodeString(const s : UCS4String) : UnicodeString;
function WideStringToUCS4String(const s : WideString) : UCS4String;

View File

@ -78,7 +78,7 @@ begin
end;
procedure DefaultAnsi2UnicodeMove(source:pchar;var dest:unicodestring;len:SizeInt);
procedure DefaultAnsi2UnicodeMove(source:pchar;cp : TSystemCodePage;var dest:unicodestring;len:SizeInt);
var
i : SizeInt;
p : PUnicodeChar;
@ -304,7 +304,7 @@ begin
Size:=Length(S2);
if Size>0 then
begin
widestringmanager.Ansi2UnicodeMoveProc(PChar(@S2[1]),result,Size);
widestringmanager.Ansi2UnicodeMoveProc(PChar(@S2[1]),DefaultSystemCodePage,result,Size);
{ Terminating Zero }
PUnicodeChar(Pointer(fpc_ShortStr_To_UnicodeStr)+Size*sizeof(UnicodeChar))^:=#0;
end;
@ -335,7 +335,7 @@ begin
result:='';
Size:=Length(S2);
if Size>0 then
widestringmanager.Ansi2UnicodeMoveProc(PChar(S2),result,Size);
widestringmanager.Ansi2UnicodeMoveProc(PChar(S2),StringCodePage(S2),result,Size);
end;
@ -671,8 +671,8 @@ Function fpc_Char_To_UChar(const c : Char): UnicodeChar; compilerproc;
var
w: unicodestring;
begin
widestringmanager.Ansi2UnicodeMoveProc(@c, w, 1);
fpc_Char_To_UChar:= w[1];
widestringmanager.Ansi2UnicodeMoveProc(@c,DefaultSystemCodePage,w,1);
fpc_Char_To_UChar:=w[1];
end;
@ -718,8 +718,8 @@ Function fpc_Char_To_WChar(const c : Char): WideChar; compilerproc;
var
w: widestring;
begin
widestringmanager.Ansi2WideMoveProc(@c, w, 1);
fpc_Char_To_WChar:= w[1];
widestringmanager.Ansi2WideMoveProc(@c,DefaultSystemCodePage,w,1);
fpc_Char_To_WChar:=w[1];
end;
@ -817,7 +817,7 @@ begin
exit;
end;
l:=IndexChar(p^,-1,#0);
widestringmanager.Ansi2UnicodeMoveProc(P,fpc_PChar_To_UnicodeStr,l);
widestringmanager.Ansi2UnicodeMoveProc(P,DefaultSystemCodePage,fpc_PChar_To_UnicodeStr,l);
end;
@ -825,21 +825,21 @@ Function fpc_CharArray_To_UnicodeStr(const arr: array of char; zerobased: boolea
var
i : SizeInt;
begin
if (zerobased) then
if zerobased then
begin
if (arr[0]=#0) Then
begin
fpc_chararray_to_unicodestr := '';
exit;
end;
if arr[0]=#0 Then
begin
fpc_chararray_to_unicodestr:='';
exit;
end;
i:=IndexChar(arr,high(arr)+1,#0);
if i = -1 then
i := high(arr)+1;
if i=-1 then
i:=high(arr)+1;
end
else
i := high(arr)+1;
i:=high(arr)+1;
SetLength(fpc_CharArray_To_UnicodeStr,i);
widestringmanager.Ansi2UnicodeMoveProc (pchar(@arr),fpc_CharArray_To_UnicodeStr,i);
widestringmanager.Ansi2UnicodeMoveProc(pchar(@arr),DefaultSystemCodePage,fpc_CharArray_To_UnicodeStr,i);
end;
@ -1173,7 +1173,7 @@ begin
len := length(src);
{ make sure we don't dereference src if it can be nil (JM) }
if len > 0 then
widestringmanager.ansi2unicodemoveproc(pchar(@src[1]),temp,len);
widestringmanager.ansi2unicodemoveproc(pchar(@src[1]),DefaultSystemCodePage,temp,len);
len := length(temp);
if len > length(res) then
len := length(res);
@ -1194,7 +1194,7 @@ begin
len := length(src);
{ make sure we don't access char 1 if length is 0 (JM) }
if len > 0 then
widestringmanager.ansi2unicodemoveproc(pchar(@src[1]),temp,len);
widestringmanager.ansi2unicodemoveproc(pchar(@src[1]),DefaultSystemCodePage,temp,len);
len := length(temp);
if len > length(res) then
len := length(res);
@ -1214,7 +1214,7 @@ begin
len := length(src);
{ make sure we don't dereference src if it can be nil (JM) }
if len > 0 then
widestringmanager.ansi2widemoveproc(pchar(@src[1]),temp,len);
widestringmanager.ansi2widemoveproc(pchar(@src[1]),StringCodePage(src),temp,len);
len := length(temp);
if len > length(res) then
len := length(res);
@ -1235,7 +1235,7 @@ begin
len := length(src);
{ make sure we don't access char 1 if length is 0 (JM) }
if len > 0 then
widestringmanager.ansi2widemoveproc(pchar(@src[1]),temp,len);
widestringmanager.ansi2widemoveproc(pchar(@src[1]),DefaultSystemCodePage,temp,len);
len := length(temp);
if len > length(res) then
len := length(res);
@ -1392,16 +1392,17 @@ end;
Public functions, In interface.
*****************************************************************************}
function UnicodeCharToString(S : PUnicodeChar) : AnsiString;
function UnicodeCharToString(S : PUnicodeChar) : UnicodeString;
begin
result:=UnicodeCharLenToString(s,Length(UnicodeString(s)));
end;
function StringToUnicodeChar(const Src : AnsiString;Dest : PUnicodeChar;DestSize : SizeInt) : PUnicodeChar;
var
temp:unicodestring;
begin
widestringmanager.Ansi2UnicodeMoveProc(PChar(Src),temp,Length(Src));
widestringmanager.Ansi2UnicodeMoveProc(PChar(Src),StringCodePage(Src),temp,Length(Src));
if Length(temp)<DestSize then
move(temp[1],Dest^,Length(temp)*SizeOf(UnicodeChar))
else
@ -1414,7 +1415,7 @@ function StringToUnicodeChar(const Src : AnsiString;Dest : PUnicodeChar;DestSize
end;
function WideCharToString(S : PWideChar) : AnsiString;
function WideCharToString(S : PWideChar) : UnicodeString;
begin
result:=WideCharLenToString(s,Length(WideString(s)));
end;
@ -1424,7 +1425,7 @@ function StringToWideChar(const Src : AnsiString;Dest : PWideChar;DestSize : Siz
var
temp:widestring;
begin
widestringmanager.Ansi2WideMoveProc(PChar(Src),temp,Length(Src));
widestringmanager.Ansi2WideMoveProc(PChar(Src),StringCodePage(Src),temp,Length(Src));
if Length(temp)<DestSize then
move(temp[1],Dest^,Length(temp)*SizeOf(WideChar))
else
@ -1433,45 +1434,62 @@ function StringToWideChar(const Src : AnsiString;Dest : PWideChar;DestSize : Siz
Dest[DestSize-1]:=#0;
result:=Dest;
end;
function UnicodeCharLenToString(S : PUnicodeChar;Len : SizeInt) : UnicodeString;
begin
//SetLength(result,Len);
widestringmanager.Unicode2AnsiMoveproc(S,result,Len);
SetLength(result,Len);
Move(S^,Pointer(Result)^,Len*2);
end;
procedure UnicodeCharLenToStrVar(Src : PUnicodeChar;Len : SizeInt;out Dest : UnicodeString);
begin
Dest:=UnicodeCharLenToString(Src,Len);
end;
procedure UnicodeCharLenToStrVar(Src : PUnicodeChar;Len : SizeInt;out Dest : AnsiString);
begin
Dest:=UnicodeCharLenToString(Src,Len);
Dest:=UnicodeCharLenToString(Src,Len);
end;
procedure UnicodeCharToStrVar(S : PUnicodeChar;out Dest : AnsiString);
begin
Dest:=UnicodeCharToString(S);
Dest:=UnicodeCharToString(S);
end;
function WideCharLenToString(S : PWideChar;Len : SizeInt) : UnicodeString;
begin
//SetLength(result,Len);
widestringmanager.Wide2AnsiMoveproc(S,result,Len);
SetLength(result,Len);
Move(S^,Pointer(Result)^,Len*2);
end;
procedure WideCharLenToStrVar(Src : PWideChar;Len : SizeInt;out Dest : UnicodeString);
begin
Dest:=WideCharLenToString(Src,Len);
end;
procedure WideCharLenToStrVar(Src : PWideChar;Len : SizeInt;out Dest : AnsiString);
begin
Dest:=WideCharLenToString(Src,Len);
Dest:=WideCharLenToString(Src,Len);
end;
procedure WideCharToStrVar(S : PWideChar;out Dest : UnicodeString);
begin
Dest:=WideCharToString(S);
end;
procedure WideCharToStrVar(S : PWideChar;out Dest : AnsiString);
begin
Dest:=WideCharToString(S);
Dest:=WideCharToString(S);
end;
@ -1692,7 +1710,13 @@ var
begin
SetLength(S,Len);
If (Buf<>Nil) and (Len>0) then
widestringmanager.Ansi2UnicodeMoveProc(Buf,S,Len);
begin
BufLen := IndexByte(Buf^, Len+1, 0);
If (BufLen>0) and (BufLen < Len) then
Len := BufLen;
widestringmanager.Ansi2UnicodeMoveProc(Buf,DefaultSystemCodePage,S,Len);
//PUnicodeChar(Pointer(S)+Len*sizeof(UnicodeChar))^:=#0;
end;
end;
@ -2355,13 +2379,13 @@ function UTF8Decode(const s : UTF8String): UnicodeString;
end;
function AnsiToUtf8(const s : ansistring): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
function AnsiToUtf8(const s : RawByteString): UTF8String;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Result:=Utf8Encode(s);
end;
function Utf8ToAnsi(const s : UTF8String) : ansistring;{$ifdef SYSTEMINLINE}inline;{$endif}
function Utf8ToAnsi(const s : UTF8String) : RawByteString;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
Result:=Utf8Decode(s);
end;
@ -2530,7 +2554,7 @@ procedure unimplementedunicodestring;
function StringElementSize(const S: UnicodeString): Word; overload;
begin
if assigned(S) then
if assigned(Pointer(S)) then
Result:=PUnicodeRec(pointer(S)-UnicodeFirstOff)^.ElementSize
else
Result:=SizeOf(UnicodeChar);
@ -2539,7 +2563,7 @@ function StringElementSize(const S: UnicodeString): Word; overload;
function StringRefCount(const S: UnicodeString): SizeInt; overload;
begin
if assigned(S) then
if assigned(Pointer(S)) then
Result:=PUnicodeRec(pointer(S)-UnicodeFirstOff)^.Ref
else
Result:=SizeOf(UnicodeChar);
@ -2548,7 +2572,7 @@ function StringRefCount(const S: UnicodeString): SizeInt; overload;
function StringCodePage(const S: UnicodeString): TSystemCodePage; overload;
begin
if assigned(S) then
if assigned(Pointer(S)) then
Result:=PUnicodeRec(pointer(S)-UnicodeFirstOff)^.CodePage
else
Result:=SizeOf(UnicodeChar);
@ -2577,8 +2601,8 @@ function CompareTextUnicodeString(const s1, s2 : UnicodeString): PtrInt;
procedure initunicodestringmanager;
begin
{$ifndef HAS_WIDESTRINGMANAGER}
widestringmanager.Unicode2AnsiMoveProc:=@defaultUnicode2AnsiMove;
widestringmanager.Ansi2UnicodeMoveProc:=@defaultAnsi2UnicodeMove;
widestringmanager.Unicode2AnsiMoveProc:=@DefaultUnicode2AnsiMove;
widestringmanager.Ansi2UnicodeMoveProc:=@DefaultAnsi2UnicodeMove;
widestringmanager.UpperUnicodeStringProc:=@GenericUnicodeCase;
widestringmanager.LowerUnicodeStringProc:=@GenericUnicodeCase;
{$endif HAS_WIDESTRINGMANAGER}

View File

@ -31,8 +31,8 @@ Procedure Delete (Var S : WideString; Index,Size: SizeInt);
Procedure SetString (Out S : WideString; Buf : PWideChar; Len : SizeInt);
Procedure SetString (Out S : WideString; Buf : PChar; Len : SizeInt);
procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt);
procedure DefaultAnsi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
procedure DefaultWide2AnsiMove(source:pwidechar;var dest:ansistring;cp : TSystemCodePage;len:SizeInt);
procedure DefaultAnsi2WideMove(source:pchar;cp : TSystemCodePage;var dest:widestring;len:SizeInt);
type
TWideStringManager = TUnicodeStringManager;

View File

@ -69,7 +69,7 @@ begin
end;
procedure DefaultAnsi2WideMove(source:pchar;var dest:widestring;len:SizeInt);
procedure DefaultAnsi2WideMove(source:pchar;cp : TSystemCodePage;var dest:widestring;len:SizeInt);
var
i : SizeInt;
begin
@ -254,7 +254,7 @@ begin
Size:=Length(S2);
if Size>0 then
begin
widestringmanager.Ansi2WideMoveProc(PChar(@S2[1]),result,Size);
widestringmanager.Ansi2WideMoveProc(PChar(@S2[1]),DefaultSystemCodePage,result,Size);
{ Terminating Zero }
PWideChar(Pointer(fpc_ShortStr_To_WideStr)+Size*sizeof(WideChar))^:=#0;
end;
@ -285,7 +285,7 @@ begin
result:='';
Size:=Length(S2);
if Size>0 then
widestringmanager.Ansi2WideMoveProc(PChar(S2),result,Size);
widestringmanager.Ansi2WideMoveProc(PChar(S2),StringCodePage(S2),result,Size);
end;
@ -527,7 +527,7 @@ begin
exit;
end;
l:=IndexChar(p^,-1,#0);
widestringmanager.Ansi2WideMoveProc(P,fpc_PChar_To_WideStr,l);
widestringmanager.Ansi2WideMoveProc(P,DefaultSystemCodePage,fpc_PChar_To_WideStr,l);
end;
@ -549,7 +549,7 @@ begin
else
i := high(arr)+1;
SetLength(fpc_CharArray_To_WideStr,i);
widestringmanager.Ansi2WideMoveProc (pchar(@arr),fpc_CharArray_To_WideStr,i);
widestringmanager.Ansi2WideMoveProc(pchar(@arr),DefaultSystemCodePage,fpc_CharArray_To_WideStr,i);
end;
@ -1013,7 +1013,13 @@ Procedure SetString (Out S : WideString; Buf : PChar; Len : SizeInt);
begin
SetLength(S,Len);
If (Buf<>Nil) and (Len>0) then
widestringmanager.Ansi2WideMoveProc(Buf,S,Len);
begin
BufLen := IndexByte(Buf^, Len+1, 0);
If (BufLen>0) and (BufLen < Len) then
Len := BufLen;
widestringmanager.Ansi2WideMoveProc(Buf,DefaultSystemCodePage,S,Len);
//PWideChar(Pointer(S)+Len*sizeof(WideChar))^:=#0;
end;
end;
@ -1697,8 +1703,8 @@ procedure initwidestringmanager;
begin
fillchar(widestringmanager,sizeof(widestringmanager),0);
{$ifndef HAS_WIDESTRINGMANAGER}
widestringmanager.Wide2AnsiMoveProc:=@defaultWide2AnsiMove;
widestringmanager.Ansi2WideMoveProc:=@defaultAnsi2WideMove;
widestringmanager.Wide2AnsiMoveProc:=@DefaultWide2AnsiMove;
widestringmanager.Ansi2WideMoveProc:=@DefaultAnsi2WideMove;
widestringmanager.UpperWideStringProc:=@GenericWideCase;
widestringmanager.LowerWideStringProc:=@GenericWideCase;
{$endif HAS_WIDESTRINGMANAGER}

View File

@ -302,13 +302,19 @@ threadvar
end;
function OleStrToString(source: PWideChar) : ansistring;inline;
function OleStrToString(source: PWideChar) : UnicodeString;inline;
begin
OleStrToStrVar(source,result);
end;
procedure OleStrToStrVar(source : PWideChar;var dest : ansistring);inline;
procedure OleStrToStrVar(source : PWideChar;var dest : UnicodeString);inline;
begin
WideCharLenToStrVar(source,length(WideString(pointer(source))),dest);
end;
procedure OleStrToStrVar(source : PWideChar;var dest : AnsiString);inline;
begin
WideCharLenToStrVar(source,length(WideString(pointer(source))),dest);
end;
@ -317,5 +323,20 @@ threadvar
function StringToOleStr(const source : ansistring) : PWideChar;inline;
begin
result:=nil;
widestringmanager.Ansi2WideMoveProc(pchar(pointer(source)),widestring(pointer(result)),length(source));
widestringmanager.Ansi2WideMoveProc(pchar(pointer(source)),StringCodePage(source),widestring(pointer(result)),length(source));
end;
Function NewWideString(Len : SizeInt) : Pointer;forward;
function StringToOleStr(const source : UnicodeString) : PWideChar;inline;
begin
if source<>'' then
begin
result:=NewWideString(Length(source));
move(source[1],result^,Length(source));
end
else
result:=nil;
end;

View File

@ -58,9 +58,11 @@ const
ApiSuffix = 'A';
{$endif WINCE}
function OleStrToString(source: PWideChar) : ansistring;inline;
procedure OleStrToStrVar(source : PWideChar;var dest : ansistring);inline;
function OleStrToString(source: PWideChar) : UnicodeString;inline;
procedure OleStrToStrVar(source : PWideChar;var dest : UnicodeString);inline;
procedure OleStrToStrVar(source : PWideChar;var dest : AnsiString);inline;
function StringToOleStr(const source : ansistring) : PWideChar;inline;
function StringToOleStr(const source : UnicodeString) : PWideChar;inline;
{ package stuff }
type

View File

@ -287,20 +287,20 @@ function GetProcessID: SizeUInt;
{******************************************************************************
Unicode
******************************************************************************}
const
{ MultiByteToWideChar }
MB_PRECOMPOSED = 1;
CP_ACP = 0;
WC_NO_BEST_FIT_CHARS = $400;
const
{ MultiByteToWideChar }
MB_PRECOMPOSED = 1;
CP_ACP = 0;
WC_NO_BEST_FIT_CHARS = $400;
function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar; cchMultiByte:longint; lpWideCharStr:PWideChar;cchWideChar:longint):longint;
stdcall; external 'kernel32' name 'MultiByteToWideChar';
function WideCharToMultiByte(CodePage:UINT; dwFlags:DWORD; lpWideCharStr:PWideChar; cchWideChar:longint; lpMultiByteStr:PChar;cchMultiByte:longint; lpDefaultChar:PChar; lpUsedDefaultChar:pointer):longint;
stdcall; external 'kernel32' name 'WideCharToMultiByte';
function CharUpperBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD;
stdcall; external 'user32' name 'CharUpperBuffW';
function CharLowerBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD;
stdcall; external 'user32' name 'CharLowerBuffW';
function MultiByteToWideChar(CodePage:UINT; dwFlags:DWORD; lpMultiByteStr:PChar; cchMultiByte:longint; lpWideCharStr:PWideChar;cchWideChar:longint):longint;
stdcall; external 'kernel32' name 'MultiByteToWideChar';
function WideCharToMultiByte(CodePage:UINT; dwFlags:DWORD; lpWideCharStr:PWideChar; cchWideChar:longint; lpMultiByteStr:PChar;cchMultiByte:longint; lpDefaultChar:PChar; lpUsedDefaultChar:pointer):longint;
stdcall; external 'kernel32' name 'WideCharToMultiByte';
function CharUpperBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD;
stdcall; external 'user32' name 'CharUpperBuffW';
function CharLowerBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD;
stdcall; external 'user32' name 'CharLowerBuffW';
procedure Win32Unicode2AnsiMove(source:punicodechar;var dest:ansistring;cp : TSystemCodePage;len:SizeInt);
var
@ -320,7 +320,7 @@ procedure Win32Ansi2UnicodeMove(source:pchar;cp : TSystemCodePage;var dest:Unico
begin
// retrieve length including trailing #0
// not anymore, because this must also be usable for single characters
destlen:=MultiByteToWideChar(MB_PRECOMPOSED, source, len, nil, 0);
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);