1 { $Id: inipropstorage.pas 57220 2018-02-02 11:46:07Z ondrej $ }
2 {
3 *****************************************************************************
4 This file is part of the Lazarus Component Library (LCL)
5
6 See the file COPYING.modifiedLGPL.txt, included in this distribution,
7 for details about the license.
8 *****************************************************************************
9 }
10 unit IniPropStorage;
11
12 {$mode objfpc}{$H+}
13
14 interface
15
16 uses
17 Classes, SysUtils, IniFiles,
18 // LazUtils
19 LazUtf8,
20 // LCL
21 Forms;
22
23 type
24 { TCustomIniPropStorage }
25
26 TIniFileClass = class of TCustomIniFile;
27
28 TCustomIniPropStorage = class(TFormPropertyStorage)
29 private
30 FCount : Integer;
31 FReadOnly : Boolean;
32 FIniFile: TCustomIniFile;
33 FIniFileName: string;
34 FIniSection: string;
35 protected
IniFileClassnull36 function IniFileClass: TIniFileClass; virtual;
GetIniFileNamenull37 function GetIniFileName: string; virtual;
RootSectionnull38 function RootSection: string; override;
39 property IniFile: TCustomIniFile read FIniFile;
40 public
41 procedure StorageNeeded(ReadOnly: Boolean); override;
42 procedure FreeStorage; override;
DoReadStringnull43 function DoReadString(const Section, Ident, default: string): string; override;
44 procedure DoWriteString(const Section, Ident, Value: string); override;
45 procedure DoEraseSections(const ARootSection : string);override;
46 public
47 property IniFileName: string read FIniFileName write FIniFileName;
48 property IniSection: string read FIniSection write FIniSection;
49 end;
50
51 { TIniPropStorage }
52
53 TIniPropStorage = class(TCustomIniPropStorage)
54 published
55 Property StoredValues;
56 property IniFileName;
57 property IniSection;
58 property Active;
59 property OnSavingProperties;
60 property OnSaveProperties;
61 property OnRestoringProperties;
62 property OnRestoreProperties;
63 end;
64
65
66 procedure Register;
67
68
69 implementation
70
71
72 procedure Register;
73 begin
74 RegisterComponents('Misc',[TIniPropStorage]);
75 end;
76
77 { TCustomIniPropStorage }
78
IniFileClassnull79 function TCustomIniPropStorage.IniFileClass: TIniFileClass;
80 begin
81 Result:=TIniFile;
82 end;
83
84 procedure TCustomIniPropStorage.StorageNeeded(ReadOnly: Boolean);
85 begin
86 If (FIniFile=Nil) or (ReadOnly<>FReadOnly) then
87 begin
88 If (FiniFile<>Nil) then
89 begin
90 // Force free.
91 FCount:=0;
92 FreeStorage;
93 end;
94 FReadOnly:=ReadOnly;
95 if not (csDesigning in ComponentState) then
96 FInifile:=IniFileClass.Create(GetIniFileName{$IF FPC_FULLVERSION>=30101}, TEncoding.UTF8{$ENDIF});
97 end;
98 Inc(FCount);
99 end;
100
101 procedure TCustomIniPropStorage.FreeStorage;
102 begin
103 Dec(FCount);
104 If FCount<=0 then
105 begin
106 FCount:=0;
107 FreeAndNil(FIniFile);
108 end;
109 end;
110
TCustomIniPropStorage.GetIniFileNamenull111 function TCustomIniPropStorage.GetIniFileName: string;
112 begin
113 If (FIniFileName<>'') then
114 Result:=FIniFileName
115 else if csDesigning in ComponentState then
116 raise Exception.Create('TCustomIniPropStorage.GetIniFileName: missing Filename')
117 else
118 {$ifdef unix}
119 Result:=IncludeTrailingPathDelimiter(GetEnvironmentVariableUTF8('HOME'))
120 +'.'+ExtractFileName(Application.ExeName);
121
122 {$else}
123 Result:=ChangeFileExt(Application.ExeName,'.ini');
124 {$endif}
125 end;
126
TCustomIniPropStorage.RootSectionnull127 function TCustomIniPropStorage.RootSection: String;
128 begin
129 if (FIniSection='') then
130 Result:=inherited RootSection
131 else
132 Result:=FIniSection;
133 end;
134
TCustomIniPropStorage.DoReadStringnull135 function TCustomIniPropStorage.DoReadString(const Section, Ident, Default: string): string;
136 begin
137 Result:=FIniFile.ReadString(Section, Ident, Default);
138 end;
139
140 procedure TCustomIniPropStorage.DoWriteString(const Section, Ident, Value: string);
141 begin
142 FIniFile.WriteString(Section, Ident, Value);
143 end;
144
145 procedure TCustomIniPropStorage.DoEraseSections(const ARootSection: String);
146
147 var
148 Lines: TStrings;
149 I: Integer;
150 begin
151 Lines := TStringList.Create;
152 try
153 FInifile.ReadSections(Lines);
154 for I := 0 to Lines.Count - 1 do begin
155 if SameText(Lines[I],ARootSection) or
156 SameText(Copy(Lines[i],1,Length(ARootSection)+1), ARootSection+'.') then
157 FInifile.EraseSection(Lines[I]);
158 end;
159 finally
160 Lines.Free;
161 end;
162 end;
163
164 end.
165