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