4 -----------------------------------
5 CONFIG.PAS ÂÅÐÑÈß ÎÒ 24.09.06
6 -----------------------------------
18 TConfig
= class(TObject
)
20 FParams
: array of TParam
;
21 FSections
: array of ShortString;
22 FCurrentSection
: Word;
23 function ReadParam(Section
, Param
, Default
: string): string;
24 procedure WriteParam(Section
, Param
, Value
: string);
25 procedure ProcessStr(Str
: string);
28 constructor CreateFile(FileName
: string);
29 constructor CreateMem(pData
: Pointer; _Length
: LongWord);
30 destructor Destroy(); override;
31 procedure FreeConfig();
32 procedure SaveFile(FileName
: string);
33 function ReadInt(Section
, Param
: string; Default
: Integer): Integer;
34 function ReadStr(Section
, Param
: string; Default
: String): string;
35 function ReadBool(Section
, Param
: string; Default
: Boolean): Boolean;
36 function SectionExists(Section
: string): Boolean;
37 procedure WriteInt(Section
, Param
: string; Value
: Integer);
38 procedure WriteStr(Section
, Param
, Value
: string);
39 procedure WriteBool(Section
, Param
: string; Value
: Boolean);
49 constructor TConfig
.Create();
56 constructor TConfig
.CreateFile(FileName
: string);
63 if not FileExists(FileName
) then Exit
;
65 AssignFile(f
, FileName
);
75 constructor TConfig
.CreateMem(pData
: Pointer; _Length
: LongWord);
82 if _Length
= 0 then Exit
;
83 if pData
= nil then Exit
;
85 SetLength(str
, _Length
);
87 CopyMemory(@str
[1], pData
, _Length
);
91 for a
:= 2 to Length(Str
) do
92 if (Str
[a
-1]+Str
[a
] = #13#10) or (a
= Length(Str
)) then
94 if a
<> Length(Str
) then ProcessStr(Copy(Str
, 1, a
-2)) else ProcessStr(Str
);
102 destructor TConfig
.Destroy();
110 procedure TConfig
.FreeConfig();
115 SetLength(FSections
, 1);
117 FCurrentSection
:= 0;
120 procedure TConfig
.ProcessStr(Str
: string);
126 if (Str
<> '') and (Length(Str
) > 2) and (Str
[1] <> ';') then
130 if Pos('=', Str
) > 0 then
132 SetLength(FParams
, Length(FParams
)+1);
134 with FParams
[High(FParams
)] do
137 Param
:= Trim(Copy(Str
, 1, a
-1));
138 Value
:= Trim(Copy(Str
, a
+1, l
));
139 Section
:= FCurrentSection
;
142 else if (Str
[1] = '[') and (Str
[l
] = ']') then
144 SetLength(FSections
, Length(FSections
)+1);
145 FCurrentSection
:= High(FSections
);
146 FSections
[FCurrentSection
] := Trim(Copy(Str
, 2, l
-2));
151 function TConfig
.ReadBool(Section
, Param
: string; Default
: Boolean): Boolean;
155 if Default
then a
:= 1 else a
:= 0;
157 Result
:= StrToIntDef(ReadParam(Section
, Param
, IntToStr(a
)), a
) <> 0;
160 function TConfig
.ReadInt(Section
, Param
: string; Default
: Integer): Integer;
162 Result
:= StrToIntDef(ReadParam(Section
, Param
, IntToStr(Default
)), Default
);
165 function TConfig
.ReadParam(Section
, Param
, Default
: string): string;
174 if FParams
= nil then Exit
;
175 if FSections
= nil then Exit
;
179 for a
:= 0 to High(FSections
) do
180 if LowerCase(FSections
[a
]) = LowerCase(Section
) then
188 p
:= LowerCase(Param
);
190 for a
:= 0 to High(FParams
) do
191 if (FParams
[a
].Section
= s
) and (LowerCase(FParams
[a
].Param
) = p
) then
193 Result
:= FParams
[a
].Value
;
198 function TConfig
.ReadStr(Section
, Param
, Default
: string): string;
200 Result
:= ReadParam(Section
, Param
, Default
);
203 procedure TConfig
.SaveFile(FileName
: string);
209 AssignFile(f
, FileName
);
211 if (FSections
<> nil) or (FParams
<> nil) then
213 if FSections
<> nil then
214 for a
:= 0 to High(FSections
) do
216 if FSections
[a
] <> '' then Writeln(f
, '['+FSections
[a
]+']');
218 if FParams
<> nil then
219 for b
:= 0 to High(FParams
) do
220 if FParams
[b
].Section
= a
then WriteLn(f
, FParams
[b
].Param
+'='+FParams
[b
].Value
);
222 if (a
<> High(FSections
)) and (FSections
[a
] <> '') then WriteLn(f
, '');
228 function TConfig
.SectionExists(Section
: string): Boolean;
234 if FSections
= nil then Exit
;
236 Section
:= LowerCase(Section
);
238 for a
:= 0 to High(FSections
) do
239 if Section
= LowerCase(FSections
[a
]) then
246 procedure TConfig
.WriteBool(Section
, Param
: string; Value
: Boolean);
248 WriteParam(Section
, Param
, BoolToStr(Value
));
251 procedure TConfig
.WriteInt(Section
, Param
: string; Value
: Integer);
253 WriteParam(Section
, Param
, IntToStr(Value
));
256 procedure TConfig
.WriteParam(Section
, Param
, Value
: string);
266 if FSections
<> nil then
267 for a
:= 0 to High(FSections
) do
268 if FSections
[a
] = Section
then
276 SetLength(FSections
, Length(FSections
)+1);
277 a
:= High(FSections
);
278 FSections
[a
] := Section
;
282 if FParams
<> nil then
283 for b
:= 0 to High(FParams
) do
284 if (LowerCase(FParams
[b
].Param
) = LowerCase(Param
)) and (FParams
[b
].Section
= a
) then
290 if ok
then FParams
[b
].Value
:= Value
293 SetLength(FParams
, Length(FParams
)+1);
294 FParams
[High(FParams
)].Param
:= Param
;
295 FParams
[High(FParams
)].Value
:= Value
;
296 FParams
[High(FParams
)].Section
:= a
;
300 procedure TConfig
.WriteStr(Section
, Param
, Value
: string);
302 WriteParam(Section
, Param
, Value
);