src/shared/CONFIG.pas

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