src/shared/CONFIG.pas

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