mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 07:09:29 +02:00
* Patch from Ondrej Pokorny to implement specifying encoding when saving/loading from stream
git-svn-id: trunk@34475 -
This commit is contained in:
michael
parent
de7e5d73c0
commit
8318ba30d4
@ -599,6 +599,8 @@ type
|
||||
|
||||
TStrings = class(TPersistent)
|
||||
private
|
||||
FDefaultEncoding: TEncoding;
|
||||
FEncoding: TEncoding;
|
||||
FSpecialCharsInited : boolean;
|
||||
FQuoteChar : Char;
|
||||
FDelimiter : Char;
|
||||
@ -609,10 +611,13 @@ type
|
||||
FSkipLastLineBreak : Boolean;
|
||||
FStrictDelimiter : Boolean;
|
||||
FLineBreak : String;
|
||||
FWriteBOM: Boolean;
|
||||
function GetCommaText: string;
|
||||
function GetName(Index: Integer): string;
|
||||
function GetValue(const Name: string): string;
|
||||
Function GetLBS : TTextLineBreakStyle;
|
||||
procedure SetDefaultEncoding(const ADefaultEncoding: TEncoding);
|
||||
procedure SetEncoding(const AEncoding: TEncoding);
|
||||
Procedure SetLBS (AValue : TTextLineBreakStyle);
|
||||
procedure ReadData(Reader: TReader);
|
||||
procedure SetCommaText(const Value: string);
|
||||
@ -654,6 +659,7 @@ type
|
||||
Class Function GetNextLine (Const Value : String; Var S : String; Var P : Integer) : Boolean;
|
||||
Function GetNextLinebreak (Const Value : String; Var S : String; Var P : Integer) : Boolean;
|
||||
public
|
||||
constructor Create;
|
||||
destructor Destroy; override;
|
||||
function Add(const S: string): Integer; virtual; overload;
|
||||
function AddObject(const S: string; AObject: TObject): Integer; virtual; overload;
|
||||
@ -681,17 +687,23 @@ type
|
||||
procedure Insert(Index: Integer; const S: string); virtual; abstract;
|
||||
procedure InsertObject(Index: Integer; const S: string;
|
||||
AObject: TObject);
|
||||
procedure LoadFromFile(const FileName: string); virtual;
|
||||
procedure LoadFromStream(Stream: TStream); virtual;
|
||||
procedure LoadFromFile(const FileName: string); overload; virtual;
|
||||
procedure LoadFromFile(const FileName: string; AEncoding: TEncoding); overload; virtual;
|
||||
procedure LoadFromStream(Stream: TStream); overload; virtual;
|
||||
procedure LoadFromStream(Stream: TStream; AEncoding: TEncoding); overload; virtual;
|
||||
procedure Move(CurIndex, NewIndex: Integer); virtual;
|
||||
procedure SaveToFile(const FileName: string); virtual;
|
||||
procedure SaveToStream(Stream: TStream); virtual;
|
||||
procedure SaveToFile(const FileName: string); overload; virtual;
|
||||
procedure SaveToFile(const FileName: string; AEncoding: TEncoding); overload; virtual;
|
||||
procedure SaveToStream(Stream: TStream); overload; virtual;
|
||||
procedure SaveToStream(Stream: TStream; AEncoding: TEncoding); overload; virtual;
|
||||
procedure SetText(TheText: PChar); virtual;
|
||||
procedure GetNameValue(Index : Integer; Out AName,AValue : String);
|
||||
function ExtractName(Const S:String):String;
|
||||
Property TextLineBreakStyle : TTextLineBreakStyle Read GetLBS Write SetLBS;
|
||||
property Delimiter: Char read GetDelimiter write SetDelimiter;
|
||||
property DelimitedText: string read GetDelimitedText write SetDelimitedText;
|
||||
property DefaultEncoding: TEncoding read FDefaultEncoding write SetDefaultEncoding;
|
||||
property Encoding: TEncoding read FEncoding;
|
||||
property LineBreak : string Read GetLineBreak write SetLineBreak;
|
||||
Property StrictDelimiter : Boolean Read FStrictDelimiter Write FStrictDelimiter;
|
||||
property QuoteChar: Char read GetQuoteChar write SetQuoteChar;
|
||||
@ -707,6 +719,7 @@ type
|
||||
property Text: string read GetTextStr write SetTextStr;
|
||||
property StringsAdapter: IStringsAdapter read FAdapter write SetStringsAdapter;
|
||||
Property SkipLastLineBreak : Boolean Read GetSkipLastLineBreak Write SetSkipLastLineBreak;
|
||||
property WriteBOM: Boolean read FWriteBOM write FWriteBOM;
|
||||
end;
|
||||
|
||||
{ TStringList class }
|
||||
|
||||
@ -112,6 +112,19 @@ begin
|
||||
FDelimiter:=c;
|
||||
end;
|
||||
|
||||
Procedure TStrings.SetEncoding(const AEncoding: TEncoding);
|
||||
begin
|
||||
if (FEncoding<>nil) and not TEncoding.IsStandardEncoding(FEncoding) then
|
||||
FEncoding.Free;
|
||||
|
||||
if TEncoding.IsStandardEncoding(AEncoding) then
|
||||
FEncoding:=AEncoding
|
||||
else if AEncoding<>nil then
|
||||
FEncoding:=AEncoding.Clone
|
||||
else
|
||||
FEncoding:=nil;
|
||||
end;
|
||||
|
||||
Function TStrings.GetDelimiter : Char;
|
||||
begin
|
||||
CheckSpecialChars;
|
||||
@ -434,6 +447,21 @@ end;
|
||||
|
||||
|
||||
|
||||
Procedure TStrings.SetDefaultEncoding(const ADefaultEncoding: TEncoding);
|
||||
begin
|
||||
if (FDefaultEncoding<>nil) and not TEncoding.IsStandardEncoding(FDefaultEncoding) then
|
||||
FDefaultEncoding.Free;
|
||||
|
||||
if TEncoding.IsStandardEncoding(ADefaultEncoding) then
|
||||
FDefaultEncoding:=ADefaultEncoding
|
||||
else if ADefaultEncoding<>nil then
|
||||
FDefaultEncoding:=ADefaultEncoding.Clone
|
||||
else
|
||||
FDefaultEncoding:=TEncoding.Default;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Procedure TStrings.SetValue(const Name, Value: string);
|
||||
|
||||
Var L : longint;
|
||||
@ -679,10 +707,22 @@ end;
|
||||
destructor TSTrings.Destroy;
|
||||
|
||||
begin
|
||||
if (FEncoding<>nil) and not TEncoding.IsStandardEncoding(FEncoding) then
|
||||
FreeAndNil(FEncoding);
|
||||
if (FDefaultEncoding<>nil) and not TEncoding.IsStandardEncoding(FDefaultEncoding) then
|
||||
FreeAndNil(FDefaultEncoding);
|
||||
|
||||
inherited destroy;
|
||||
end;
|
||||
|
||||
|
||||
constructor TStrings.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FDefaultEncoding:=TEncoding.Default;
|
||||
FEncoding:=nil;
|
||||
FWriteBOM:=True;
|
||||
end;
|
||||
|
||||
Function TStrings.Add(const S: string): Integer;
|
||||
|
||||
@ -784,6 +824,9 @@ begin
|
||||
FNameValueSeparator:=S.FNameValueSeparator;
|
||||
FLBS:=S.FLBS;
|
||||
FLineBreak:=S.FLineBreak;
|
||||
FWriteBOM:=S.FWriteBOM;
|
||||
DefaultEncoding:=S.DefaultEncoding;
|
||||
SetEncoding(S.Encoding);
|
||||
AddStrings(S);
|
||||
finally
|
||||
EndUpdate;
|
||||
@ -939,6 +982,20 @@ end;
|
||||
|
||||
|
||||
|
||||
Procedure TStrings.LoadFromFile(const FileName: string; AEncoding: TEncoding);
|
||||
Var
|
||||
TheStream : TFileStream;
|
||||
begin
|
||||
TheStream:=TFileStream.Create(FileName,fmOpenRead or fmShareDenyWrite);
|
||||
try
|
||||
LoadFromStream(TheStream,AEncoding);
|
||||
finally
|
||||
TheStream.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Procedure TStrings.LoadFromStream(Stream: TStream);
|
||||
{
|
||||
Borlands method is no good, since a pipe for
|
||||
@ -978,6 +1035,50 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Procedure TStrings.LoadFromStream(Stream: TStream; AEncoding: TEncoding);
|
||||
{
|
||||
Borlands method is no good, since a pipe for
|
||||
instance doesn't have a size.
|
||||
So we must do it the hard way.
|
||||
}
|
||||
Const
|
||||
BufSize = 1024;
|
||||
MaxGrow = 1 shl 29;
|
||||
|
||||
Var
|
||||
Buffer : TBytes;
|
||||
T : string;
|
||||
BytesRead,
|
||||
BufLen,
|
||||
I,BufDelta,
|
||||
PreambleLength : Longint;
|
||||
begin
|
||||
// reread into a buffer
|
||||
beginupdate;
|
||||
try
|
||||
SetLength(Buffer,0);
|
||||
BufLen:=0;
|
||||
I:=1;
|
||||
Repeat
|
||||
BufDelta:=BufSize*I;
|
||||
SetLength(Buffer,BufLen+BufDelta);
|
||||
BytesRead:=Stream.Read(Buffer[BufLen],BufDelta);
|
||||
inc(BufLen,BufDelta);
|
||||
If I<MaxGrow then
|
||||
I:=I shl 1;
|
||||
Until BytesRead<>BufDelta;
|
||||
SetLength(Buffer,BufLen-BufDelta+BytesRead);
|
||||
PreambleLength:=TEncoding.GetBufferEncoding(Buffer,AEncoding,FDefaultEncoding);
|
||||
T:=AEncoding.GetAnsiString(Buffer,PreambleLength,Length(Buffer)-PreambleLength);
|
||||
SetEncoding(AEncoding);
|
||||
SetLength(Buffer,0);
|
||||
SetTextStr(T);
|
||||
finally
|
||||
EndUpdate;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Procedure TStrings.Move(CurIndex, NewIndex: Integer);
|
||||
Var
|
||||
Obj : TObject;
|
||||
@ -1012,13 +1113,54 @@ end;
|
||||
|
||||
|
||||
|
||||
Procedure TStrings.SaveToFile(const FileName: string; AEncoding: TEncoding);
|
||||
|
||||
Var TheStream : TFileStream;
|
||||
|
||||
begin
|
||||
TheStream:=TFileStream.Create(FileName,fmCreate);
|
||||
try
|
||||
SaveToStream(TheStream,AEncoding);
|
||||
finally
|
||||
TheStream.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Procedure TStrings.SaveToStream(Stream: TStream);
|
||||
Var
|
||||
S : String;
|
||||
begin
|
||||
S:=Text;
|
||||
if S = '' then Exit;
|
||||
Stream.WriteBuffer(Pointer(S)^,Length(S));
|
||||
if Encoding<>nil then
|
||||
SaveToStream(Stream,Encoding)
|
||||
else
|
||||
begin
|
||||
S:=Text;
|
||||
if S = '' then Exit;
|
||||
Stream.WriteBuffer(Pointer(S)^,Length(S));
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
Procedure TStrings.SaveToStream(Stream: TStream; AEncoding: TEncoding);
|
||||
|
||||
Var B : TBytes;
|
||||
|
||||
begin
|
||||
if AEncoding=nil then
|
||||
AEncoding:=FDefaultEncoding;
|
||||
if FWriteBOM then
|
||||
begin
|
||||
B:=AEncoding.GetPreamble;
|
||||
if Length(B)>0 then
|
||||
Stream.WriteBuffer(B[0],Length(B));
|
||||
end;
|
||||
B:=AEncoding.GetAnsiBytes(Text);
|
||||
if Length(B)>0 then
|
||||
Stream.WriteBuffer(B[0],Length(B));
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user