mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 05:31:29 +01:00 
			
		
		
		
	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:
		
							parent
							
								
									28627482c5
								
							
						
					
					
						commit
						ae0d732c8f
					
				| @ -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 | ||||
|  | ||||
| @ -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; | ||||
| 
 | ||||
|  | ||||
| @ -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); | ||||
|  | ||||
| @ -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; | ||||
|  | ||||
| @ -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; | ||||
|  | ||||
| @ -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} | ||||
|  | ||||
| @ -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; | ||||
|  | ||||
| @ -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} | ||||
|  | ||||
| @ -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; | ||||
|  | ||||
| @ -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 | ||||
|  | ||||
| @ -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); | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user
	 paul
						paul