unit CfgFiles;
interface
uses
Classes;
type
TCfgFile =
class
private
fFileName :
string;
fChanged : Boolean;
fContent : TStrings;
protected
function VariableStr(
const Variable :
string ) :
string;
function GetVariableRow(
const Variable :
string ) : Integer;
public
constructor Create(
const FileName :
string );
destructor Destroy;
override;
function VarExists(
const Variable :
string ) : Boolean;
procedure Delete(
const Variable :
string );
function ReadString(
const Variable,
Default :
string ) :
string;
procedure WriteString(
const Variable, Value :
string );
function ReadInteger(
const Variable :
string;
Default : LongInt ) : LongInt;
procedure WriteInteger(
const Variable :
string; Value : LongInt );
function ReadBool(
const Variable :
string;
Default : Boolean ) : Boolean;
procedure WriteBool(
const Variable :
string; Value : Boolean );
function ReadDate(
const Variable :
string;
Default : TDateTime ) : TDateTime;
function ReadDateTime(
const Variable :
string;
Default : TDateTime ) : TDateTime;
function ReadFloat(
const Variable :
string;
Default : Double ) : Double;
function ReadTime(
const Variable :
string;
Default : TDateTime ) : TDateTime;
procedure WriteDate(
const Variable :
string; Value : TDateTime );
virtual;
procedure WriteDateTime(
const Variable :
string; Value : TDateTime );
virtual;
procedure WriteFloat(
const Variable :
string; Value : Double );
virtual;
procedure WriteTime(
const Variable :
string; Value : TDateTime );
virtual;
procedure UpdateFile;
end;
implementation
uses
SysUtils;
{ TCfgFile }
constructor TCfgFile.Create(
const FileName :
string );
begin
inherited Create;
fFileName := FileName;
fContent := TStringList.Create;
if FileExists( fFileName )
then
fContent.LoadFromFile( fFileName );
end;
procedure TCfgFile.Delete(
const Variable :
string );
var
idx : Integer;
begin
idx := GetVariableRow( Variable );
if idx < 0
then
Exit;
fContent.Delete( idx );
fChanged := True;
end;
destructor TCfgFile.Destroy;
begin
UpdateFile;
inherited;
end;
function TCfgFile.GetVariableRow(
const Variable :
string ) : Integer;
var
idx : Integer;
SearchStr :
string;
begin
Result := -1;
SearchStr := VariableStr( Variable );
for idx := 0
to fContent.Count - 1
do
if Pos( SearchStr, Trim( fContent[idx] ) ) = 1
then
begin
Result := idx;
Break;
end;
end;
function TCfgFile.ReadString(
const Variable,
Default :
string ) :
string;
var
idx : Integer;
SearchStr :
string;
SearchRow :
string;
begin
Result :=
Default;
idx := GetVariableRow( Variable );
if idx < 0
then
Exit;
SearchStr := VariableStr( Variable );
SearchRow := fContent[idx];
Result := Copy( SearchRow, Pos( SearchStr, SearchRow ) + Length( SearchStr ) );
end;
procedure TCfgFile.UpdateFile;
begin
if fChanged
then
begin
fContent.SaveToFile( fFileName );
fChanged := False;
end;
end;
function TCfgFile.VarExists(
const Variable :
string ) : Boolean;
begin
Result :=
not( GetVariableRow( Variable ) < 0 );
end;
function TCfgFile.VariableStr(
const Variable :
string ) :
string;
begin
Result := '
@' + Variable + '
: ';
end;
procedure TCfgFile.WriteString(
const Variable, Value :
string );
var
idx : Integer;
begin
idx := GetVariableRow( Variable );
if idx < 0
then
fContent.Add( VariableStr( Variable ) + Value )
else
begin
fContent[idx] := VariableStr( Variable ) + Value;
end;
fChanged := True;
end;
//
// Ab hier war es quasi nur reines Kopieren von TIniFile
//
function TCfgFile.ReadBool(
const Variable :
string;
Default : Boolean ) : Boolean;
begin
Result := ReadInteger( Variable, Ord(
Default ) ) <> 0;
end;
function TCfgFile.ReadDate(
const Variable :
string;
Default : TDateTime ) : TDateTime;
var
DateStr :
string;
begin
DateStr := ReadString( Variable, '
' );
Result :=
Default;
if DateStr <> '
'
then
try
Result := StrToDate( DateStr );
except
on EConvertError
do
// Ignore EConvertError exceptions
else
raise;
end;
end;
function TCfgFile.ReadDateTime(
const Variable :
string;
Default : TDateTime ) : TDateTime;
var
DateStr :
string;
begin
DateStr := ReadString( Variable, '
' );
Result :=
Default;
if DateStr <> '
'
then
try
Result := StrToDateTime( DateStr );
except
on EConvertError
do
// Ignore EConvertError exceptions
else
raise;
end;
end;
function TCfgFile.ReadFloat(
const Variable :
string;
Default : Double ) : Double;
var
FloatStr :
string;
begin
FloatStr := ReadString( Variable, '
' );
Result :=
Default;
if FloatStr <> '
'
then
try
Result := StrToFloat( FloatStr );
except
on EConvertError
do
// Ignore EConvertError exceptions
else
raise;
end;
end;
function TCfgFile.ReadTime(
const Variable :
string;
Default : TDateTime ) : TDateTime;
var
TimeStr :
string;
begin
TimeStr := ReadString( Variable, '
' );
Result :=
Default;
if TimeStr <> '
'
then
try
Result := StrToTime( TimeStr );
except
on EConvertError
do
// Ignore EConvertError exceptions
else
raise;
end;
end;
function TCfgFile.ReadInteger(
const Variable :
string;
Default : LongInt ) : LongInt;
var
IntStr :
string;
begin
IntStr := ReadString( Variable, '
' );
if ( Length( IntStr ) > 2 )
and ( IntStr[1] = '
0' )
and ( ( IntStr[2] = '
X' )
or ( IntStr[2] = '
x' ) )
then
IntStr := '
$' + Copy( IntStr, 3, Maxint );
Result := StrToIntDef( IntStr,
Default );
end;
procedure TCfgFile.WriteBool(
const Variable :
string; Value : Boolean );
const
Values :
array [Boolean]
of string = ( '
0', '
1' );
begin
WriteString( Variable, Values[Value] );
end;
procedure TCfgFile.WriteDate(
const Variable :
string; Value : TDateTime );
begin
WriteString( Variable, DateToStr( Value ) );
end;
procedure TCfgFile.WriteDateTime(
const Variable :
string; Value : TDateTime );
begin
WriteString( Variable, DateTimeToStr( Value ) );
end;
procedure TCfgFile.WriteFloat(
const Variable :
string; Value : Double );
begin
WriteString( Variable, FloatToStr( Value ) );
end;
procedure TCfgFile.WriteInteger(
const Variable :
string; Value : LongInt );
begin
WriteString( Variable, IntToStr( Value ) );
end;
procedure TCfgFile.WriteTime(
const Variable :
string; Value : TDateTime );
begin
WriteString( Variable, TimeToStr( Value ) );
end;
end.