1 (* Copyright (C) DooM 2D:Forever Developers
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
16 {$INCLUDE a_modes.inc}
33 TConfig
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
35 FParams
: array of TParam
;
36 FSections
: array of ShortString;
37 FCurrentSection
: Word;
38 function ReadParam(Section
, Param
, Default
: string): string;
39 procedure WriteParam(Section
, Param
, Value
: string);
40 procedure ProcessStr(Str
: string);
43 constructor CreateFile(FileName
: string);
44 constructor CreateMem(pData
: Pointer; _Length
: LongWord);
45 destructor Destroy(); override;
46 procedure FreeConfig();
47 procedure SaveFile(FileName
: string);
48 function ReadInt(Section
, Param
: string; Default
: Integer): Integer;
49 function ReadStr(Section
, Param
: string; Default
: String): string;
50 function ReadBool(Section
, Param
: string; Default
: Boolean): Boolean;
51 function SectionExists(Section
: string): Boolean;
52 procedure WriteInt(Section
, Param
: string; Value
: Integer);
53 procedure WriteStr(Section
, Param
, Value
: string);
54 procedure WriteBool(Section
, Param
: string; Value
: Boolean);
64 constructor TConfig
.Create();
71 constructor TConfig
.CreateFile(FileName
: string);
78 if not FileExists(FileName
) then Exit
;
80 AssignFile(f
, FileName
);
90 constructor TConfig
.CreateMem(pData
: Pointer; _Length
: LongWord);
97 if _Length
= 0 then Exit
;
98 if pData
= nil then Exit
;
100 SetLength(str
, _Length
);
102 CopyMemory(@str
[1], pData
, _Length
);
106 for a
:= 2 to Length(Str
) do
107 if (Str
[a
-1]+Str
[a
] = #13#10) or (a
= Length(Str
)) then
109 if a
<> Length(Str
) then ProcessStr(Copy(Str
, 1, a
-2)) else ProcessStr(Str
);
117 destructor TConfig
.Destroy();
125 procedure TConfig
.FreeConfig();
130 SetLength(FSections
, 1);
132 FCurrentSection
:= 0;
135 procedure TConfig
.ProcessStr(Str
: string);
141 if (Str
<> '') and (Length(Str
) > 2) and (Str
[1] <> ';') then
145 if Pos('=', Str
) > 0 then
147 SetLength(FParams
, Length(FParams
)+1);
149 with FParams
[High(FParams
)] do
152 Param
:= Trim(Copy(Str
, 1, a
-1));
153 Value
:= Trim(Copy(Str
, a
+1, l
));
154 Section
:= FCurrentSection
;
157 else if (Str
[1] = '[') and (Str
[l
] = ']') then
159 SetLength(FSections
, Length(FSections
)+1);
160 FCurrentSection
:= High(FSections
);
161 FSections
[FCurrentSection
] := Trim(Copy(Str
, 2, l
-2));
166 function TConfig
.ReadBool(Section
, Param
: string; Default
: Boolean): Boolean;
170 if Default
then a
:= 1 else a
:= 0;
172 Result
:= StrToIntDef(ReadParam(Section
, Param
, IntToStr(a
)), a
) <> 0;
175 function TConfig
.ReadInt(Section
, Param
: string; Default
: Integer): Integer;
177 Result
:= StrToIntDef(ReadParam(Section
, Param
, IntToStr(Default
)), Default
);
180 function TConfig
.ReadParam(Section
, Param
, Default
: string): string;
189 if FParams
= nil then Exit
;
190 if FSections
= nil then Exit
;
194 for a
:= 0 to High(FSections
) do
195 if LowerCase(FSections
[a
]) = LowerCase(Section
) then
203 p
:= LowerCase(Param
);
205 for a
:= 0 to High(FParams
) do
206 if (FParams
[a
].Section
= s
) and (LowerCase(FParams
[a
].Param
) = p
) then
208 Result
:= FParams
[a
].Value
;
213 function TConfig
.ReadStr(Section
, Param
, Default
: string): string;
215 Result
:= ReadParam(Section
, Param
, Default
);
218 procedure TConfig
.SaveFile(FileName
: string);
224 AssignFile(f
, FileName
);
226 if (FSections
<> nil) or (FParams
<> nil) then
228 if FSections
<> nil then
229 for a
:= 0 to High(FSections
) do
231 if FSections
[a
] <> '' then Writeln(f
, '['+FSections
[a
]+']');
233 if FParams
<> nil then
234 for b
:= 0 to High(FParams
) do
235 if FParams
[b
].Section
= a
then WriteLn(f
, FParams
[b
].Param
+'='+FParams
[b
].Value
);
237 if (a
<> High(FSections
)) and (FSections
[a
] <> '') then WriteLn(f
, '');
243 function TConfig
.SectionExists(Section
: string): Boolean;
249 if FSections
= nil then Exit
;
251 Section
:= LowerCase(Section
);
253 for a
:= 0 to High(FSections
) do
254 if Section
= LowerCase(FSections
[a
]) then
261 procedure TConfig
.WriteBool(Section
, Param
: string; Value
: Boolean);
263 WriteParam(Section
, Param
, BoolToStr(Value
));
266 procedure TConfig
.WriteInt(Section
, Param
: string; Value
: Integer);
268 WriteParam(Section
, Param
, IntToStr(Value
));
271 procedure TConfig
.WriteParam(Section
, Param
, Value
: string);
281 if FSections
<> nil then
282 for a
:= 0 to High(FSections
) do
283 if FSections
[a
] = Section
then
291 SetLength(FSections
, Length(FSections
)+1);
292 a
:= High(FSections
);
293 FSections
[a
] := Section
;
297 if FParams
<> nil then
298 for b
:= 0 to High(FParams
) do
299 if (LowerCase(FParams
[b
].Param
) = LowerCase(Param
)) and (FParams
[b
].Section
= a
) then
305 if ok
then FParams
[b
].Value
:= Value
308 SetLength(FParams
, Length(FParams
)+1);
309 FParams
[High(FParams
)].Param
:= Param
;
310 FParams
[High(FParams
)].Value
:= Value
;
311 FParams
[High(FParams
)].Section
:= a
;
315 procedure TConfig
.WriteStr(Section
, Param
, Value
: string);
317 WriteParam(Section
, Param
, Value
);