diff --git a/compiler/defcmp.pas b/compiler/defcmp.pas index e965fe3ed6..66afbcc53c 100644 --- a/compiler/defcmp.pas +++ b/compiler/defcmp.pas @@ -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 diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas index faac7e99aa..045ee70461 100644 --- a/compiler/ncnv.pas +++ b/compiler/ncnv.pas @@ -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; diff --git a/rtl/inc/astrings.inc b/rtl/inc/astrings.inc index 8004d4cc0f..8e959e68bb 100644 --- a/rtl/inc/astrings.inc +++ b/rtl/inc/astrings.inc @@ -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); diff --git a/rtl/inc/compproc.inc b/rtl/inc/compproc.inc index 882993d18c..613b2de374 100644 --- a/rtl/inc/compproc.inc +++ b/rtl/inc/compproc.inc @@ -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; diff --git a/rtl/inc/ustringh.inc b/rtl/inc/ustringh.inc index 6e4e76afe7..9909f9f2d6 100644 --- a/rtl/inc/ustringh.inc +++ b/rtl/inc/ustringh.inc @@ -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; diff --git a/rtl/inc/ustrings.inc b/rtl/inc/ustrings.inc index f25e9747cf..a90fb06f22 100644 --- a/rtl/inc/ustrings.inc +++ b/rtl/inc/ustrings.inc @@ -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)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} diff --git a/rtl/inc/wstringh.inc b/rtl/inc/wstringh.inc index d933fef0c0..1dd9c7e7ff 100644 --- a/rtl/inc/wstringh.inc +++ b/rtl/inc/wstringh.inc @@ -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; diff --git a/rtl/inc/wstrings.inc b/rtl/inc/wstrings.inc index 553da593e4..2891167658 100644 --- a/rtl/inc/wstrings.inc +++ b/rtl/inc/wstrings.inc @@ -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} diff --git a/rtl/win/sysos.inc b/rtl/win/sysos.inc index 76a08c1cff..82687077de 100644 --- a/rtl/win/sysos.inc +++ b/rtl/win/sysos.inc @@ -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; diff --git a/rtl/win/sysosh.inc b/rtl/win/sysosh.inc index 7bfe95d315..0f4be7f524 100644 --- a/rtl/win/sysosh.inc +++ b/rtl/win/sysosh.inc @@ -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 diff --git a/rtl/win/syswin.inc b/rtl/win/syswin.inc index a46ebaa972..a8b1377e83 100644 --- a/rtl/win/syswin.inc +++ b/rtl/win/syswin.inc @@ -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);