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