From 9e9c7e1409e016a9f6a6dff4975ebaed153d2b9d Mon Sep 17 00:00:00 2001 From: ondrej Date: Thu, 30 Jan 2020 06:21:12 +0000 Subject: [PATCH] Merging revisions r43838, r43839, r43840, r43841, r43842, r43844, r43845, r43846, r43848, r43942, r43945, r43946, r43947, r43948 from trunk (TStrings&TEncoding encoding fixes) r43838 classes: fix TMBCSEncoding.IsSingleByte. Issue #36504 --------------------- r43839 classes: fix TStrings.SaveToStream overloads (Delphi-compatibility + introduce IgnoreEncoding-overload for legacy FPC code like for LoadFromStream) --------------------- r43840 sysutils: fix TMBCSEncoding.GetPreamble --------------------- r43841 classes: add TStrings.Options (Delphi-compatibility) --------------------- r43842 sysutils: change TEncoding.Default from ANSI to SystemEncoding. (It is Delphi-compatible indeed because default SystemEncoding is ANSI.) --------------------- r43844 fpmkunit: fix compilation after r43841 --------------------- r43845 classes: introduce TRawByteStringStream --------------------- r43846 sysutils: TEncoding.IsStandardEncoding: FSystemEncodings are standard encodings (they must not be destroyed in user code) --------------------- r43848 classes: add TStringsOption.soPreserveBOM --------------------- r43942 TStrings: old SaveToFile(string) and SaveToStream(TStream) should ignore Encoding and stay backwards compatible within FPC. Use the other overloads for Encoding-aware SaveTo* methods --------------------- r43945 TStrings: add missing SaveToFile overload with IgnoreEncoding parameter --------------------- r43946 Revert r43942: TStrings: old SaveToFile(string) and SaveToStream(TStream) should ignore Encoding and stay backwards compatible within FPC. Use the other overloads for Encoding-aware SaveTo* methods --------------------- r43947 TStrings: default options: * remove soWriteBOM for FPC backwards compatibility * add soPreserveBOM so that a loaded file is correctly resaved --------------------- r43948 TStrings.SaveToStream(TStream): use FEncoding as the default for IgnoreEncoding=False so that loaded files are correctly resaved --------------------- git-svn-id: branches/fixes_3_2@44067 - --- packages/fcl-web/src/base/fphttpclient.pp | 62 ++----- packages/fpmkunit/src/fpmkunit.pp | 2 +- rtl/objpas/classes/classesh.inc | 34 +++- rtl/objpas/classes/streams.inc | 45 +++++ rtl/objpas/classes/stringl.inc | 196 +++++++++++++++++----- rtl/objpas/sysutils/sysencoding.inc | 37 +++- 6 files changed, 277 insertions(+), 99 deletions(-) diff --git a/packages/fcl-web/src/base/fphttpclient.pp b/packages/fcl-web/src/base/fphttpclient.pp index 1f66604913..e735d3ea3b 100644 --- a/packages/fcl-web/src/base/fphttpclient.pp +++ b/packages/fcl-web/src/base/fphttpclient.pp @@ -461,34 +461,6 @@ begin SetLength(Result, P-Pchar(Result)); end; -Type - - { TRawStringStream } - - TRawStringStream = Class(TMemoryStream) - public - Constructor Create (const aData : RawByteString); overload; - function DataString: RawByteString; - end; - -constructor TRawStringStream.Create(const aData: RawByteString); -begin - Inherited Create; - If Length(aData)>0 then - begin - WriteBuffer(aData[1],Length(aData)); - Position:=0; - end; -end; - -function TRawStringStream.DataString: RawByteString; -begin - Result:=''; - SetLength(Result,Size); - if Size>0 then - Move(Memory^, Result[1], Size); -end; - { TProxyData } function TProxyData.GetProxyHeaders: String; @@ -1491,10 +1463,10 @@ end; function TFPCustomHTTPClient.Get(const AURL: String): RawByteString; Var - SS : TRawStringStream; + SS : TRawByteStringStream; begin - SS:=TRawStringStream.Create; + SS:=TRawByteStringStream.Create; try Get(AURL,SS); Result:=SS.Datastring; @@ -1606,9 +1578,9 @@ end; function TFPCustomHTTPClient.Post(const URL: string): RawByteString; Var - SS : TRawStringStream; + SS : TRawByteStringStream; begin - SS:=TRawStringStream.Create(); + SS:=TRawByteStringStream.Create(); try Post(URL,SS); Result:=SS.Datastring; @@ -1699,9 +1671,9 @@ end; function TFPCustomHTTPClient.Put(const URL: string): RawByteString; Var - SS : TRawStringStream; + SS : TRawByteStringStream; begin - SS:=TRawStringStream.Create(); + SS:=TRawByteStringStream.Create(); try Put(URL,SS); Result:=SS.Datastring; @@ -1789,9 +1761,9 @@ end; function TFPCustomHTTPClient.Delete(const URL: string): RawByteString; Var - SS : TRawStringStream; + SS : TRawByteStringStream; begin - SS:=TRawStringStream.Create(); + SS:=TRawByteStringStream.Create(); try Delete(URL,SS); Result:=SS.Datastring; @@ -1879,9 +1851,9 @@ end; function TFPCustomHTTPClient.Options(const URL: string): RawByteString; Var - SS : TRawStringStream; + SS : TRawByteStringStream; begin - SS:=TRawStringStream.Create(); + SS:=TRawByteStringStream.Create(); try Options(URL,SS); Result:=SS.Datastring; @@ -1956,7 +1928,7 @@ end; procedure TFPCustomHTTPClient.FormPost(const URL : String; FormData: RawBytestring; const Response: TStream); begin - RequestBody:=TRawStringStream.Create(FormData); + RequestBody:=TRawByteStringStream.Create(FormData); try AddHeader('Content-Type','application/x-www-form-urlencoded'); Post(URL,Response); @@ -1999,9 +1971,9 @@ end; function TFPCustomHTTPClient.FormPost(const URL : String; Const FormData: RawBytestring): RawByteString; Var - SS : TRawStringStream; + SS : TRawByteStringStream; begin - SS:=TRawStringStream.Create(); + SS:=TRawByteStringStream.Create(); try FormPost(URL,FormData,SS); Result:=SS.Datastring; @@ -2012,9 +1984,9 @@ end; function TFPCustomHTTPClient.FormPost(const URL: string; FormData: TStrings): RawByteString; Var - SS : TRawStringStream; + SS : TRawByteStringStream; begin - SS:=TRawStringStream.Create(); + SS:=TRawByteStringStream.Create(); try FormPost(URL,FormData,SS); Result:=SS.Datastring; @@ -2130,13 +2102,13 @@ procedure TFPCustomHTTPClient.StreamFormPost(const AURL: string; const AStream: TStream; const Response: TStream); Var S, Sep : string; - SS : TRawStringStream; + SS : TRawByteStringStream; I: Integer; N,V: String; begin Sep:=Format('%.8x_multipart_boundary',[Random($ffffff)]); AddHeader('Content-Type','multipart/form-data; boundary='+Sep); - SS:=TRawStringStream.Create(); + SS:=TRawByteStringStream.Create(); try if (FormData<>Nil) then for I:=0 to FormData.Count -1 do diff --git a/packages/fpmkunit/src/fpmkunit.pp b/packages/fpmkunit/src/fpmkunit.pp index ece3ca3a3d..0bd65c2158 100644 --- a/packages/fpmkunit/src/fpmkunit.pp +++ b/packages/fpmkunit/src/fpmkunit.pp @@ -4842,7 +4842,7 @@ begin FRemove:=Values[KeyRemove]; FRemoveDir:=Values[KeyRemoveDir]; FRemoveTree:=Values[KeyRemoveTree]; - Options:=OptionsToStringList(Values[KeyOptions]); + Self.Options:=OptionsToStringList(Values[KeyOptions]); Line:=Values[KeyCPU]; If (Line<>'') then FCPU:=StringToCPU(Line); diff --git a/rtl/objpas/classes/classesh.inc b/rtl/objpas/classes/classesh.inc index 6b6e6767c0..c8f0beb4e3 100644 --- a/rtl/objpas/classes/classesh.inc +++ b/rtl/objpas/classes/classesh.inc @@ -609,6 +609,8 @@ type TStringsForEachMethod = procedure(const CurrentValue: string) of object; TMissingNameValueSeparatorAction = (mnvaValue,mnvaName,mnvaEmpty,mnvaError); TMissingNameValueSeparatorActions = set of TMissingNameValueSeparatorAction; + TStringsOption = (soStrictDelimiter,soWriteBOM,soTrailingLineBreak,soUseLocale,soPreserveBOM); + TStringsOptions = set of TStringsOption; TStrings = class(TPersistent) private @@ -623,15 +625,17 @@ type FUpdateCount: Integer; FAdapter: IStringsAdapter; FLBS : TTextLineBreakStyle; - FSkipLastLineBreak : Boolean; - FStrictDelimiter : Boolean; + FOptions : TStringsOptions; FLineBreak : String; - FWriteBOM: Boolean; function GetCommaText: string; + function GetLineBreakCharLBS: string; function GetMissingNameValueSeparatorAction: TMissingNameValueSeparatorAction; function GetName(Index: Integer): string; + function GetStrictDelimiter: Boolean; function GetTrailingLineBreak: Boolean; + function GetUseLocale: Boolean; function GetValue(const Name: string): string; + function GetWriteBOM: Boolean; Function GetLBS : TTextLineBreakStyle; procedure SetDefaultEncoding(const ADefaultEncoding: TEncoding); procedure SetEncoding(const AEncoding: TEncoding); @@ -640,7 +644,10 @@ type procedure SetCommaText(const Value: string); procedure SetMissingNameValueSeparatorAction(AValue: TMissingNameValueSeparatorAction); procedure SetStringsAdapter(const Value: IStringsAdapter); + procedure SetStrictDelimiter(AValue: Boolean); procedure SetTrailingLineBreak(AValue: Boolean); + procedure SetUseLocale(AValue: Boolean); + procedure SetWriteBOM(AValue: Boolean); procedure SetValue(const Name, Value: string); procedure SetDelimiter(c:Char); procedure SetQuoteChar(c:Char); @@ -656,6 +663,7 @@ type procedure SetSkipLastLineBreak(const AValue : Boolean); Procedure DoSetDelimitedText(const AValue: string; DoClear,aStrictDelimiter : Boolean; aQuoteChar,aDelimiter : Char); protected + function CompareStrings(const s1,s2 : string) : Integer; virtual; procedure DefineProperties(Filer: TFiler); override; procedure Error(const Msg: string; Data: Integer); procedure Error(const Msg: pstring; Data: Integer); @@ -740,8 +748,10 @@ type Function Reverse : TStrings; Procedure Reverse(aList : TStrings); procedure SaveToFile(const FileName: string); overload; virtual; + procedure SaveToFile(const FileName: string; IgnoreEncoding : Boolean); overload; procedure SaveToFile(const FileName: string; AEncoding: TEncoding); overload; virtual; procedure SaveToStream(Stream: TStream); overload; virtual; + procedure SaveToStream(Stream: TStream; IgnoreEncoding : Boolean); overload; procedure SaveToStream(Stream: TStream; AEncoding: TEncoding); overload; virtual; function Shift : String; Procedure Slice(fromIndex: integer; aList : TStrings); @@ -760,18 +770,20 @@ type property Names[Index: Integer]: string read GetName; Property NameValueSeparator : Char Read GetNameValueSeparator Write SetNameValueSeparator; property Objects[Index: Integer]: TObject read GetObject write PutObject; + property Options: TStringsOptions read FOptions write FOptions; property QuoteChar: Char read GetQuoteChar write SetQuoteChar; Property SkipLastLineBreak : Boolean Read GetSkipLastLineBreak Write SetSkipLastLineBreak; // Same as SkipLastLineBreak but for Delphi compatibility. Note it has opposite meaning. Property TrailingLineBreak : Boolean Read GetTrailingLineBreak Write SetTrailingLineBreak; - Property StrictDelimiter : Boolean Read FStrictDelimiter Write FStrictDelimiter; + Property StrictDelimiter : Boolean Read GetStrictDelimiter Write SetStrictDelimiter; property Strings[Index: Integer]: string read Get write Put; default; property StringsAdapter: IStringsAdapter read FAdapter write SetStringsAdapter; property Text: string read GetTextStr write SetTextStr; Property TextLineBreakStyle : TTextLineBreakStyle Read GetLBS Write SetLBS; + Property UseLocale : Boolean Read GetUseLocale Write SetUseLocale; property ValueFromIndex[Index: Integer]: string read GetValueFromIndex write SetValueFromIndex; property Values[const Name: string]: string read GetValue write SetValue; - property WriteBOM: Boolean read FWriteBOM write FWriteBOM; + property WriteBOM: Boolean read GetWriteBOM write SetWriteBOM; end; TStringsClass = Class of TStrings; @@ -831,7 +843,6 @@ type procedure InsertItem(Index: Integer; const S: string); virtual; procedure InsertItem(Index: Integer; const S: string; O: TObject); virtual; Function DoCompareText(const s1,s2 : string) : PtrInt; override; - function CompareStrings(const s1,s2 : string) : Integer; virtual; public destructor Destroy; override; @@ -1098,6 +1109,17 @@ type Property Encoding : TEncoding Read FEncoding; end; +{ TRawByteStringStream } + + TRawByteStringStream = Class(TBytesStream) + public + Constructor Create (const aData : RawByteString); overload; + function DataString: RawByteString; + + function ReadString(Count: Longint): RawByteString; + procedure WriteString(const AString: RawByteString); + end; + { TResourceStream } {$ifdef FPC_OS_UNICODE} diff --git a/rtl/objpas/classes/streams.inc b/rtl/objpas/classes/streams.inc index 0c7d0518c1..4ffe4d65db 100644 --- a/rtl/objpas/classes/streams.inc +++ b/rtl/objpas/classes/streams.inc @@ -939,6 +939,51 @@ end; +{****************************************************************************} +{* TRawByteStringStream *} +{****************************************************************************} + +constructor TRawByteStringStream.Create(const aData: RawByteString); +begin + Inherited Create; + If Length(aData)>0 then + begin + WriteBuffer(aData[1],Length(aData)); + Position:=0; + end; +end; + +function TRawByteStringStream.DataString: RawByteString; +begin + Result:=''; + SetLength(Result,Size); + if Size>0 then + Move(Memory^, Result[1], Size); +end; + +function TRawByteStringStream.ReadString(Count: Longint): RawByteString; +Var + NewLen : Longint; + +begin + NewLen:=Size-FPosition; + If NewLen>Count then NewLen:=Count; + Result:=''; + if NewLen>0 then + begin + SetLength(Result, NewLen); + Move(FBytes[FPosition],Result[1],NewLen); + end; +end; + +procedure TRawByteStringStream.WriteString(const AString: RawByteString); +begin + if Length(AString)>0 then + WriteBuffer(AString[1],Length(AString)); +end; + + + {****************************************************************************} {* TResourceStream *} {****************************************************************************} diff --git a/rtl/objpas/classes/stringl.inc b/rtl/objpas/classes/stringl.inc index 43987c5847..85ba95281b 100644 --- a/rtl/objpas/classes/stringl.inc +++ b/rtl/objpas/classes/stringl.inc @@ -83,15 +83,13 @@ end; Function TStrings.GetSkipLastLineBreak : Boolean; begin - CheckSpecialChars; - Result:=FSkipLastLineBreak; + Result:=not TrailingLineBreak; end; procedure TStrings.SetSkipLastLineBreak(const AValue : Boolean); begin - CheckSpecialChars; - FSkipLastLineBreak:=AValue; + TrailingLineBreak:=not AValue; end; Function TStrings.GetLBS : TTextLineBreakStyle; @@ -194,6 +192,19 @@ begin end; end; +function TStrings.GetLineBreakCharLBS: string; +begin + CheckSpecialChars; + if FLineBreak<>sLineBreak then + Result:=FLineBreak + else + Case FLBS of + tlbsLF : Result:=#10; + tlbsCRLF : Result:=#13#10; + tlbsCR : Result:=#13; + end; +end; + function TStrings.GetMissingNameValueSeparatorAction: TMissingNameValueSeparatorAction; begin CheckSpecialChars; @@ -446,9 +457,24 @@ begin GetNameValue(Index,Result,V); end; +function TStrings.GetStrictDelimiter: Boolean; +begin + Result:=soStrictDelimiter in FOptions; +end; + function TStrings.GetTrailingLineBreak: Boolean; begin - Result:=Not SkipLastLineBreak; + Result:=soTrailingLineBreak in FOptions; +end; + +function TStrings.GetUseLocale: Boolean; +begin + Result:=soUseLocale in FOptions; +end; + +function TStrings.GetWriteBOM: Boolean; +begin + Result:=soWriteBOM in FOptions; end; Function TStrings.GetValue(const Name: string): string; @@ -506,7 +532,7 @@ Procedure TStrings.SetDelimitedText(const AValue: string); begin CheckSpecialChars; - DoSetDelimitedText(aValue,True,FStrictDelimiter,FQuoteChar,FDelimiter); + DoSetDelimitedText(aValue,True,StrictDelimiter,FQuoteChar,FDelimiter); end; Procedure TStrings.DoSetDelimitedText(const AValue: string; DoClear,aStrictDelimiter : Boolean; aQuoteChar,aDelimiter : Char); @@ -639,9 +665,36 @@ Procedure TStrings.SetStringsAdapter(const Value: IStringsAdapter); begin end; +procedure TStrings.SetStrictDelimiter(AValue: Boolean); +begin + if AValue then + Include(FOptions,soStrictDelimiter) + else + Exclude(FOptions,soStrictDelimiter); +end; + procedure TStrings.SetTrailingLineBreak(AValue: Boolean); begin - SkipLastLineBreak:=Not aValue; + if AValue then + Include(FOptions,soTrailingLineBreak) + else + Exclude(FOptions,soTrailingLineBreak); +end; + +procedure TStrings.SetUseLocale(AValue: Boolean); +begin + if AValue then + Include(FOptions,soUseLocale) + else + Exclude(FOptions,soUseLocale); +end; + +procedure TStrings.SetWriteBOM(AValue: Boolean); +begin + if AValue then + Include(FOptions,soWriteBOM) + else + Exclude(FOptions,soWriteBOM); end; @@ -688,6 +741,13 @@ end; +function TStrings.CompareStrings(const s1,s2 : string) : Integer; +begin + Result := DoCompareText(s1, s2); +end; + + + procedure TStrings.DefineProperties(Filer: TFiler); var HasData: Boolean; @@ -739,16 +799,8 @@ Var P : Pchar; S,NL : String; begin - CheckSpecialChars; + NL:=GetLineBreakCharLBS; // Determine needed place - if FLineBreak<>sLineBreak then - NL:=FLineBreak - else - Case FLBS of - tlbsLF : NL:=#10; - tlbsCRLF : NL:=#13#10; - tlbsCR : NL:=#13; - end; L:=0; NLS:=Length(NL); For I:=0 to count-1 do @@ -946,7 +998,7 @@ end; procedure TStrings.AddDelimitedText(const S: String); begin CheckSpecialChars; - DoSetDelimitedText(S,False,FStrictDelimiter,FQuoteChar,FDelimiter); + DoSetDelimitedText(S,False,StrictDelimiter,FQuoteChar,FDelimiter); end; Procedure TStrings.SetUpdateState(Updating: Boolean); @@ -972,7 +1024,7 @@ begin inherited Create; FDefaultEncoding:=TEncoding.Default; FEncoding:=nil; - FWriteBOM:=True; + FOptions := [soTrailingLineBreak,soUseLocale,soPreserveBOM]; FAlwaysQuote:=False; end; @@ -1086,7 +1138,7 @@ begin FNameValueSeparator:=S.FNameValueSeparator; FLBS:=S.FLBS; FLineBreak:=S.FLineBreak; - FWriteBOM:=S.FWriteBOM; + FOptions:=S.FOptions; DefaultEncoding:=S.DefaultEncoding; SetEncoding(S.Encoding); AddStrings(S); @@ -1181,7 +1233,10 @@ end; Function TStrings.DoCompareText(const s1,s2 : string) : PtrInt; begin - result:=CompareText(s1,s2); + if UseLocale then + result:=AnsiCompareText(s1,s2) + else + result:=CompareText(s1,s2); end; @@ -1342,6 +1397,8 @@ begin finally EndUpdate; end; + if soPreserveBOM in FOptions then + WriteBOM:=False; end; @@ -1376,6 +1433,8 @@ begin SetLength(Buffer,BufLen-BufDelta+BytesRead); PreambleLength:=TEncoding.GetBufferEncoding(Buffer,AEncoding,FDefaultEncoding); T:=AEncoding.GetAnsiString(Buffer,PreambleLength,Length(Buffer)-PreambleLength); + if soPreserveBOM in FOptions then + WriteBOM:=PreambleLength>0; SetEncoding(AEncoding); SetLength(Buffer,0); SetTextStr(T); @@ -1443,6 +1502,21 @@ end; +Procedure TStrings.SaveToFile(const FileName: string; IgnoreEncoding : Boolean); + +Var TheStream : TFileStream; + +begin + TheStream:=TFileStream.Create(FileName,fmCreate); + try + SaveToStream(TheStream, IgnoreEncoding); + finally + TheStream.Free; + end; +end; + + + Procedure TStrings.SaveToFile(const FileName: string; AEncoding: TEncoding); Var TheStream : TFileStream; @@ -1459,17 +1533,34 @@ end; Procedure TStrings.SaveToStream(Stream: TStream); -Var - S : String; begin - if Encoding<>nil then - SaveToStream(Stream,Encoding) - else - begin - S:=Text; - if S = '' then Exit; - Stream.WriteBuffer(Pointer(S)^,Length(S)); - end; + SaveToStream(Stream,False) +end; + + + +Procedure TStrings.SaveToStream(Stream: TStream; IgnoreEncoding: Boolean); +Var + I,L,NLS : SizeInt; + S,NL : String; + +begin + if not IgnoreEncoding then + begin + SaveToStream(Stream,FEncoding); + Exit; + end; + NL:=GetLineBreakCharLBS; + NLS:=Length(NL)*SizeOf(Char); + For i:=0 To count-1 do + begin + S:=Strings[I]; + L:=Length(S); + if L<>0 then + Stream.WriteBuffer(S[1], L*SizeOf(Char)); + if (I0 then Stream.WriteBuffer(B[0],Length(B)); end; - B:=AEncoding.GetAnsiBytes(Text); - if Length(B)>0 then - Stream.WriteBuffer(B[0],Length(B)); + + NL := GetLineBreakCharLBS; + BNL:=AEncoding.GetAnsiBytes(NL); + BNLS:=Length(BNL); + For i:=0 To count-1 do + begin + S:=Strings[I]; + if S<>'' then + begin + B:=AEncoding.GetAnsiBytes(S); + Stream.WriteBuffer(B[0],Length(B)); + end; + if (I