src/shared/CONFIG.pas

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