mirror of
https://github.com/HeidiSQL/HeidiSQL.git
synced 2025-08-26 11:17:57 +08:00
832 lines
23 KiB
ObjectPascal
832 lines
23 KiB
ObjectPascal
|
|
{*****************************************************************************}
|
|
{ }
|
|
{ Tnt Delphi Unicode Controls }
|
|
{ http://www.tntware.com/delphicontrols/unicode/ }
|
|
{ Version: 2.3.0 }
|
|
{ }
|
|
{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
|
|
{ }
|
|
{*****************************************************************************}
|
|
|
|
unit TntWideStrings;
|
|
|
|
{$INCLUDE compilers.inc}
|
|
|
|
interface
|
|
|
|
{$IFDEF COMPILER_10_UP}
|
|
{$MESSAGE FATAL 'Do not refer to TntWideStrings.pas. It works correctly in Delphi 2006.'}
|
|
{$ENDIF}
|
|
|
|
uses
|
|
Classes;
|
|
|
|
{******************************************************************************}
|
|
{ }
|
|
{ Delphi 2005 introduced TWideStrings in WideStrings.pas. }
|
|
{ Unfortunately, it was not ready for prime time. }
|
|
{ Setting CommaText is not consistent, and it relies on CharNextW }
|
|
{ Which is only available on Windows NT+. }
|
|
{ }
|
|
{******************************************************************************}
|
|
|
|
type
|
|
TWideStrings = class;
|
|
|
|
{ IWideStringsAdapter interface }
|
|
{ Maintains link between TWideStrings and IWideStrings implementations }
|
|
|
|
IWideStringsAdapter = interface
|
|
['{25FE0E3B-66CB-48AA-B23B-BCFA67E8F5DA}']
|
|
procedure ReferenceStrings(S: TWideStrings);
|
|
procedure ReleaseStrings;
|
|
end;
|
|
|
|
TWideStringsEnumerator = class
|
|
private
|
|
FIndex: Integer;
|
|
FStrings: TWideStrings;
|
|
public
|
|
constructor Create(AStrings: TWideStrings);
|
|
function GetCurrent: WideString;
|
|
function MoveNext: Boolean;
|
|
property Current: WideString read GetCurrent;
|
|
end;
|
|
|
|
{ TWideStrings class }
|
|
|
|
TWideStrings = class(TPersistent)
|
|
private
|
|
FDefined: TStringsDefined;
|
|
FDelimiter: WideChar;
|
|
FQuoteChar: WideChar;
|
|
{$IFDEF COMPILER_7_UP}
|
|
FNameValueSeparator: WideChar;
|
|
{$ENDIF}
|
|
FUpdateCount: Integer;
|
|
FAdapter: IWideStringsAdapter;
|
|
function GetCommaText: WideString;
|
|
function GetDelimitedText: WideString;
|
|
function GetName(Index: Integer): WideString;
|
|
function GetValue(const Name: WideString): WideString;
|
|
procedure ReadData(Reader: TReader);
|
|
procedure SetCommaText(const Value: WideString);
|
|
procedure SetDelimitedText(const Value: WideString);
|
|
procedure SetStringsAdapter(const Value: IWideStringsAdapter);
|
|
procedure SetValue(const Name, Value: WideString);
|
|
procedure WriteData(Writer: TWriter);
|
|
function GetDelimiter: WideChar;
|
|
procedure SetDelimiter(const Value: WideChar);
|
|
function GetQuoteChar: WideChar;
|
|
procedure SetQuoteChar(const Value: WideChar);
|
|
function GetNameValueSeparator: WideChar;
|
|
{$IFDEF COMPILER_7_UP}
|
|
procedure SetNameValueSeparator(const Value: WideChar);
|
|
{$ENDIF}
|
|
function GetValueFromIndex(Index: Integer): WideString;
|
|
procedure SetValueFromIndex(Index: Integer; const Value: WideString);
|
|
protected
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
procedure Error(const Msg: WideString; Data: Integer); overload;
|
|
procedure Error(Msg: PResStringRec; Data: Integer); overload;
|
|
function ExtractName(const S: WideString): WideString;
|
|
function Get(Index: Integer): WideString; virtual; abstract;
|
|
function GetCapacity: Integer; virtual;
|
|
function GetCount: Integer; virtual; abstract;
|
|
function GetObject(Index: Integer): TObject; virtual;
|
|
function GetTextStr: WideString; virtual;
|
|
procedure Put(Index: Integer; const S: WideString); virtual;
|
|
procedure PutObject(Index: Integer; AObject: TObject); virtual;
|
|
procedure SetCapacity(NewCapacity: Integer); virtual;
|
|
procedure SetTextStr(const Value: WideString); virtual;
|
|
procedure SetUpdateState(Updating: Boolean); virtual;
|
|
property UpdateCount: Integer read FUpdateCount;
|
|
function CompareStrings(const S1, S2: WideString): Integer; virtual;
|
|
public
|
|
destructor Destroy; override;
|
|
function Add(const S: WideString): Integer; virtual;
|
|
function AddObject(const S: WideString; AObject: TObject): Integer; virtual;
|
|
procedure Append(const S: WideString);
|
|
procedure AddStrings(Strings: TStrings{TNT-ALLOW TStrings}); overload; virtual;
|
|
procedure AddStrings(Strings: TWideStrings); overload; virtual;
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure BeginUpdate;
|
|
procedure Clear; virtual; abstract;
|
|
procedure Delete(Index: Integer); virtual; abstract;
|
|
procedure EndUpdate;
|
|
function Equals(Strings: TWideStrings): Boolean;
|
|
procedure Exchange(Index1, Index2: Integer); virtual;
|
|
function GetEnumerator: TWideStringsEnumerator;
|
|
function GetTextW: PWideChar; virtual;
|
|
function IndexOf(const S: WideString): Integer; virtual;
|
|
function IndexOfName(const Name: WideString): Integer; virtual;
|
|
function IndexOfObject(AObject: TObject): Integer; virtual;
|
|
procedure Insert(Index: Integer; const S: WideString); virtual; abstract;
|
|
procedure InsertObject(Index: Integer; const S: WideString;
|
|
AObject: TObject); virtual;
|
|
procedure LoadFromFile(const FileName: WideString); virtual;
|
|
procedure LoadFromStream(Stream: TStream); virtual;
|
|
procedure Move(CurIndex, NewIndex: Integer); virtual;
|
|
procedure SaveToFile(const FileName: WideString); virtual;
|
|
procedure SaveToStream(Stream: TStream); virtual;
|
|
procedure SetTextW(const Text: PWideChar); virtual;
|
|
property Capacity: Integer read GetCapacity write SetCapacity;
|
|
property CommaText: WideString read GetCommaText write SetCommaText;
|
|
property Count: Integer read GetCount;
|
|
property Delimiter: WideChar read GetDelimiter write SetDelimiter;
|
|
property DelimitedText: WideString read GetDelimitedText write SetDelimitedText;
|
|
property Names[Index: Integer]: WideString read GetName;
|
|
property Objects[Index: Integer]: TObject read GetObject write PutObject;
|
|
property QuoteChar: WideChar read GetQuoteChar write SetQuoteChar;
|
|
property Values[const Name: WideString]: WideString read GetValue write SetValue;
|
|
property ValueFromIndex[Index: Integer]: WideString read GetValueFromIndex write SetValueFromIndex;
|
|
property NameValueSeparator: WideChar read GetNameValueSeparator {$IFDEF COMPILER_7_UP} write SetNameValueSeparator {$ENDIF};
|
|
property Strings[Index: Integer]: WideString read Get write Put; default;
|
|
property Text: WideString read GetTextStr write SetTextStr;
|
|
property StringsAdapter: IWideStringsAdapter read FAdapter write SetStringsAdapter;
|
|
end;
|
|
|
|
PWideStringItem = ^TWideStringItem;
|
|
TWideStringItem = record
|
|
FString: WideString;
|
|
FObject: TObject;
|
|
end;
|
|
|
|
PWideStringItemList = ^TWideStringItemList;
|
|
TWideStringItemList = array[0..MaxListSize] of TWideStringItem;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Windows, SysUtils, TntSystem, {$IFDEF COMPILER_9_UP} WideStrUtils, {$ELSE} TntWideStrUtils, {$ENDIF}
|
|
TntSysUtils, TntClasses;
|
|
|
|
{ TWideStringsEnumerator }
|
|
|
|
constructor TWideStringsEnumerator.Create(AStrings: TWideStrings);
|
|
begin
|
|
inherited Create;
|
|
FIndex := -1;
|
|
FStrings := AStrings;
|
|
end;
|
|
|
|
function TWideStringsEnumerator.GetCurrent: WideString;
|
|
begin
|
|
Result := FStrings[FIndex];
|
|
end;
|
|
|
|
function TWideStringsEnumerator.MoveNext: Boolean;
|
|
begin
|
|
Result := FIndex < FStrings.Count - 1;
|
|
if Result then
|
|
Inc(FIndex);
|
|
end;
|
|
|
|
{ TWideStrings }
|
|
|
|
destructor TWideStrings.Destroy;
|
|
begin
|
|
StringsAdapter := nil;
|
|
inherited;
|
|
end;
|
|
|
|
function TWideStrings.Add(const S: WideString): Integer;
|
|
begin
|
|
Result := GetCount;
|
|
Insert(Result, S);
|
|
end;
|
|
|
|
function TWideStrings.AddObject(const S: WideString; AObject: TObject): Integer;
|
|
begin
|
|
Result := Add(S);
|
|
PutObject(Result, AObject);
|
|
end;
|
|
|
|
procedure TWideStrings.Append(const S: WideString);
|
|
begin
|
|
Add(S);
|
|
end;
|
|
|
|
procedure TWideStrings.AddStrings(Strings: TStrings{TNT-ALLOW TStrings});
|
|
var
|
|
I: Integer;
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
for I := 0 to Strings.Count - 1 do
|
|
AddObject(Strings[I], Strings.Objects[I]);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStrings.AddStrings(Strings: TWideStrings);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
for I := 0 to Strings.Count - 1 do
|
|
AddObject(Strings[I], Strings.Objects[I]);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStrings.Assign(Source: TPersistent);
|
|
begin
|
|
if Source is TWideStrings then
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
FDefined := TWideStrings(Source).FDefined;
|
|
{$IFDEF COMPILER_7_UP}
|
|
FNameValueSeparator := TWideStrings(Source).FNameValueSeparator;
|
|
{$ENDIF}
|
|
FQuoteChar := TWideStrings(Source).FQuoteChar;
|
|
FDelimiter := TWideStrings(Source).FDelimiter;
|
|
AddStrings(TWideStrings(Source));
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end
|
|
else if Source is TStrings{TNT-ALLOW TStrings} then
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
{$IFDEF COMPILER_7_UP}
|
|
FNameValueSeparator := WideChar(TStrings{TNT-ALLOW TStrings}(Source).NameValueSeparator);
|
|
{$ENDIF}
|
|
FQuoteChar := WideChar(TStrings{TNT-ALLOW TStrings}(Source).QuoteChar);
|
|
FDelimiter := WideChar(TStrings{TNT-ALLOW TStrings}(Source).Delimiter);
|
|
AddStrings(TStrings{TNT-ALLOW TStrings}(Source));
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TWideStrings.AssignTo(Dest: TPersistent);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Dest is TWideStrings then Dest.Assign(Self)
|
|
else if Dest is TStrings{TNT-ALLOW TStrings} then
|
|
begin
|
|
TStrings{TNT-ALLOW TStrings}(Dest).BeginUpdate;
|
|
try
|
|
TStrings{TNT-ALLOW TStrings}(Dest).Clear;
|
|
{$IFDEF COMPILER_7_UP}
|
|
TStrings{TNT-ALLOW TStrings}(Dest).NameValueSeparator := AnsiChar(NameValueSeparator);
|
|
{$ENDIF}
|
|
TStrings{TNT-ALLOW TStrings}(Dest).QuoteChar := AnsiChar(QuoteChar);
|
|
TStrings{TNT-ALLOW TStrings}(Dest).Delimiter := AnsiChar(Delimiter);
|
|
for I := 0 to Count - 1 do
|
|
TStrings{TNT-ALLOW TStrings}(Dest).AddObject(Strings[I], Objects[I]);
|
|
finally
|
|
TStrings{TNT-ALLOW TStrings}(Dest).EndUpdate;
|
|
end;
|
|
end
|
|
else
|
|
inherited AssignTo(Dest);
|
|
end;
|
|
|
|
procedure TWideStrings.BeginUpdate;
|
|
begin
|
|
if FUpdateCount = 0 then SetUpdateState(True);
|
|
Inc(FUpdateCount);
|
|
end;
|
|
|
|
procedure TWideStrings.DefineProperties(Filer: TFiler);
|
|
|
|
function DoWrite: Boolean;
|
|
begin
|
|
if Filer.Ancestor <> nil then
|
|
begin
|
|
Result := True;
|
|
if Filer.Ancestor is TWideStrings then
|
|
Result := not Equals(TWideStrings(Filer.Ancestor))
|
|
end
|
|
else Result := Count > 0;
|
|
end;
|
|
|
|
begin
|
|
Filer.DefineProperty('Strings', ReadData, WriteData, DoWrite);
|
|
end;
|
|
|
|
procedure TWideStrings.EndUpdate;
|
|
begin
|
|
Dec(FUpdateCount);
|
|
if FUpdateCount = 0 then SetUpdateState(False);
|
|
end;
|
|
|
|
function TWideStrings.Equals(Strings: TWideStrings): Boolean;
|
|
var
|
|
I, Count: Integer;
|
|
begin
|
|
Result := False;
|
|
Count := GetCount;
|
|
if Count <> Strings.GetCount then Exit;
|
|
for I := 0 to Count - 1 do if Get(I) <> Strings.Get(I) then Exit;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TWideStrings.Error(const Msg: WideString; Data: Integer);
|
|
|
|
function ReturnAddr: Pointer;
|
|
asm
|
|
MOV EAX,[EBP+4]
|
|
end;
|
|
|
|
begin
|
|
raise EStringListError.CreateFmt(Msg, [Data]) at ReturnAddr;
|
|
end;
|
|
|
|
procedure TWideStrings.Error(Msg: PResStringRec; Data: Integer);
|
|
begin
|
|
Error(WideLoadResString(Msg), Data);
|
|
end;
|
|
|
|
procedure TWideStrings.Exchange(Index1, Index2: Integer);
|
|
var
|
|
TempObject: TObject;
|
|
TempString: WideString;
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
TempString := Strings[Index1];
|
|
TempObject := Objects[Index1];
|
|
Strings[Index1] := Strings[Index2];
|
|
Objects[Index1] := Objects[Index2];
|
|
Strings[Index2] := TempString;
|
|
Objects[Index2] := TempObject;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TWideStrings.ExtractName(const S: WideString): WideString;
|
|
var
|
|
P: Integer;
|
|
begin
|
|
Result := S;
|
|
P := Pos(NameValueSeparator, Result);
|
|
if P <> 0 then
|
|
SetLength(Result, P-1) else
|
|
SetLength(Result, 0);
|
|
end;
|
|
|
|
function TWideStrings.GetCapacity: Integer;
|
|
begin // descendents may optionally override/replace this default implementation
|
|
Result := Count;
|
|
end;
|
|
|
|
function TWideStrings.GetCommaText: WideString;
|
|
var
|
|
LOldDefined: TStringsDefined;
|
|
LOldDelimiter: WideChar;
|
|
LOldQuoteChar: WideChar;
|
|
begin
|
|
LOldDefined := FDefined;
|
|
LOldDelimiter := FDelimiter;
|
|
LOldQuoteChar := FQuoteChar;
|
|
Delimiter := ',';
|
|
QuoteChar := '"';
|
|
try
|
|
Result := GetDelimitedText;
|
|
finally
|
|
FDelimiter := LOldDelimiter;
|
|
FQuoteChar := LOldQuoteChar;
|
|
FDefined := LOldDefined;
|
|
end;
|
|
end;
|
|
|
|
function TWideStrings.GetDelimitedText: WideString;
|
|
var
|
|
S: WideString;
|
|
P: PWideChar;
|
|
I, Count: Integer;
|
|
begin
|
|
Count := GetCount;
|
|
if (Count = 1) and (Get(0) = '') then
|
|
Result := WideString(QuoteChar) + QuoteChar
|
|
else
|
|
begin
|
|
Result := '';
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
S := Get(I);
|
|
P := PWideChar(S);
|
|
while not ((P^ in [WideChar(#0)..WideChar(' ')]) or (P^ = QuoteChar) or (P^ = Delimiter)) do
|
|
Inc(P);
|
|
if (P^ <> #0) then S := WideQuotedStr(S, QuoteChar);
|
|
Result := Result + S + Delimiter;
|
|
end;
|
|
System.Delete(Result, Length(Result), 1);
|
|
end;
|
|
end;
|
|
|
|
function TWideStrings.GetName(Index: Integer): WideString;
|
|
begin
|
|
Result := ExtractName(Get(Index));
|
|
end;
|
|
|
|
function TWideStrings.GetObject(Index: Integer): TObject;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
|
|
function TWideStrings.GetEnumerator: TWideStringsEnumerator;
|
|
begin
|
|
Result := TWideStringsEnumerator.Create(Self);
|
|
end;
|
|
|
|
function TWideStrings.GetTextW: PWideChar;
|
|
begin
|
|
Result := WStrNew(PWideChar(GetTextStr));
|
|
end;
|
|
|
|
function TWideStrings.GetTextStr: WideString;
|
|
var
|
|
I, L, Size, Count: Integer;
|
|
P: PWideChar;
|
|
S, LB: WideString;
|
|
begin
|
|
Count := GetCount;
|
|
Size := 0;
|
|
LB := sLineBreak;
|
|
for I := 0 to Count - 1 do Inc(Size, Length(Get(I)) + Length(LB));
|
|
SetString(Result, nil, Size);
|
|
P := Pointer(Result);
|
|
for I := 0 to Count - 1 do
|
|
begin
|
|
S := Get(I);
|
|
L := Length(S);
|
|
if L <> 0 then
|
|
begin
|
|
System.Move(Pointer(S)^, P^, L * SizeOf(WideChar));
|
|
Inc(P, L);
|
|
end;
|
|
L := Length(LB);
|
|
if L <> 0 then
|
|
begin
|
|
System.Move(Pointer(LB)^, P^, L * SizeOf(WideChar));
|
|
Inc(P, L);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TWideStrings.GetValue(const Name: WideString): WideString;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := IndexOfName(Name);
|
|
if I >= 0 then
|
|
Result := Copy(Get(I), Length(Name) + 2, MaxInt) else
|
|
Result := '';
|
|
end;
|
|
|
|
function TWideStrings.IndexOf(const S: WideString): Integer;
|
|
begin
|
|
for Result := 0 to GetCount - 1 do
|
|
if CompareStrings(Get(Result), S) = 0 then Exit;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TWideStrings.IndexOfName(const Name: WideString): Integer;
|
|
var
|
|
P: Integer;
|
|
S: WideString;
|
|
begin
|
|
for Result := 0 to GetCount - 1 do
|
|
begin
|
|
S := Get(Result);
|
|
P := Pos(NameValueSeparator, S);
|
|
if (P <> 0) and (CompareStrings(Copy(S, 1, P - 1), Name) = 0) then Exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TWideStrings.IndexOfObject(AObject: TObject): Integer;
|
|
begin
|
|
for Result := 0 to GetCount - 1 do
|
|
if GetObject(Result) = AObject then Exit;
|
|
Result := -1;
|
|
end;
|
|
|
|
procedure TWideStrings.InsertObject(Index: Integer; const S: WideString;
|
|
AObject: TObject);
|
|
begin
|
|
Insert(Index, S);
|
|
PutObject(Index, AObject);
|
|
end;
|
|
|
|
procedure TWideStrings.LoadFromFile(const FileName: WideString);
|
|
var
|
|
Stream: TStream;
|
|
begin
|
|
Stream := TTntFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
|
|
try
|
|
LoadFromStream(Stream);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStrings.LoadFromStream(Stream: TStream);
|
|
var
|
|
Size: Integer;
|
|
S: WideString;
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Size := Stream.Size - Stream.Position;
|
|
SetString(S, nil, Size div SizeOf(WideChar));
|
|
Stream.Read(Pointer(S)^, Length(S) * SizeOf(WideChar));
|
|
SetTextStr(S);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStrings.Move(CurIndex, NewIndex: Integer);
|
|
var
|
|
TempObject: TObject;
|
|
TempString: WideString;
|
|
begin
|
|
if CurIndex <> NewIndex then
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
TempString := Get(CurIndex);
|
|
TempObject := GetObject(CurIndex);
|
|
Delete(CurIndex);
|
|
InsertObject(NewIndex, TempString, TempObject);
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStrings.Put(Index: Integer; const S: WideString);
|
|
var
|
|
TempObject: TObject;
|
|
begin
|
|
TempObject := GetObject(Index);
|
|
Delete(Index);
|
|
InsertObject(Index, S, TempObject);
|
|
end;
|
|
|
|
procedure TWideStrings.PutObject(Index: Integer; AObject: TObject);
|
|
begin
|
|
end;
|
|
|
|
procedure TWideStrings.ReadData(Reader: TReader);
|
|
begin
|
|
if Reader.NextValue in [vaString, vaLString] then
|
|
SetTextStr(Reader.ReadString) {JCL compatiblity}
|
|
else if Reader.NextValue = vaWString then
|
|
SetTextStr(Reader.ReadWideString) {JCL compatiblity}
|
|
else begin
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
Reader.ReadListBegin;
|
|
while not Reader.EndOfList do
|
|
if Reader.NextValue in [vaString, vaLString] then
|
|
Add(Reader.ReadString) {TStrings compatiblity}
|
|
else
|
|
Add(Reader.ReadWideString);
|
|
Reader.ReadListEnd;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStrings.SaveToFile(const FileName: WideString);
|
|
var
|
|
Stream: TStream;
|
|
begin
|
|
Stream := TTntFileStream.Create(FileName, fmCreate);
|
|
try
|
|
SaveToStream(Stream);
|
|
finally
|
|
Stream.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStrings.SaveToStream(Stream: TStream);
|
|
var
|
|
SW: WideString;
|
|
begin
|
|
SW := GetTextStr;
|
|
Stream.WriteBuffer(PWideChar(SW)^, Length(SW) * SizeOf(WideChar));
|
|
end;
|
|
|
|
procedure TWideStrings.SetCapacity(NewCapacity: Integer);
|
|
begin
|
|
// do nothing - descendents may optionally implement this method
|
|
end;
|
|
|
|
procedure TWideStrings.SetCommaText(const Value: WideString);
|
|
begin
|
|
Delimiter := ',';
|
|
QuoteChar := '"';
|
|
SetDelimitedText(Value);
|
|
end;
|
|
|
|
procedure TWideStrings.SetStringsAdapter(const Value: IWideStringsAdapter);
|
|
begin
|
|
if FAdapter <> nil then FAdapter.ReleaseStrings;
|
|
FAdapter := Value;
|
|
if FAdapter <> nil then FAdapter.ReferenceStrings(Self);
|
|
end;
|
|
|
|
procedure TWideStrings.SetTextW(const Text: PWideChar);
|
|
begin
|
|
SetTextStr(Text);
|
|
end;
|
|
|
|
procedure TWideStrings.SetTextStr(const Value: WideString);
|
|
var
|
|
P, Start: PWideChar;
|
|
S: WideString;
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
P := Pointer(Value);
|
|
if P <> nil then
|
|
while P^ <> #0 do
|
|
begin
|
|
Start := P;
|
|
while not (P^ in [WideChar(#0), WideChar(#10), WideChar(#13)]) and (P^ <> WideLineSeparator) do
|
|
Inc(P);
|
|
SetString(S, Start, P - Start);
|
|
Add(S);
|
|
if P^ = #13 then Inc(P);
|
|
if P^ = #10 then Inc(P);
|
|
if P^ = WideLineSeparator then Inc(P);
|
|
end;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStrings.SetUpdateState(Updating: Boolean);
|
|
begin
|
|
end;
|
|
|
|
procedure TWideStrings.SetValue(const Name, Value: WideString);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := IndexOfName(Name);
|
|
if Value <> '' then
|
|
begin
|
|
if I < 0 then I := Add('');
|
|
Put(I, Name + NameValueSeparator + Value);
|
|
end else
|
|
begin
|
|
if I >= 0 then Delete(I);
|
|
end;
|
|
end;
|
|
|
|
procedure TWideStrings.WriteData(Writer: TWriter);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Writer.WriteListBegin;
|
|
for I := 0 to Count-1 do begin
|
|
Writer.WriteWideString(Get(I));
|
|
end;
|
|
Writer.WriteListEnd;
|
|
end;
|
|
|
|
procedure TWideStrings.SetDelimitedText(const Value: WideString);
|
|
var
|
|
P, P1: PWideChar;
|
|
S: WideString;
|
|
begin
|
|
BeginUpdate;
|
|
try
|
|
Clear;
|
|
P := PWideChar(Value);
|
|
while P^ in [WideChar(#1)..WideChar(' ')] do
|
|
Inc(P);
|
|
while P^ <> #0 do
|
|
begin
|
|
if P^ = QuoteChar then
|
|
S := WideExtractQuotedStr(P, QuoteChar)
|
|
else
|
|
begin
|
|
P1 := P;
|
|
while (P^ > ' ') and (P^ <> Delimiter) do
|
|
Inc(P);
|
|
SetString(S, P1, P - P1);
|
|
end;
|
|
Add(S);
|
|
while P^ in [WideChar(#1)..WideChar(' ')] do
|
|
Inc(P);
|
|
if P^ = Delimiter then
|
|
begin
|
|
P1 := P;
|
|
Inc(P1);
|
|
if P1^ = #0 then
|
|
Add('');
|
|
repeat
|
|
Inc(P);
|
|
until not (P^ in [WideChar(#1)..WideChar(' ')]);
|
|
end;
|
|
end;
|
|
finally
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TWideStrings.GetDelimiter: WideChar;
|
|
begin
|
|
if not (sdDelimiter in FDefined) then
|
|
Delimiter := ',';
|
|
Result := FDelimiter;
|
|
end;
|
|
|
|
function TWideStrings.GetQuoteChar: WideChar;
|
|
begin
|
|
if not (sdQuoteChar in FDefined) then
|
|
QuoteChar := '"';
|
|
Result := FQuoteChar;
|
|
end;
|
|
|
|
procedure TWideStrings.SetDelimiter(const Value: WideChar);
|
|
begin
|
|
if (FDelimiter <> Value) or not (sdDelimiter in FDefined) then
|
|
begin
|
|
Include(FDefined, sdDelimiter);
|
|
FDelimiter := Value;
|
|
end
|
|
end;
|
|
|
|
procedure TWideStrings.SetQuoteChar(const Value: WideChar);
|
|
begin
|
|
if (FQuoteChar <> Value) or not (sdQuoteChar in FDefined) then
|
|
begin
|
|
Include(FDefined, sdQuoteChar);
|
|
FQuoteChar := Value;
|
|
end
|
|
end;
|
|
|
|
function TWideStrings.CompareStrings(const S1, S2: WideString): Integer;
|
|
begin
|
|
Result := WideCompareText(S1, S2);
|
|
end;
|
|
|
|
function TWideStrings.GetNameValueSeparator: WideChar;
|
|
begin
|
|
{$IFDEF COMPILER_7_UP}
|
|
if not (sdNameValueSeparator in FDefined) then
|
|
NameValueSeparator := '=';
|
|
Result := FNameValueSeparator;
|
|
{$ELSE}
|
|
Result := '=';
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF COMPILER_7_UP}
|
|
procedure TWideStrings.SetNameValueSeparator(const Value: WideChar);
|
|
begin
|
|
if (FNameValueSeparator <> Value) or not (sdNameValueSeparator in FDefined) then
|
|
begin
|
|
Include(FDefined, sdNameValueSeparator);
|
|
FNameValueSeparator := Value;
|
|
end
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TWideStrings.GetValueFromIndex(Index: Integer): WideString;
|
|
begin
|
|
if Index >= 0 then
|
|
Result := Copy(Get(Index), Length(Names[Index]) + 2, MaxInt) else
|
|
Result := '';
|
|
end;
|
|
|
|
procedure TWideStrings.SetValueFromIndex(Index: Integer; const Value: WideString);
|
|
begin
|
|
if Value <> '' then
|
|
begin
|
|
if Index < 0 then Index := Add('');
|
|
Put(Index, Names[Index] + NameValueSeparator + Value);
|
|
end
|
|
else
|
|
if Index >= 0 then Delete(Index);
|
|
end;
|
|
|
|
end.
|