{ *************************************************************************** } { } { Delphi and Kylix Cross-Platform Visual Component Library } { } { Copyright (c) 1995, 2001 Borland Software Corporation } { } { *************************************************************************** } unit IniFiles; {$R-,T-,H+,X+} interface uses SysUtils, Classes; type EIniFileException = class(Exception); TCustomIniFile = class(TObject) private FFileName: string; public constructor Create(const FileName: string); function SectionExists(const Section: string): Boolean; function ReadString(const Section, Ident, Default: string): string; virtual; abstract; procedure WriteString(const Section, Ident, Value: String); virtual; abstract; function ReadInteger(const Section, Ident: string; Default: Longint): Longint; virtual; procedure WriteInteger(const Section, Ident: string; Value: Longint); virtual; function ReadBool(const Section, Ident: string; Default: Boolean): Boolean; virtual; procedure WriteBool(const Section, Ident: string; Value: Boolean); virtual; function ReadBinaryStream(const Section, Name: string; Value: TStream): Integer; virtual; function ReadDate(const Section, Name: string; Default: TDateTime): TDateTime; virtual; function ReadDateTime(const Section, Name: string; Default: TDateTime): TDateTime; virtual; function ReadFloat(const Section, Name: string; Default: Double): Double; virtual; function ReadTime(const Section, Name: string; Default: TDateTime): TDateTime; virtual; procedure WriteBinaryStream(const Section, Name: string; Value: TStream); virtual; procedure WriteDate(const Section, Name: string; Value: TDateTime); virtual; procedure WriteDateTime(const Section, Name: string; Value: TDateTime); virtual; procedure WriteFloat(const Section, Name: string; Value: Double); virtual; procedure WriteTime(const Section, Name: string; Value: TDateTime); virtual; procedure ReadSection(const Section: string; Strings: TStrings); virtual; abstract; procedure ReadSections(Strings: TStrings); virtual; abstract; procedure ReadSectionValues(const Section: string; Strings: TStrings); virtual; abstract; procedure EraseSection(const Section: string); virtual; abstract; procedure DeleteKey(const Section, Ident: String); virtual; abstract; procedure UpdateFile; virtual; abstract; function ValueExists(const Section, Ident: string): Boolean; property FileName: string read FFileName; end; { TStringHash - used internally by TMemIniFile to optimize searches. } PPHashItem = ^PHashItem; PHashItem = ^THashItem; THashItem = record Next: PHashItem; Key: string; Value: Integer; end; TStringHash = class private Buckets: array of PHashItem; protected function Find(const Key: string): PPHashItem; function HashOf(const Key: string): Cardinal; virtual; public constructor Create(Size: Cardinal = 256); destructor Destroy; override; procedure Add(const Key: string; Value: Integer); procedure Clear; procedure Remove(const Key: string); function Modify(const Key: string; Value: Integer): Boolean; function ValueOf(const Key: string): Integer; end; { THashedStringList - A TStringList that uses TStringHash to improve the speed of Find } THashedStringList = class(TStringList) private FValueHash: TStringHash; FNameHash: TStringHash; FValueHashValid: Boolean; FNameHashValid: Boolean; procedure UpdateValueHash; procedure UpdateNameHash; protected procedure Changed; override; public destructor Destroy; override; function IndexOf(const S: string): Integer; override; function IndexOfName(const Name: string): Integer; override; end; { TMemIniFile - loads an entire INI file into memory and allows all operations to be performed on the memory image. The image can then be written out to the disk file } TMemIniFile = class(TCustomIniFile) private FSections: TStringList; function AddSection(const Section: string): TStrings; function GetCaseSensitive: Boolean; procedure LoadValues; procedure SetCaseSensitive(Value: Boolean); public constructor Create(const FileName: string); destructor Destroy; override; procedure Clear; procedure DeleteKey(const Section, Ident: String); override; procedure EraseSection(const Section: string); override; procedure GetStrings(List: TStrings); procedure ReadSection(const Section: string; Strings: TStrings); override; procedure ReadSections(Strings: TStrings); override; procedure ReadSectionValues(const Section: string; Strings: TStrings); override; function ReadString(const Section, Ident, Default: string): string; override; procedure Rename(const FileName: string; Reload: Boolean); procedure SetStrings(List: TStrings); procedure UpdateFile; override; procedure WriteString(const Section, Ident, Value: String); override; property CaseSensitive: Boolean read GetCaseSensitive write SetCaseSensitive; end; {$IFDEF MSWINDOWS} { TIniFile - Encapsulates the Windows INI file interface (Get/SetPrivateProfileXXX functions) } TIniFile = class(TCustomIniFile) public destructor Destroy; override; function ReadString(const Section, Ident, Default: string): string; override; procedure WriteString(const Section, Ident, Value: String); override; procedure ReadSection(const Section: string; Strings: TStrings); override; procedure ReadSections(Strings: TStrings); override; procedure ReadSectionValues(const Section: string; Strings: TStrings); override; procedure EraseSection(const Section: string); override; procedure DeleteKey(const Section, Ident: String); override; procedure UpdateFile; override; end; {$ELSE} TIniFile = class(TMemIniFile) public destructor Destroy; override; end; {$ENDIF} implementation uses RTLConsts {$IFDEF MSWINDOWS} , Windows {$ENDIF}; { TCustomIniFile } constructor TCustomIniFile.Create(const FileName: string); begin FFileName := FileName; end; function TCustomIniFile.SectionExists(const Section: string): Boolean; var S: TStrings; begin S := TStringList.Create; try ReadSection(Section, S); Result := S.Count > 0; finally S.Free; end; end; function TCustomIniFile.ReadInteger(const Section, Ident: string; Default: Longint): Longint; var IntStr: string; begin IntStr := ReadString(Section, Ident, ''); if (Length(IntStr) > 2) and (IntStr[1] = '0') and ((IntStr[2] = 'X') or (IntStr[2] = 'x')) then IntStr := '$' + Copy(IntStr, 3, Maxint); Result := StrToIntDef(IntStr, Default); end; procedure TCustomIniFile.WriteInteger(const Section, Ident: string; Value: Longint); begin WriteString(Section, Ident, IntToStr(Value)); end; function TCustomIniFile.ReadBool(const Section, Ident: string; Default: Boolean): Boolean; begin Result := ReadInteger(Section, Ident, Ord(Default)) <> 0; end; function TCustomIniFile.ReadDate(const Section, Name: string; Default: TDateTime): TDateTime; var DateStr: string; begin DateStr := ReadString(Section, Name, ''); Result := Default; if DateStr <> '' then try Result := StrToDate(DateStr); except on EConvertError do // Ignore EConvertError exceptions else raise; end; end; function TCustomIniFile.ReadDateTime(const Section, Name: string; Default: TDateTime): TDateTime; var DateStr: string; begin DateStr := ReadString(Section, Name, ''); Result := Default; if DateStr <> '' then try Result := StrToDateTime(DateStr); except on EConvertError do // Ignore EConvertError exceptions else raise; end; end; function TCustomIniFile.ReadFloat(const Section, Name: string; Default: Double): Double; var FloatStr: string; begin FloatStr := ReadString(Section, Name, ''); Result := Default; if FloatStr <> '' then try Result := StrToFloat(FloatStr); except on EConvertError do // Ignore EConvertError exceptions else raise; end; end; function TCustomIniFile.ReadTime(const Section, Name: string; Default: TDateTime): TDateTime; var TimeStr: string; begin TimeStr := ReadString(Section, Name, ''); Result := Default; if TimeStr <> '' then try Result := StrToTime(TimeStr); except on EConvertError do // Ignore EConvertError exceptions else raise; end; end; procedure TCustomIniFile.WriteDate(const Section, Name: string; Value: TDateTime); begin WriteString(Section, Name, DateToStr(Value)); end; procedure TCustomIniFile.WriteDateTime(const Section, Name: string; Value: TDateTime); begin WriteString(Section, Name, DateTimeToStr(Value)); end; procedure TCustomIniFile.WriteFloat(const Section, Name: string; Value: Double); begin WriteString(Section, Name, FloatToStr(Value)); end; procedure TCustomIniFile.WriteTime(const Section, Name: string; Value: TDateTime); begin WriteString(Section, Name, TimeToStr(Value)); end; procedure TCustomIniFile.WriteBool(const Section, Ident: string; Value: Boolean); const Values: array[Boolean] of string = ('0', '1'); begin WriteString(Section, Ident, Values[Value]); end; function TCustomIniFile.ValueExists(const Section, Ident: string): Boolean; var S: TStrings; begin S := TStringList.Create; try ReadSection(Section, S); Result := S.IndexOf(Ident) > -1; finally S.Free; end; end; function TCustomIniFile.ReadBinaryStream(const Section, Name: string; Value: TStream): Integer; var Text: string; Stream: TMemoryStream; Pos: Integer; begin Text := ReadString(Section, Name, ''); if Text <> '' then begin if Value is TMemoryStream then Stream := TMemoryStream(Value) else Stream := TMemoryStream.Create; try Pos := Stream.Position; Stream.SetSize(Stream.Size + Length(Text) div 2); HexToBin(PChar(Text), PChar(Integer(Stream.Memory) + Stream.Position), Length(Text) div 2); Stream.Position := Pos; if Value <> Stream then Value.CopyFrom(Stream, Length(Text) div 2); Result := Stream.Size - Pos; finally if Value <> Stream then Stream.Free; end; end else Result := 0; end; procedure TCustomIniFile.WriteBinaryStream(const Section, Name: string; Value: TStream); var Text: string; Stream: TMemoryStream; begin SetLength(Text, (Value.Size - Value.Position) * 2); if Length(Text) > 0 then begin if Value is TMemoryStream then Stream := TMemoryStream(Value) else Stream := TMemoryStream.Create; try if Stream <> Value then begin Stream.CopyFrom(Value, Value.Size - Value.Position); Stream.Position := 0; end; BinToHex(PChar(Integer(Stream.Memory) + Stream.Position), PChar(Text), Stream.Size - Stream.Position); finally if Value <> Stream then Stream.Free; end; end; WriteString(Section, Name, Text); end; { TStringHash } procedure TStringHash.Add(const Key: string; Value: Integer); var Hash: Integer; Bucket: PHashItem; begin Hash := HashOf(Key) mod Cardinal(Length(Buckets)); New(Bucket); Bucket^.Key := Key; Bucket^.Value := Value; Bucket^.Next := Buckets[Hash]; Buckets[Hash] := Bucket; end; procedure TStringHash.Clear; var I: Integer; P, N: PHashItem; begin for I := 0 to Length(Buckets) - 1 do begin P := Buckets[I]; while P <> nil do begin N := P^.Next; Dispose(P); P := N; end; Buckets[I] := nil; end; end; constructor TStringHash.Create(Size: Cardinal); begin inherited Create; SetLength(Buckets, Size); end; destructor TStringHash.Destroy; begin Clear; inherited Destroy; end; function TStringHash.Find(const Key: string): PPHashItem; var Hash: Integer; begin Hash := HashOf(Key) mod Cardinal(Length(Buckets)); Result := @Buckets[Hash]; while Result^ <> nil do begin if Result^.Key = Key then Exit else Result := @Result^.Next; end; end; function TStringHash.HashOf(const Key: string): Cardinal; var I: Integer; begin Result := 0; for I := 1 to Length(Key) do Result := ((Result shl 2) or (Result shr (SizeOf(Result) * 8 - 2))) xor Ord(Key[I]); end; function TStringHash.Modify(const Key: string; Value: Integer): Boolean; var P: PHashItem; begin P := Find(Key)^; if P <> nil then begin Result := True; P^.Value := Value; end else Result := False; end; procedure TStringHash.Remove(const Key: string); var P: PHashItem; Prev: PPHashItem; begin Prev := Find(Key); P := Prev^; if P <> nil then begin Prev^ := P^.Next; Dispose(P); end; end; function TStringHash.ValueOf(const Key: string): Integer; var P: PHashItem; begin P := Find(Key)^; if P <> nil then Result := P^.Value else Result := -1; end; { THashedStringList } procedure THashedStringList.Changed; begin inherited Changed; FValueHashValid := False; FNameHashValid := False; end; destructor THashedStringList.Destroy; begin FValueHash.Free; FNameHash.Free; inherited Destroy; end; function THashedStringList.IndexOf(const S: string): Integer; begin UpdateValueHash; if not CaseSensitive then Result := FValueHash.ValueOf(AnsiUpperCase(S)) else Result := FValueHash.ValueOf(S); end; function THashedStringList.IndexOfName(const Name: string): Integer; begin UpdateNameHash; if not CaseSensitive then Result := FNameHash.ValueOf(AnsiUpperCase(Name)) else Result := FNameHash.ValueOf(Name); end; procedure THashedStringList.UpdateNameHash; var I: Integer; P: Integer; Key: string; begin if FNameHashValid then Exit; if FNameHash = nil then FNameHash := TStringHash.Create else FNameHash.Clear; for I := 0 to Count - 1 do begin Key := Get(I); P := AnsiPos(NameValueSeparator, Key); if P <> 0 then begin if not CaseSensitive then Key := AnsiUpperCase(Copy(Key, 1, P - 1)) else Key := Copy(Key, 1, P - 1); FNameHash.Add(Key, I); end; end; FNameHashValid := True; end; procedure THashedStringList.UpdateValueHash; var I: Integer; begin if FValueHashValid then Exit; if FValueHash = nil then FValueHash := TStringHash.Create else FValueHash.Clear; for I := 0 to Count - 1 do if not CaseSensitive then FValueHash.Add(AnsiUpperCase(Self[I]), I) else FValueHash.Add(Self[I], I); FValueHashValid := True; end; { TMemIniFile } constructor TMemIniFile.Create(const FileName: string); begin inherited Create(FileName); FSections := THashedStringList.Create; {$IFDEF LINUX} FSections.CaseSensitive := True; {$ENDIF} LoadValues; end; destructor TMemIniFile.Destroy; begin if FSections <> nil then Clear; FSections.Free; inherited Destroy; end; function TMemIniFile.AddSection(const Section: string): TStrings; begin Result := THashedStringList.Create; try THashedStringList(Result).CaseSensitive := CaseSensitive; FSections.AddObject(Section, Result); except Result.Free; raise; end; end; procedure TMemIniFile.Clear; var I: Integer; begin for I := 0 to FSections.Count - 1 do TObject(FSections.Objects[I]).Free; FSections.Clear; end; procedure TMemIniFile.DeleteKey(const Section, Ident: String); var I, J: Integer; Strings: TStrings; begin I := FSections.IndexOf(Section); if I >= 0 then begin Strings := TStrings(FSections.Objects[I]); J := Strings.IndexOfName(Ident); if J >= 0 then Strings.Delete(J); end; end; procedure TMemIniFile.EraseSection(const Section: string); var I: Integer; begin I := FSections.IndexOf(Section); if I >= 0 then begin TStrings(FSections.Objects[I]).Free; FSections.Delete(I); end; end; function TMemIniFile.GetCaseSensitive: Boolean; begin Result := FSections.CaseSensitive; end; procedure TMemIniFile.GetStrings(List: TStrings); var I, J: Integer; Strings: TStrings; begin List.BeginUpdate; try for I := 0 to FSections.Count - 1 do begin List.Add('[' + FSections[I] + ']'); Strings := TStrings(FSections.Objects[I]); for J := 0 to Strings.Count - 1 do List.Add(Strings[J]); List.Add(''); end; finally List.EndUpdate; end; end; procedure TMemIniFile.LoadValues; var List: TStringList; begin if (FileName <> '') and FileExists(FileName) then begin List := TStringList.Create; try List.LoadFromFile(FileName); SetStrings(List); finally List.Free; end; end else Clear; end; procedure TMemIniFile.ReadSection(const Section: string; Strings: TStrings); var I, J: Integer; SectionStrings: TStrings; begin Strings.BeginUpdate; try Strings.Clear; I := FSections.IndexOf(Section); if I >= 0 then begin SectionStrings := TStrings(FSections.Objects[I]); for J := 0 to SectionStrings.Count - 1 do Strings.Add(SectionStrings.Names[J]); end; finally Strings.EndUpdate; end; end; procedure TMemIniFile.ReadSections(Strings: TStrings); begin Strings.Assign(FSections); end; procedure TMemIniFile.ReadSectionValues(const Section: string; Strings: TStrings); var I: Integer; begin Strings.BeginUpdate; try Strings.Clear; I := FSections.IndexOf(Section); if I >= 0 then Strings.Assign(TStrings(FSections.Objects[I])); finally Strings.EndUpdate; end; end; function TMemIniFile.ReadString(const Section, Ident, Default: string): string; var I: Integer; Strings: TStrings; begin I := FSections.IndexOf(Section); if I >= 0 then begin Strings := TStrings(FSections.Objects[I]); I := Strings.IndexOfName(Ident); if I >= 0 then begin Result := Copy(Strings[I], Length(Ident) + 2, Maxint); Exit; end; end; Result := Default; end; procedure TMemIniFile.Rename(const FileName: string; Reload: Boolean); begin FFileName := FileName; if Reload then LoadValues; end; procedure TMemIniFile.SetCaseSensitive(Value: Boolean); var I: Integer; begin if Value <> FSections.CaseSensitive then begin FSections.CaseSensitive := Value; for I := 0 to FSections.Count - 1 do with THashedStringList(FSections.Objects[I]) do begin CaseSensitive := Value; Changed; end; THashedStringList(FSections).Changed; end; end; procedure TMemIniFile.SetStrings(List: TStrings); var I, J: Integer; S: string; Strings: TStrings; begin Clear; Strings := nil; for I := 0 to List.Count - 1 do begin S := Trim(List[I]); if (S <> '') and (S[1] <> ';') then if (S[1] = '[') and (S[Length(S)] = ']') then begin Delete(S, 1, 1); SetLength(S, Length(S)-1); Strings := AddSection(Trim(S)); end else if Strings <> nil then begin J := Pos('=', S); if J > 0 then // remove spaces before and after '=' Strings.Add(Trim(Copy(S, 1, J-1)) + '=' + Trim(Copy(S, J+1, MaxInt)) ) else Strings.Add(S); end; end; end; procedure TMemIniFile.UpdateFile; var List: TStringList; begin List := TStringList.Create; try GetStrings(List); List.SaveToFile(FFileName); finally List.Free; end; end; procedure TMemIniFile.WriteString(const Section, Ident, Value: String); var I: Integer; S: string; Strings: TStrings; begin I := FSections.IndexOf(Section); if I >= 0 then Strings := TStrings(FSections.Objects[I]) else Strings := AddSection(Section); S := Ident + '=' + Value; I := Strings.IndexOfName(Ident); if I >= 0 then Strings[I] := S else Strings.Add(S); end; {$IFDEF MSWINDOWS} { TIniFile } destructor TIniFile.Destroy; begin UpdateFile; // flush changes to disk inherited Destroy; end; function TIniFile.ReadString(const Section, Ident, Default: string): string; var Buffer: array[0..2047] of Char; begin SetString(Result, Buffer, GetPrivateProfileString(PChar(Section), PChar(Ident), PChar(Default), Buffer, SizeOf(Buffer), PChar(FFileName))); end; procedure TIniFile.WriteString(const Section, Ident, Value: string); begin if not WritePrivateProfileString(PChar(Section), PChar(Ident), PChar(Value), PChar(FFileName)) then raise EIniFileException.CreateResFmt(@SIniFileWriteError, [FileName]); end; procedure TIniFile.ReadSections(Strings: TStrings); const BufSize = 16384; var Buffer, P: PChar; begin GetMem(Buffer, BufSize); try Strings.BeginUpdate; try Strings.Clear; if GetPrivateProfileString(nil, nil, nil, Buffer, BufSize, PChar(FFileName)) <> 0 then begin P := Buffer; while P^ <> #0 do begin Strings.Add(P); Inc(P, StrLen(P) + 1); end; end; finally Strings.EndUpdate; end; finally FreeMem(Buffer, BufSize); end; end; procedure TIniFile.ReadSection(const Section: string; Strings: TStrings); const BufSize = 16384; var Buffer, P: PChar; begin GetMem(Buffer, BufSize); try Strings.BeginUpdate; try Strings.Clear; if GetPrivateProfileString(PChar(Section), nil, nil, Buffer, BufSize, PChar(FFileName)) <> 0 then begin P := Buffer; while P^ <> #0 do begin Strings.Add(P); Inc(P, StrLen(P) + 1); end; end; finally Strings.EndUpdate; end; finally FreeMem(Buffer, BufSize); end; end; procedure TIniFile.ReadSectionValues(const Section: string; Strings: TStrings); var KeyList: TStringList; I: Integer; begin KeyList := TStringList.Create; try ReadSection(Section, KeyList); Strings.BeginUpdate; try Strings.Clear; for I := 0 to KeyList.Count - 1 do Strings.Add(KeyList[I] + '=' + ReadString(Section, KeyList[I], '')) finally Strings.EndUpdate; end; finally KeyList.Free; end; end; procedure TIniFile.EraseSection(const Section: string); begin if not WritePrivateProfileString(PChar(Section), nil, nil, PChar(FFileName)) then raise EIniFileException.CreateResFmt(@SIniFileWriteError, [FileName]); end; procedure TIniFile.DeleteKey(const Section, Ident: String); begin WritePrivateProfileString(PChar(Section), PChar(Ident), nil, PChar(FFileName)); end; procedure TIniFile.UpdateFile; begin WritePrivateProfileString(nil, nil, nil, PChar(FFileName)); end; {$ELSE} destructor TIniFile.Destroy; begin UpdateFile; inherited Destroy; end; {$ENDIF} end.