5 -----------------------------------
6 CONFIG.PAS ÂÅÐÑÈß ÎÒ 24.09.06
7 -----------------------------------
19 TConfig
= class(TObject
)
21 FParams
: array of TParam
;
22 FSections
: array of ShortString;
23 FCurrentSection
: Word;
24 function ReadParam(Section
, Param
, Default
: string): string;
25 procedure WriteParam(Section
, Param
, Value
: string);
26 procedure ProcessStr(Str
: string);
29 constructor CreateFile(FileName
: string);
30 constructor CreateMem(pData
: Pointer; _Length
: LongWord);
31 destructor Destroy(); override;
32 procedure FreeConfig();
33 procedure SaveFile(FileName
: string);
34 function ReadInt(Section
, Param
: string; Default
: Integer): Integer;
35 function ReadStr(Section
, Param
: string; Default
: String): string;
36 function ReadBool(Section
, Param
: string; Default
: Boolean): Boolean;
37 function SectionExists(Section
: string): Boolean;
38 procedure WriteInt(Section
, Param
: string; Value
: Integer);
39 procedure WriteStr(Section
, Param
, Value
: string);
40 procedure WriteBool(Section
, Param
: string; Value
: Boolean);
50 constructor TConfig
.Create();
57 constructor TConfig
.CreateFile(FileName
: string);
64 if not FileExists(FileName
) then Exit
;
66 AssignFile(f
, FileName
);
76 constructor TConfig
.CreateMem(pData
: Pointer; _Length
: LongWord);
83 if _Length
= 0 then Exit
;
84 if pData
= nil then Exit
;
86 SetLength(str
, _Length
);
88 CopyMemory(@str
[1], pData
, _Length
);
92 for a
:= 2 to Length(Str
) do
93 if (Str
[a
-1]+Str
[a
] = #13#10) or (a
= Length(Str
)) then
95 if a
<> Length(Str
) then ProcessStr(Copy(Str
, 1, a
-2)) else ProcessStr(Str
);
103 destructor TConfig
.Destroy();
111 procedure TConfig
.FreeConfig();
116 SetLength(FSections
, 1);
118 FCurrentSection
:= 0;
121 procedure TConfig
.ProcessStr(Str
: string);
127 if (Str
<> '') and (Length(Str
) > 2) and (Str
[1] <> ';') then
131 if Pos('=', Str
) > 0 then
133 SetLength(FParams
, Length(FParams
)+1);
135 with FParams
[High(FParams
)] do
138 Param
:= Trim(Copy(Str
, 1, a
-1));
139 Value
:= Trim(Copy(Str
, a
+1, l
));
140 Section
:= FCurrentSection
;
143 else if (Str
[1] = '[') and (Str
[l
] = ']') then
145 SetLength(FSections
, Length(FSections
)+1);
146 FCurrentSection
:= High(FSections
);
147 FSections
[FCurrentSection
] := Trim(Copy(Str
, 2, l
-2));
152 function TConfig
.ReadBool(Section
, Param
: string; Default
: Boolean): Boolean;
156 if Default
then a
:= 1 else a
:= 0;
158 Result
:= StrToIntDef(ReadParam(Section
, Param
, IntToStr(a
)), a
) <> 0;
161 function TConfig
.ReadInt(Section
, Param
: string; Default
: Integer): Integer;
163 Result
:= StrToIntDef(ReadParam(Section
, Param
, IntToStr(Default
)), Default
);
166 function TConfig
.ReadParam(Section
, Param
, Default
: string): string;
175 if FParams
= nil then Exit
;
176 if FSections
= nil then Exit
;
180 for a
:= 0 to High(FSections
) do
181 if LowerCase(FSections
[a
]) = LowerCase(Section
) then
189 p
:= LowerCase(Param
);
191 for a
:= 0 to High(FParams
) do
192 if (FParams
[a
].Section
= s
) and (LowerCase(FParams
[a
].Param
) = p
) then
194 Result
:= FParams
[a
].Value
;
199 function TConfig
.ReadStr(Section
, Param
, Default
: string): string;
201 Result
:= ReadParam(Section
, Param
, Default
);
204 procedure TConfig
.SaveFile(FileName
: string);
210 AssignFile(f
, FileName
);
212 if (FSections
<> nil) or (FParams
<> nil) then
214 if FSections
<> nil then
215 for a
:= 0 to High(FSections
) do
217 if FSections
[a
] <> '' then Writeln(f
, '['+FSections
[a
]+']');
219 if FParams
<> nil then
220 for b
:= 0 to High(FParams
) do
221 if FParams
[b
].Section
= a
then WriteLn(f
, FParams
[b
].Param
+'='+FParams
[b
].Value
);
223 if (a
<> High(FSections
)) and (FSections
[a
] <> '') then WriteLn(f
, '');
229 function TConfig
.SectionExists(Section
: string): Boolean;
235 if FSections
= nil then Exit
;
237 Section
:= LowerCase(Section
);
239 for a
:= 0 to High(FSections
) do
240 if Section
= LowerCase(FSections
[a
]) then
247 procedure TConfig
.WriteBool(Section
, Param
: string; Value
: Boolean);
249 WriteParam(Section
, Param
, BoolToStr(Value
));
252 procedure TConfig
.WriteInt(Section
, Param
: string; Value
: Integer);
254 WriteParam(Section
, Param
, IntToStr(Value
));
257 procedure TConfig
.WriteParam(Section
, Param
, Value
: string);
267 if FSections
<> nil then
268 for a
:= 0 to High(FSections
) do
269 if FSections
[a
] = Section
then
277 SetLength(FSections
, Length(FSections
)+1);
278 a
:= High(FSections
);
279 FSections
[a
] := Section
;
283 if FParams
<> nil then
284 for b
:= 0 to High(FParams
) do
285 if (LowerCase(FParams
[b
].Param
) = LowerCase(Param
)) and (FParams
[b
].Section
= a
) then
291 if ok
then FParams
[b
].Value
:= Value
294 SetLength(FParams
, Length(FParams
)+1);
295 FParams
[High(FParams
)].Param
:= Param
;
296 FParams
[High(FParams
)].Value
:= Value
;
297 FParams
[High(FParams
)].Section
:= a
;
301 procedure TConfig
.WriteStr(Section
, Param
, Value
: string);
303 WriteParam(Section
, Param
, Value
);