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}
20 -----------------------------------
21 CONFIG.PAS ÂÅÐÑÈß ÎÒ 24.09.06
22 -----------------------------------
37 TConfig
= class(TPoolObject
)
39 FParams
: array of TParam
;
40 FSections
: array of ShortString;
41 FCurrentSection
: Word;
42 function ReadParam(Section
, Param
, Default
: string): string;
43 procedure WriteParam(Section
, Param
, Value
: string);
44 procedure ProcessStr(Str
: string);
47 constructor CreateFile(FileName
: string);
48 constructor CreateMem(pData
: Pointer; _Length
: LongWord);
49 destructor Destroy(); override;
50 procedure FreeConfig();
51 procedure SaveFile(FileName
: string);
52 function ReadInt(Section
, Param
: string; Default
: Integer): Integer;
53 function ReadStr(Section
, Param
: string; Default
: String): string;
54 function ReadBool(Section
, Param
: string; Default
: Boolean): Boolean;
55 function SectionExists(Section
: string): Boolean;
56 procedure WriteInt(Section
, Param
: string; Value
: Integer);
57 procedure WriteStr(Section
, Param
, Value
: string);
58 procedure WriteBool(Section
, Param
: string; Value
: Boolean);
68 constructor TConfig
.Create();
75 constructor TConfig
.CreateFile(FileName
: string);
82 if not FileExists(FileName
) then Exit
;
84 AssignFile(f
, FileName
);
94 constructor TConfig
.CreateMem(pData
: Pointer; _Length
: LongWord);
101 if _Length
= 0 then Exit
;
102 if pData
= nil then Exit
;
104 SetLength(str
, _Length
);
106 CopyMemory(@str
[1], pData
, _Length
);
110 for a
:= 2 to Length(Str
) do
111 if (Str
[a
-1]+Str
[a
] = #13#10) or (a
= Length(Str
)) then
113 if a
<> Length(Str
) then ProcessStr(Copy(Str
, 1, a
-2)) else ProcessStr(Str
);
121 destructor TConfig
.Destroy();
129 procedure TConfig
.FreeConfig();
134 SetLength(FSections
, 1);
136 FCurrentSection
:= 0;
139 procedure TConfig
.ProcessStr(Str
: string);
145 if (Str
<> '') and (Length(Str
) > 2) and (Str
[1] <> ';') then
149 if Pos('=', Str
) > 0 then
151 SetLength(FParams
, Length(FParams
)+1);
153 with FParams
[High(FParams
)] do
156 Param
:= Trim(Copy(Str
, 1, a
-1));
157 Value
:= Trim(Copy(Str
, a
+1, l
));
158 Section
:= FCurrentSection
;
161 else if (Str
[1] = '[') and (Str
[l
] = ']') then
163 SetLength(FSections
, Length(FSections
)+1);
164 FCurrentSection
:= High(FSections
);
165 FSections
[FCurrentSection
] := Trim(Copy(Str
, 2, l
-2));
170 function TConfig
.ReadBool(Section
, Param
: string; Default
: Boolean): Boolean;
174 if Default
then a
:= 1 else a
:= 0;
176 Result
:= StrToIntDef(ReadParam(Section
, Param
, IntToStr(a
)), a
) <> 0;
179 function TConfig
.ReadInt(Section
, Param
: string; Default
: Integer): Integer;
181 Result
:= StrToIntDef(ReadParam(Section
, Param
, IntToStr(Default
)), Default
);
184 function TConfig
.ReadParam(Section
, Param
, Default
: string): string;
193 if FParams
= nil then Exit
;
194 if FSections
= nil then Exit
;
198 for a
:= 0 to High(FSections
) do
199 if LowerCase(FSections
[a
]) = LowerCase(Section
) then
207 p
:= LowerCase(Param
);
209 for a
:= 0 to High(FParams
) do
210 if (FParams
[a
].Section
= s
) and (LowerCase(FParams
[a
].Param
) = p
) then
212 Result
:= FParams
[a
].Value
;
217 function TConfig
.ReadStr(Section
, Param
, Default
: string): string;
219 Result
:= ReadParam(Section
, Param
, Default
);
222 procedure TConfig
.SaveFile(FileName
: string);
228 AssignFile(f
, FileName
);
230 if (FSections
<> nil) or (FParams
<> nil) then
232 if FSections
<> nil then
233 for a
:= 0 to High(FSections
) do
235 if FSections
[a
] <> '' then Writeln(f
, '['+FSections
[a
]+']');
237 if FParams
<> nil then
238 for b
:= 0 to High(FParams
) do
239 if FParams
[b
].Section
= a
then WriteLn(f
, FParams
[b
].Param
+'='+FParams
[b
].Value
);
241 if (a
<> High(FSections
)) and (FSections
[a
] <> '') then WriteLn(f
, '');
247 function TConfig
.SectionExists(Section
: string): Boolean;
253 if FSections
= nil then Exit
;
255 Section
:= LowerCase(Section
);
257 for a
:= 0 to High(FSections
) do
258 if Section
= LowerCase(FSections
[a
]) then
265 procedure TConfig
.WriteBool(Section
, Param
: string; Value
: Boolean);
267 WriteParam(Section
, Param
, BoolToStr(Value
));
270 procedure TConfig
.WriteInt(Section
, Param
: string; Value
: Integer);
272 WriteParam(Section
, Param
, IntToStr(Value
));
275 procedure TConfig
.WriteParam(Section
, Param
, Value
: string);
285 if FSections
<> nil then
286 for a
:= 0 to High(FSections
) do
287 if FSections
[a
] = Section
then
295 SetLength(FSections
, Length(FSections
)+1);
296 a
:= High(FSections
);
297 FSections
[a
] := Section
;
301 if FParams
<> nil then
302 for b
:= 0 to High(FParams
) do
303 if (LowerCase(FParams
[b
].Param
) = LowerCase(Param
)) and (FParams
[b
].Section
= a
) then
309 if ok
then FParams
[b
].Value
:= Value
312 SetLength(FParams
, Length(FParams
)+1);
313 FParams
[High(FParams
)].Param
:= Param
;
314 FParams
[High(FParams
)].Value
:= Value
;
315 FParams
[High(FParams
)].Section
:= a
;
319 procedure TConfig
.WriteStr(Section
, Param
, Value
: string);
321 WriteParam(Section
, Param
, Value
);