src/shared/CONFIG.pas

   1 (* Copyright (C)  DooM 2D:Forever Developers
   2  *
   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.
   7  *
   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.
  12  *
  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/>.
  15  *)
  16 {$INCLUDE a_modes.inc}
  17 unit CONFIG;
  18
  19 {
  20 -----------------------------------
  21 CONFIG.PAS ÂÅÐÑÈß ÎÒ 24.09.06
  22 -----------------------------------
  23 }
  24
  25 interface
  26
  27 uses
  28   mempool;
  29
  30 type
  31   TParam = record
  32    Param: ShortString;
  33    Value: ShortString;
  34    Section: Word;
  35   end;
  36
  37   TConfig = class(TPoolObject)
  38    private
  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);
  45    public
  46     constructor Create();
  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);
  59    end;
  60
  61 implementation
  62
  63 uses
  64   SysUtils, BinEditor;
  65
  66 { TConfig }
  67
  68 constructor TConfig.Create();
  69 begin
  70  inherited Create;
  71
  72  FreeConfig();
  73 end;
  74
  75 constructor TConfig.CreateFile(FileName: string);
  76 var
  77   f: TextFile;
  78   a: string;
  79 begin
  80  FreeConfig();
  81
  82  if not FileExists(FileName) then Exit;
  83
  84  AssignFile(f, FileName);
  85  Reset(f);
  86  while not EOF(f) do
  87  begin
  88   Readln(f, a);
  89   ProcessStr(a);
  90  end;
  91  CloseFile(f);
  92 end;
  93
  94 constructor TConfig.CreateMem(pData: Pointer; _Length: LongWord);
  95 var
  96   a: Integer;
  97   str: string;
  98 begin
  99  FreeConfig();
 100
 101  if _Length = 0 then Exit;
 102  if pData = nil then Exit;
 103
 104  SetLength(str, _Length);
 105
 106  CopyMemory(@str[1], pData, _Length);
 107
 108  while Str <> '' do
 109  begin
 110   for a := 2 to Length(Str) do
 111    if (Str[a-1]+Str[a] = #13#10) or (a = Length(Str)) then
 112    begin
 113     if a <> Length(Str) then ProcessStr(Copy(Str, 1, a-2)) else ProcessStr(Str);
 114     Delete(Str, 1, a);
 115     Str := Trim(Str);
 116     Break;
 117    end;
 118  end;
 119 end;
 120
 121 destructor TConfig.Destroy();
 122 begin
 123  FParams := nil;
 124  FSections := nil;
 125
 126  inherited;
 127 end;
 128
 129 procedure TConfig.FreeConfig();
 130 begin
 131  FParams := nil;
 132  FSections := nil;
 133
 134  SetLength(FSections, 1);
 135  FSections[0] := '';
 136  FCurrentSection := 0;
 137 end;
 138
 139 procedure TConfig.ProcessStr(Str: string);
 140 var
 141   a, l: Integer;
 142 begin
 143  Str := Trim(Str);
 144
 145  if (Str <> '') and (Length(Str) > 2) and (Str[1] <> ';') then
 146  begin
 147   l := Length(Str);
 148
 149   if Pos('=', Str) > 0  then
 150   begin
 151    SetLength(FParams, Length(FParams)+1);
 152
 153    with FParams[High(FParams)] do
 154    begin
 155     a := Pos('=', Str);
 156     Param := Trim(Copy(Str, 1, a-1));
 157     Value := Trim(Copy(Str, a+1, l));
 158     Section := FCurrentSection;
 159    end;
 160   end
 161    else if (Str[1] = '[') and (Str[l] = ']') then
 162   begin
 163    SetLength(FSections, Length(FSections)+1);
 164    FCurrentSection := High(FSections);
 165    FSections[FCurrentSection] := Trim(Copy(Str, 2, l-2));
 166   end;
 167  end;
 168 end;
 169
 170 function TConfig.ReadBool(Section, Param: string; Default: Boolean): Boolean;
 171 var
 172   a: Integer;
 173 begin
 174  if Default then a := 1 else a := 0;
 175
 176  Result := StrToIntDef(ReadParam(Section, Param, IntToStr(a)), a) <> 0;
 177 end;
 178
 179 function TConfig.ReadInt(Section, Param: string; Default: Integer): Integer;
 180 begin
 181  Result := StrToIntDef(ReadParam(Section, Param, IntToStr(Default)), Default);
 182 end;
 183
 184 function TConfig.ReadParam(Section, Param, Default: string): string;
 185 var
 186   a: Integer;
 187   s: Word;
 188   ok: Boolean;
 189   p: string;
 190 begin
 191  Result := default;
 192
 193  if FParams = nil then Exit;
 194  if FSections = nil then Exit;
 195
 196  ok := False;
 197  s := 0;
 198  for a := 0 to High(FSections) do
 199   if LowerCase(FSections[a]) = LowerCase(Section) then
 200   begin
 201    s := a;
 202    ok := True;
 203   end;
 204
 205  if not ok then Exit;
 206
 207  p := LowerCase(Param);
 208
 209  for a := 0 to High(FParams) do
 210   if (FParams[a].Section = s) and (LowerCase(FParams[a].Param) = p) then
 211   begin
 212    Result := FParams[a].Value;
 213    Break;
 214   end;
 215 end;
 216
 217 function TConfig.ReadStr(Section, Param, Default: string): string;
 218 begin
 219  Result := ReadParam(Section, Param, Default);
 220 end;
 221
 222 procedure TConfig.SaveFile(FileName: string);
 223 var
 224   f: TextFile;
 225   a: Integer;
 226   b: Integer;
 227 begin
 228  AssignFile(f, FileName);
 229  Rewrite(f);
 230  if (FSections <> nil) or (FParams <> nil) then
 231  begin
 232   if FSections <> nil then
 233    for a := 0 to High(FSections) do
 234    begin
 235     if FSections[a] <> '' then Writeln(f, '['+FSections[a]+']');
 236
 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);
 240
 241     if (a <> High(FSections)) and (FSections[a] <> '') then WriteLn(f, '');
 242    end;
 243  end;
 244  CloseFile(f);
 245 end;
 246
 247 function TConfig.SectionExists(Section: string): Boolean;
 248 var
 249   a: Integer;
 250 begin
 251  Result := False;
 252
 253  if FSections = nil then Exit;
 254
 255  Section := LowerCase(Section);
 256
 257  for a := 0 to High(FSections) do
 258   if Section = LowerCase(FSections[a]) then
 259   begin
 260    Result := True;
 261    Exit;
 262   end;
 263 end;
 264
 265 procedure TConfig.WriteBool(Section, Param: string; Value: Boolean);
 266 begin
 267  WriteParam(Section, Param, BoolToStr(Value));
 268 end;
 269
 270 procedure TConfig.WriteInt(Section, Param: string; Value: Integer);
 271 begin
 272  WriteParam(Section, Param, IntToStr(Value));
 273 end;
 274
 275 procedure TConfig.WriteParam(Section, Param, Value: string);
 276 var
 277   a, b: Integer;
 278   ok: Boolean;
 279 begin
 280  a := 0;
 281  b := 0;
 282
 283  ok := False;
 284
 285  if FSections <> nil then
 286   for a := 0 to High(FSections) do
 287    if FSections[a] = Section then
 288    begin
 289     ok := True;
 290     Break;
 291    end;
 292
 293  if not ok then
 294  begin
 295   SetLength(FSections, Length(FSections)+1);
 296   a := High(FSections);
 297   FSections[a] := Section;
 298  end;
 299
 300  ok := False;
 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
 304    begin
 305     ok := True;
 306     Break;
 307    end;
 308
 309  if ok then FParams[b].Value := Value
 310   else
 311  begin
 312   SetLength(FParams, Length(FParams)+1);
 313   FParams[High(FParams)].Param := Param;
 314   FParams[High(FParams)].Value := Value;
 315   FParams[High(FParams)].Section := a;
 316  end;
 317 end;
 318
 319 procedure TConfig.WriteStr(Section, Param, Value: string);
 320 begin
 321  WriteParam(Section, Param, Value);
 322 end;
 323
 324 end.