|
- unit uutlMCF;
-
- { Package: Utils
- Prefix: utl - UTiLs
- Beschreibung: diese Unit enthält Klassen zum Lesen und Schreiben eines MuoConfgiFiles (kurz MCF)
-
- Lesen/Schreiben in/von Stream über TutlMCFFile
- LineEndMode zur Kompatibilität mit MCF-alt und KCF:
- leNone - Kein Semikolon erlaubt (KCF)
- leAcceptNoWrite - Semikolon wird beim Lesen ignoriert, beim Schreiben weggelassen
- leAlways - Beim Lesen erforderlich, immer geschrieben (MCF-alt)
-
- Jeder SectionName und jeder ValueName ist Unique, es kann aber ein Value und eine
- Section mit dem gleichen Namen existieren
-
- Zugriff auf Subsections über .Section(), mehrere Stufen auf einmal mit . getrennt:
- mcf.Section('foo.bar.baz') === mcf.Section('foo').Section('bar').Section('baz')
- Zugriff erstellt automatisch eine Section, falls sie nicht existiert. Prüfung mit
- SectionExists (nur direkt, keine Pfade!).
-
- Zugriff auf Werte von der Section aus:
- Get/Set[Int,Float,String,Bool](Key, Default)
- ValueExists()
- UnsetValue()
- Strings sind Widestrings, Un/Escaping passiert beim Dateizugriff automatisch
-
- Enumeration: ValueCount/ValueNameAt, SectionCount/SectionNameAt }
-
- interface
-
- uses
- SysUtils, Classes, uutlStreamHelper;
-
- type
- EConfigException = class(Exception)
- end;
- TutlMCFSection = class;
- TutlMCFFile = class;
- TutlMCFLineEndMarkerMode = (leNone, leAcceptNoWrite, leAlways);
-
- { TutlMCFSection }
-
- TutlMCFSection = class
- private type
- TSectionEnumerator = class(TObject)
- private
- fList: TStringList;
- fPosition: Integer;
- function GetCurrent: TutlMCFSection;
- public
- property Current: TutlMCFSection read GetCurrent;
- function MoveNext: Boolean;
- constructor Create(const aList: TStringList);
- end;
- private
- FSections,
- FValues: TStringList;
- function GetSection(aPath: String): TutlMCFSection;
- function GetSectionCount: integer;
- function GetSectionName(Index: integer): string;
- function GetSectionByIndex(aIndex: Integer): TutlMCFSection;
- function GetValueCount: integer;
- function GetValueName(Index: integer): string;
- function GetValueAt(aIndex: integer): Variant;
- protected
- procedure ClearSections;
- procedure ClearValues;
- procedure SaveData(Stream: TStream; Indent: string; LineEnds: TutlMCFLineEndMarkerMode);
- procedure LoadData(Data: TStream; LineEnds: TutlMCFLineEndMarkerMode; Depth: Integer);
- procedure AddValueChecked(Name: String; Val: TObject);
- procedure SplitPath(const Path: String; out First, Rest: String);
- public
- constructor Create;
- destructor Destroy; override;
-
- function GetEnumerator: TSectionEnumerator;
- procedure Clear;
- procedure Assign(Source: TutlMCFSection);
-
- property ValueCount: integer read GetValueCount;
- property ValueNameAt[Index: integer]: string read GetValueName;
- property ValueAt[Index: integer]: Variant read GetValueAt;
-
- property SectionCount: integer read GetSectionCount;
- property SectionNameAt[Index: integer]: string read GetSectionName;
- property Sections[aPath: String]: TutlMCFSection read GetSection; default;
- property SectionByIndex[aIndex: Integer]: TutlMCFSection read GetSectionByIndex;
-
- function SectionExists(Path: string): boolean;
- function Section(Path: string): TutlMCFSection;
- procedure DeleteSection(Name: string);
-
- function ValueExists(Name: string): boolean;
- procedure UnsetValue(Name: string);
-
- function GetValue (Name: String; Default: Variant): Variant;
- function GetInt (Name: string; Default: Int64 = 0): Int64; overload;
- function GetFloat (Name: string; Default: Double = 0): Double; overload;
- function GetString (Name: string; Default: AnsiString = ''): AnsiString; overload;
- function GetStringW (Name: string; Default: UnicodeString = ''): UnicodeString; overload;
- function GetBool (Name: string; Default: Boolean = false): Boolean; overload;
-
- function TryGetValue (aName: String; out aValue: Variant): Boolean;
- function TryGetInt (aName: String; out aValue: Int64): Boolean;
- function TryGetFloat (aName: String; out aValue: Double): Boolean;
- function TryGetString (aName: String; out aValue: AnsiString): Boolean;
- function TryGetStringW(aName: String; out aValue: UnicodeString): Boolean;
- function TryGetBool (aName: String; out aValue: Boolean): Boolean;
-
- procedure SetInt (Name: string; Value: Int64); overload;
- procedure SetFloat (Name: string; Value: Double); overload;
- procedure SetString (Name: string; Value: WideString); overload;
- procedure SetString (Name: string; Value: AnsiString); overload;
- procedure SetBool (Name: string; Value: Boolean); overload;
- end;
-
- { TutlMCFFile }
-
- TutlMCFFile = class(TutlMCFSection)
- private
- fLineEndMode: TutlMCFLineEndMarkerMode;
- public
- constructor Create(Data: TStream; LineEndMode: TutlMCFLineEndMarkerMode = leAcceptNoWrite);
- procedure LoadFromStream(Stream: TStream);
- procedure SaveToStream(Stream: TStream);
- end;
-
- implementation
-
- uses Variants, StrUtils;
-
- const
- sComment = '#';
- sSectionEnd = 'end';
- sSectionMarker = ':';
- sSectionPathDelim = '.';
- sLineEndMarker = ';';
- sValueDelim = '=';
- sValueQuote = '''';
- sValueDecimal = '.';
- sIndentOnSave = ' ';
- sNameValidChars = [' ' .. #$7F] - [sValueDelim];
- sWhitespaceChars = [#0 .. ' '];
-
- type
- StoredValue = Variant;
-
- { TutlMCFValue }
-
- TutlMCFValue = class
- private
- Format: TFormatSettings;
- FValue: StoredValue;
- procedure SetValue(const Value: StoredValue);
- protected
- function CheckSpecialChars(Data: WideString): boolean;
- procedure LoadData(Data: string);
- function SaveData: string;
- class function Escape(Value: WideString): AnsiString;
- class function Unescape(Value: AnsiString): WideString;
- public
- constructor Create(Val: StoredValue);
- property Value: StoredValue read FValue write SetValue;
- end;
-
- { TkcfValue }
-
- constructor TutlMCFValue.Create(Val: StoredValue);
- begin
- inherited Create;
- SetValue(Val);
- Format.DecimalSeparator:= sValueDecimal;
- end;
-
- procedure TutlMCFValue.SetValue(const Value: StoredValue);
- begin
- FValue:= Value;
- end;
-
- function TutlMCFValue.CheckSpecialChars(Data: WideString): boolean;
- var
- i: Integer;
- begin
- result := false;
- for i:= 1 to Length(Data) do
- if Data[i] in [sSectionMarker, sValueQuote, sValueDelim, sLineEndMarker, ' '] then
- exit;
- result := true;
- end;
-
- procedure TutlMCFValue.LoadData(Data: string);
- var
- b: boolean;
- i: int64;
- d: double;
- p: PChar;
- begin
- if TryStrToInt64(Data, i) then
- Value:= i
- else if TryStrToFloat(Data, d, Format) then
- Value:= d
- else if TryStrToBool(Data, b) then
- Value:= b
- else begin
- p:= PChar(Data);
- if p^ = sValueQuote then
- Data := AnsiExtractQuotedStr(p, sValueQuote);
- Value:= Unescape(Trim(Data));
- end;
- end;
-
- function TutlMCFValue.SaveData: string;
- begin
- if VarIsType(FValue, varBoolean) then
- Result:= BoolToStr(FValue, false)
- else if VarIsType(FValue, varInt64) then
- Result:= IntToStr(FValue)
- else if VarIsType(FValue, varDouble) then
- Result:= FloatToStr(Double(FValue), Format)
- else begin
- Result:= AnsiQuotedStr(Escape(FValue), sValueQuote);
- end;
- end;
-
- class function TutlMCFValue.Escape(Value: WideString): AnsiString;
- var
- i: integer;
- wc: WideChar;
- begin
- Result:= '';
- for i:= 1 to length(Value) do begin
- wc:= Value[i];
- case Ord(wc) of
- Ord('\'),
- $007F..$FFFF: Result:= Result + '\'+IntToHex(ord(wc),4);
- else
- Result:= Result + AnsiChar(wc);
- end;
- end;
- end;
-
- class function TutlMCFValue.Unescape(Value: AnsiString): WideString;
- var
- i: integer;
- c: Char;
- begin
- Result:= '';
- i:= 1;
- while i <= length(value) do begin
- c:= Value[i];
- if c='\' then begin
- Result:= Result + WideChar(StrToInt('$'+Copy(Value,i+1,4)));
- inc(i, 4);
- end else
- Result:= Result + WideChar(c);
- inc(i);
- end;
- end;
-
- { TutlMCFSection.TSectionEnumerator }
-
- function TutlMCFSection.TSectionEnumerator.GetCurrent: TutlMCFSection;
- begin
- result := TutlMCFSection(fList.Objects[fPosition]);
- end;
-
- function TutlMCFSection.TSectionEnumerator.MoveNext: Boolean;
- begin
- inc(fPosition);
- result := (fPosition < fList.Count);
- end;
-
- constructor TutlMCFSection.TSectionEnumerator.Create(const aList: TStringList);
- begin
- inherited Create;
- fList := aList;
- fPosition := -1;
- end;
-
- { TkcfCompound }
-
- constructor TutlMCFSection.Create;
- begin
- inherited;
- FSections:= TStringList.Create;
- FSections.CaseSensitive:= false;
- FSections.Sorted:= true;
- FSections.Duplicates:= dupError;
- FValues:= TStringList.Create;
- FValues.CaseSensitive:= false;
- FValues.Sorted:= true;
- FValues.Duplicates:= dupError;
- end;
-
- destructor TutlMCFSection.Destroy;
- begin
- ClearSections;
- ClearValues;
- FreeAndNil(FSections);
- FreeAndNil(FValues);
- inherited;
- end;
-
- function TutlMCFSection.GetEnumerator: TSectionEnumerator;
- begin
- result := TSectionEnumerator.Create(FSections);
- end;
-
- procedure TutlMCFSection.Clear;
- begin
- ClearSections;
- ClearValues;
- end;
-
- procedure TutlMCFSection.Assign(Source: TutlMCFSection);
- var
- ms: TMemoryStream;
- begin
- Clear;
- ms:= TMemoryStream.Create;
- try
- Source.SaveData(ms, '', leNone);
- ms.Position:= 0;
- LoadData(ms, leNone, 0);
- finally
- FreeAndNil(ms);
- end;
- end;
-
-
- function TutlMCFSection.GetSectionCount: integer;
- begin
- Result:= FSections.Count;
- end;
-
- function TutlMCFSection.GetSection(aPath: String): TutlMCFSection;
- begin
- result := Section(aPath);
- end;
-
- function TutlMCFSection.GetSectionByIndex(aIndex: Integer): TutlMCFSection;
- begin
- result := (FSections.Objects[aIndex] as TutlMCFSection);
- end;
-
- function TutlMCFSection.GetSectionName(Index: integer): string;
- begin
- Result:= FSections[Index];
- end;
-
- function TutlMCFSection.GetValueCount: integer;
- begin
- Result:= FValues.Count;
- end;
-
- function TutlMCFSection.GetValueName(Index: integer): string;
- begin
- Result:= FValues[Index];
- end;
-
- function TutlMCFSection.GetValueAt(aIndex: integer): Variant;
- begin
- result := TutlMcfValue(FValues.Objects[aIndex]).Value;
- end;
-
- procedure TutlMCFSection.ClearSections;
- var
- i: integer;
- begin
- for i:= FSections.Count - 1 downto 0 do
- FSections.Objects[i].Free;
- FSections.Clear;
- end;
-
- procedure TutlMCFSection.ClearValues;
- var
- i: integer;
- begin
- for i:= FValues.Count - 1 downto 0 do
- FValues.Objects[i].Free;
- FValues.Clear;
- end;
-
- procedure TutlMCFSection.SplitPath(const Path: String; out First, Rest: String);
- begin
- First:= Copy(Path, 1, Pos(sSectionPathDelim, Path)-1);
- if First='' then begin
- First:= Path;
- Rest:= '';
- end else begin
- Rest:= Copy(Path, Length(First)+2, MaxInt);
- end;
- end;
-
- function TutlMCFSection.SectionExists(Path: string): boolean;
- var
- f,r: String;
- i: integer;
- begin
- SplitPath(Path, f, r);
- i:= FSections.IndexOf(f);
- Result:= (i >= 0) and ((r='') or (TutlMCFSection(FSections.Objects[i]).SectionExists(r)));
- end;
-
- function TutlMCFSection.Section(Path: string): TutlMCFSection;
- var
- f,r: String;
- i: integer;
- begin
- SplitPath(Path, f, r);
- i:= FSections.IndexOf(f);
- if r <> '' then begin
- if (i >= 0) then
- Result:= TutlMCFSection(FSections.Objects[i]).Section(r)
- else begin
- result := TutlMCFSection.Create;
- fSections.AddObject(f, result);
- result := result.Section(r);
- end;
- end else begin
- if i >= 0 then
- Result:= TutlMCFSection(FSections.Objects[i])
- else begin
- Result:= TutlMCFSection.Create;
- FSections.AddObject(f, Result);
- end;
- end;
- end;
-
- procedure TutlMCFSection.DeleteSection(Name: string);
- var
- i: integer;
- begin
- i:= FSections.IndexOf(Name);
- if i >= 0 then begin
- FSections.Objects[i].Free;
- FSections.Delete(i);
- end;
- end;
-
- function TutlMCFSection.ValueExists(Name: string): boolean;
- begin
- Result:= FValues.IndexOf(Name) >= 0;
- end;
-
- procedure TutlMCFSection.UnsetValue(Name: string);
- var
- i: integer;
- begin
- i:= FValues.IndexOf(Name);
- if i >= 0 then begin
- FValues.Objects[i].Free;
- FValues.Delete(i);
- end;
- end;
-
- function TutlMCFSection.GetValue(Name: String; Default: Variant): Variant;
- begin
- if not TryGetValue(Name, result) then
- result := Default;
- end;
-
- function TutlMCFSection.GetInt(Name: string; Default: Int64): Int64;
- begin
- if not TryGetInt(Name, result) then
- result := Default;
- end;
-
- function TutlMCFSection.GetFloat(Name: string; Default: Double): Double;
- begin
- if not TryGetFloat(Name, result) then
- result := Default;
- end;
-
- function TutlMCFSection.GetStringW(Name: string; Default: UnicodeString): UnicodeString;
- begin
- if not TryGetStringW(Name, result) then
- result := Default;
- end;
-
- function TutlMCFSection.GetString(Name: string; Default: AnsiString): AnsiString;
- begin
- if not TryGetString(Name, result) then
- result := Default;
- end;
-
- function TutlMCFSection.GetBool(Name: string; Default: Boolean): Boolean;
- begin
- if not TryGetBool(Name, result) then
- result := Default;
- end;
-
- function TutlMCFSection.TryGetValue(aName: String; out aValue: Variant): Boolean;
- var
- i: Integer;
- begin
- i := FValues.IndexOf(aName);
- result := (i >= 0);
- if result then
- aValue := TutlMcfValue(FValues.Objects[i]).Value;
- end;
-
- function TutlMCFSection.TryGetInt(aName: String; out aValue: Int64): Boolean;
- var
- v: Variant;
- begin
- result := TryGetValue(aName, v);
- if result then
- aValue := v;
- end;
-
- function TutlMCFSection.TryGetFloat(aName: String; out aValue: Double): Boolean;
- var
- v: Variant;
- begin
- result := TryGetValue(aName, v);
- if result then
- aValue := v;
- end;
-
- function TutlMCFSection.TryGetString(aName: String; out aValue: AnsiString): Boolean;
- var
- v: Variant;
- begin
- result := TryGetValue(aName, v);
- if result then
- aValue := v;
- end;
-
- function TutlMCFSection.TryGetStringW(aName: String; out aValue: UnicodeString): Boolean;
- var
- v: Variant;
- begin
- result := TryGetValue(aName, v);
- if result then
- aValue := v;
- end;
-
- function TutlMCFSection.TryGetBool(aName: String; out aValue: Boolean): Boolean;
- var
- v: Variant;
- begin
- result := TryGetValue(aName, v);
- if result then
- aValue := v;
- end;
-
- procedure TutlMCFSection.AddValueChecked(Name: String; Val: TObject);
- var
- i: integer;
- begin
- if (Length(Name) < 1) or
- (Name[1] in sWhitespaceChars) or
- (Name[Length(Name)] in sWhitespaceChars) then
- raise EConfigException.CreateFmt('Invalid Value Name: "%s"',[Name]);
-
- for i:= 1 to Length(Name) do
- if not (Name[i] in sNameValidChars) then
- raise EConfigException.CreateFmt('Invalid Value Name: "%s"',[Name]);
- FValues.AddObject(Name, Val);
- end;
-
- procedure TutlMCFSection.SetInt(Name: string; Value: Int64);
- var
- i: integer;
- begin
- i:= FValues.IndexOf(Name);
- if i < 0 then
- AddValueChecked(Name, TutlMCFValue.Create(Value))
- else
- TutlMCFValue(FValues.Objects[i]).Value:= Value;
- end;
-
- procedure TutlMCFSection.SetFloat(Name: string; Value: Double);
- var
- i: integer;
- begin
- i:= FValues.IndexOf(Name);
- if i < 0 then
- AddValueChecked(Name, TutlMCFValue.Create(Value))
- else
- TutlMCFValue(FValues.Objects[i]).Value:= Value;
- end;
-
- procedure TutlMCFSection.SetString(Name: string; Value: WideString);
- var
- i: integer;
- begin
- i:= FValues.IndexOf(Name);
- if i < 0 then
- AddValueChecked(Name, TutlMCFValue.Create(Value))
- else
- TutlMCFValue(FValues.Objects[i]).Value:= Value;
- end;
-
- procedure TutlMCFSection.SetString(Name: string; Value: AnsiString);
- begin
- SetString(Name, WideString(Value));
- end;
-
- procedure TutlMCFSection.SetBool(Name: string; Value: Boolean);
- var
- i: integer;
- begin
- i:= FValues.IndexOf(Name);
- if i < 0 then
- AddValueChecked(Name, TutlMCFValue.Create(Value))
- else
- TutlMCFValue(FValues.Objects[i]).Value:= Value;
- end;
-
- procedure TutlMCFSection.LoadData(Data: TStream; LineEnds: TutlMCFLineEndMarkerMode; Depth: Integer);
- var
- reader: TutlStreamReader;
- l, sn, vn, vs: string;
- se: TutlMCFSection;
- va: TutlMCFValue;
- begin
- reader:= TutlStreamReader.Create(Data, false);
- try
- repeat
- l:= reader.ReadLine;
- l:= trim(l);
- if (l = '') or AnsiStartsStr(sComment, l) then
- continue;
- if ((LineEnds in [leNone, leAcceptNoWrite]) and (l = sSectionEnd)) or
- ((LineEnds in [leAcceptNoWrite, leAlways]) and (l = sSectionEnd+sLineEndMarker)) then begin
- if Depth > 0 then
- exit
- else
- raise EConfigException.Create('Encountered Section End where none was expected.');
- end;
- if AnsiEndsStr(sSectionMarker, l) then begin
- sn:= trim(Copy(l, 1, length(l) - length(sSectionMarker)));
- if SectionExists(sn) then
- raise EConfigException.Create('Redeclared Section: '+sn);
- if Pos(sSectionPathDelim,sn) > 0 then
- raise EConfigException.Create('Invalid Section Name: '+sn);
- se:= TutlMCFSection.Create;
- try
- se.LoadData(Data, LineEnds, Depth + 1);
- FSections.AddObject(sn, se);
- except
- FreeAndNil(se);
- end;
- end else if (Pos(sValueDelim, l) > 0) then begin
- if (LineEnds in [leAcceptNoWrite, leAlways]) and AnsiEndsStr(sLineEndMarker, l) then
- Delete(l, length(l), 1);
- vn:= trim(Copy(l, 1, Pos(sValueDelim, l) - 1));
- vs:= trim(Copy(l, Pos(sValueDelim, l) + 1, Maxint));
- if ValueExists(vn) then
- raise EConfigException.Create('Redeclared Value: '+vn);
- va:= TutlMCFValue.Create('');
- try
- va.LoadData(vs);
- AddValueChecked(vn, va);
- except
- FreeAndNil(va);
- end;
- end else
- raise EConfigException.Create('Cannot Parse Line: '+l);
- until reader.IsEOF;
- if Depth > 0 then
- raise EConfigException.Create('Expected Section End, but reached stream end.');
- Depth:= Depth - 1;
- finally
- FreeAndNil(reader);
- end;
- end;
-
- procedure TutlMCFSection.SaveData(Stream: TStream; Indent: string; LineEnds: TutlMCFLineEndMarkerMode);
- var
- writer: TutlStreamWriter;
- i: integer;
- ele, s: AnsiString;
- begin
- if LineEnds in [leAlways] then
- ele:= sLineEndMarker
- else
- ele:= '';
- writer:= TutlStreamWriter.Create(Stream, false);
- try
- for i:= 0 to FValues.Count - 1 do begin
- s:= Indent + FValues[i] + ' ' + sValueDelim + ' ' + TutlMCFValue(FValues.Objects[i]).SaveData + ele;
- writer.WriteLine(s);
- end;
-
- for i:= 0 to FSections.Count - 1 do begin
- s:= Indent + FSections[i] + sSectionMarker;
- writer.WriteLine(s);
- TutlMCFSection(FSections.Objects[i]).SaveData(Stream, Indent + sIndentOnSave, LineEnds);
- s:= Indent + sSectionEnd + ele;
- writer.WriteLine(s);
- end;
- finally
- FreeAndNil(writer);
- end;
- end;
-
- { TutlMCFFile }
-
- constructor TutlMCFFile.Create(Data: TStream; LineEndMode: TutlMCFLineEndMarkerMode);
- begin
- inherited Create;
- fLineEndMode:= LineEndMode;
- if Assigned(Data) then
- LoadFromStream(Data);
- end;
-
- procedure TutlMCFFile.LoadFromStream(Stream: TStream);
- begin
- ClearSections;
- ClearValues;
- LoadData(Stream, fLineEndMode, 0);
- end;
-
- procedure TutlMCFFile.SaveToStream(Stream: TStream);
- begin
- SaveData(Stream, '', fLineEndMode);
- end;
-
- end.
|