unit PropUtl;

interface
uses
  SysUtils, Classes, TypInfo, Stru
  {v0.39}, {confu conftype} BinHex, UtlType, WinUtl, IniFiles{/v0.39};

{v0.39}
const
  DefValidDigits = 6;
{/v0.39}

type
  EUnsupportedTypeKind = class(Exception);
  EUnsupportedOrdType = class(Exception);
  EUnsupportedFloatType = class(Exception);

function ClassGetPropStr(c: TObject; j: integer;
  var AValue: AnsiString): boolean; overload;
{v0.47}
function ClassGetPropStr(c: TObject; APropInfo: PPropInfo): string; overload;
{/v0.47}

function ClassGetPropNameAndValue(c: TObject; j: integer; var AName: shortstring;
  var AValue: AnsiString): boolean;
{ returns true if j is valid index in c's properties and sets AName to the
  name of property of given index and AValue to it's value;
  returns false if j is out of range }

function ClassSetPropStr(c: TObject; const AName: shortstring;
  const AValue: AnsiString): integer;overload;
{ returns > 0 if c has property of name AName and sets it's value to AValue;
  the return value is size of the property (if tkLString then its sum of
  length(string) + 4 i.e. size used to store it to stream),
  returns 0 if c has no property with name AName }

function ClassSetPropStr(c: TObject; i: integer; const AValue: AnsiString): integer;overload;

{v0.47}
function ClassSetPropStr(c: TObject; APropInfo: PPropInfo; const AValue: AnsiString): integer; overload;
{/v0.47}


function FillEnumNames(c: TObject; const AName: string; Items: TStrings): boolean;overload;
  { Fills Items with names of allowed values for property AName of object c }
{v0.24}
function FillEnumNames(APropInfo: PPropInfo; Items: TStrings): boolean;overload;
{/v0.24}

{v0.44}
function FillSetEnumNames(c: TObject; const AName: string; Items: TStrings): boolean; overload;
  { calls FillEnumNames for the set property's enum prop }
function FillSetEnumNames(APropInfo: PPropInfo; Items: TStrings): boolean; overload;

function SetToStr(ASetInt: integer; Items: TStrings): string;
  { converts bitflags in ASetInt to string using Items stringlist with enumnames }
function StrToSet(const ASetStr: string; Items: TStrings): integer;
  { converts setstr got by SetToStr to ASetInt using enumnames in Items }
{/v0.44}


function FillPropNames(c: TObject; const AfterName: string;
  var FirstPropIndex:integer; Items: TStrings): boolean;
  { Fill Items with names of properties published in given object c;
    if AfterName <> '', then fills only with names of those properties that
    are defined after property of the name AfterName and the FirstPropIndex is set
    to the index of the first property that is after AfterName property. }

function GetPropIndex(c: TObject; const APropName: string): integer;
  { Returns index of the objects' published property with a name = APropName;
    -1 if not found. }

function ClassSumStringLength(c: TObject): integer;
  { return sum of all lengths of all c's published properties of
    type = tkLString }

function ClassReadPropsFromStream(c: TObject; FromPropIndex: integer;
  {v0.06}MaxSize: integer; {/v0.06} AStream: TStream): integer;
  { Read values of all published properties with field index value FromPropIndex
    and higher from AStream (if MaxSize <> 0, then reads from stream maximaly
    that count of bytes) }

function ClassWritePropsToStream(c: TObject; FromPropIndex: integer; AStream: TStream): integer;
  { Read values of all published properties with field index value = FromPropIndex
    and higher from AStream }

{v0.21}
{function GetClass(const AClassTypeName: string): TClass;}
{/v0.21}

{v0.22}
function ClassGetMethod(c: TObject; const AMethodName: shortstring;
  var AMethod: TMethod): boolean; overload;

function ClassGetMethod(c: TObject; i: integer;
  var AMethod: TMethod): boolean;overload;

function ClassSetMethod(c: TObject; const AMethodName: shortstring;
  const AMethod: TMethod): boolean; overload;
function ClassSetMethod(c: TObject; i: integer; const AMethod: TMethod): boolean; overload;
{/v0.22}

{v0.23}
function ClassGetPropInfo(c: TObject; const APropName: string; var APropInfo: PPropInfo): boolean;
{/v0.23}

{v0.39}
function ClassReadPropsFromFile(c: TObject; FromPropIndex: integer;
  MaxSize: integer; const AFileName: string): integer;
  { Read values of all published properties with field index value FromPropIndex
    and higher from FileName (if MaxSize <> 0, then reads from stream maximaly
    that count of bytes) }

function ClassWritePropsToFile(c: TObject; FromPropIndex: integer;
  const AFileName: string): integer;
  { Read values of all published properties with field index value = FromPropIndex
    and higher from FileName }
procedure ClassReadWriteIniFile(c: TComponent; {v0.40}FromPropIndex: integer; {/v0.40}const AFileName: string; Read: boolean);

procedure ConfigReadWriteValue(AIniFile: TIniFile; what:TReadWrite; const ASection: string;
  AName: string; AAddress: pointer; ATyp: TPropertyType);
{/v0.39}
{v0.48}
function GetTypeSize(tk: TTypeKind; const td: TTypeData): integer;
{/v0.48}

implementation

function GetTypeKindEnumName(tk: TTypeKind): shortstring;
begin
  GetTypeKindEnumName := inttostr(integer(tk));
end;

function GetEnumPropStr(c: TObject; pi: PPropInfo): shortstring;
var
  i: integer;
begin
  i := GetOrdProp(c, pi);
  GetEnumPropStr := GetEnumName(pi^.PropType^, i);
end;

procedure SetEnumPropStr(c: TObject; pi: PPropInfo; const AValue: shortstring);
var i: integer;
begin
  i := GetEnumValue(pi^.PropType^, AValue);
  SetOrdProp(c, pi, i);
end;

function GetPropIndex(c: TObject; const APropName: string): integer;
var
  ti: PTypeInfo;
  td: PTypeData;
  pl: TPropList;
  pi: PPropInfo;
  j:integer;
begin
  Result := -1;
  ti := PTypeInfo(c.ClassInfo);
  td := PTypeData(GetTypeData(ti));
  GetPropInfos(ti, @pl);
  for j := 0 to td^.PropCount - 1 do begin
    pi := pl[j];
    if pi^.Name = APropName then begin
      Result := j;
      exit;
    end;
  end;
end;

{v0.23}
function ClassGetPropInfo(c: TObject; const APropName: string; var APropInfo: PPropInfo): boolean;
var
  ti: PTypeInfo;
  td: PTypeData;
  pl: TPropList;
  pi: PPropInfo;
  j:integer;
begin
  Result := false;
  APropInfo := nil;
  ti := PTypeInfo(c.ClassInfo);
  td := PTypeData(GetTypeData(ti));
  GetPropInfos(ti, @pl);
  for j := 0 to td^.PropCount - 1 do begin
    pi := pl[j];
    if pi^.Name = APropName then begin
      Result := true;
      APropInfo := pi;
      exit;
    end;
  end;
end;
{/v0.23}

{/v0.24}
function FillEnumNames(APropInfo: PPropInfo; Items: TStrings): boolean;
  { Fills Items with names of allowed values }
var
{  ti: PTypeInfo;}
  pi: PPropInfo;
  td: PTypeData;
  s: string;
  i: integer;
begin
  Result := false;
  pi := APropInfo;
  if pi = nil then
    exit;
  if pi^.PropType^^.Kind <> tkEnumeration then
    exit;
  if Items = nil then
    exit;
  {v0.31}
  Items.Clear;
  {/v0.31}
  td := GetTypeData(pi^.PropType^);
  if td = nil then
    exit;
  for i := td^.MinValue to td^.MaxValue do begin
    s := GetEnumName(pi^.PropType^, i);
    if s <> '' then begin
      Items.Add(s);
    end;
  end;
  Result := true;
end;
{/v0.24}

function FillEnumNames(c: TObject; const AName: string; Items: TStrings):boolean;
  { Fills Items with names of allowed values for property AName of object c }
var
  ti: PTypeInfo;
  pi: PPropInfo;
{v0.24}
{/v0.24
  td: PTypeData;
  s: string;
  i: integer;}
begin
  {v0.24}{/v0.24
  FillEnumNames := false;}
  ti := PTypeInfo(c.ClassInfo);
  pi := GetPropInfo(ti, AName);
  Result := FillEnumNames(pi, Items);
  {v0.24}{/v0.24
  if pi = nil then
    exit;
  if pi^.PropType^^.Kind <> tkEnumeration then
    exit;
  if Items = nil then
    exit;
  td := GetTypeData(pi^.PropType^);
  if td = nil then
    exit;
  for i := td^.MinValue to td^.MaxValue do begin
    s := GetEnumName(pi^.PropType^, i);
    if s <> '' then begin
      Items.Add(s);
    end;
  end;
  FillEnumNames := true;}
end;


{v0.44}

(*
function GetEnumName(TypeInfo: PTypeInfo; Value: Integer): string;
var
  P: ^ShortString;
  T: PTypeData;
begin
  if TypeInfo = System.TypeInfo(Boolean) then
  begin
    Result := BooleanIdents[Boolean(Value)];
    if CompareText(HexDisplayPrefix, '0x') = 0 then Result := LowerCase(Result);
    Exit;
  end;
  if TypeInfo^.Kind = tkInteger then
  begin
    Result := IntToStr(Value);
    Exit;
  end;
  T := GetTypeData(GetTypeData(TypeInfo)^.BaseType^);
  if T^.MinValue < 0 then      { must be LongBool/WordBool/ByteBool }
    Value := Ord(Value <> 0);  { map non-zero to true in this case  }
  P := @T^.NameList;
  while Value <> 0 do
  begin
    Inc(Integer(P), Length(P^) + 1);
    Dec(Value);
  end;
  Result := P^;
end;
*)

function FillSetEnumNames(APropInfo: PPropInfo; Items: TStrings): boolean;
var
  sti, eti: PTypeInfo;
  std, etd: PTypeData;
  i: integer;
  s: string;
begin
  Result := false;
  if APropInfo^.PropType^^.Kind <> tkSet then
    exit;
  sti := APropInfo^.PropType^;
  std := GetTypeData(sti);

  eti := std^.CompType^;
  etd := PTypeData(GetTypeData(eti));
  Items.Clear;
  for i := etd^.MinValue to etd^.MaxValue do begin
    if eti^.Kind = tkInteger then begin
      s := IntToStr(i);
    end else begin
      s := GetEnumName(eti, i);
    end;
    Items.Add(s);
  end;
end;
{
function GetSetProp(Instance: TObject; PropInfo: PPropInfo;
  Brackets: Boolean): string;
var
  S: TIntegerSet;
  TypeInfo: PTypeInfo;
  I: Integer;
begin
  Integer(S) := GetOrdProp(Instance, PropInfo);
  TypeInfo := GetTypeData(PropInfo^.PropType^)^.CompType^;
  for I := 0 to SizeOf(Integer) * 8 - 1 do
    if I in S then
    begin
      if Result <> '' then
        Result := Result + ',';
      Result := Result + GetEnumName(TypeInfo, I);
    end;
  if Brackets then
    Result := '[' + Result + ']';
end;
}

function FillSetEnumNames(c: TObject; const AName: string; Items: TStrings): boolean;
  { calls FillEnumNames for the set property's enum prop }
var
  ti: PTypeInfo;
  pi: PPropInfo;
begin
  ti := PTypeInfo(c.ClassInfo);
  pi := GetPropInfo(ti, AName);
  Result := FillSetEnumNames(pi, Items);
end;

function SetToStr(ASetInt: integer; Items: TStrings): string;
  { converts bitflags in ASetInt to string using Items stringlist with enumnames }
var
  b: integer;
  i: integer;
begin
  b := 1;
  Result := '';
  for i := 0 to sizeof(integer) * 8 - 1 do begin
    if i >= Items.Count then
      break;
    if (b and ASetInt) <> 0 then begin
      if Result <> '' then
        Result := Result + ',';
      Result := Result + Items[i];
    end;
    b := b shl 1;
  end;
end;

function StrToSet(const ASetStr: string; Items: TStrings): integer;
  { converts setstr got by SetToStr to ASetInt using enumnames in Items }
var
  s: string;
  i: integer;
begin
  Result := 0;
  s := ',' + ASetStr + ',';
  for i := 0 to Items.Count - 1 do begin
    if i >= sizeof(integer) * 8 then
      break;
    if pos(',' + Items[i] + ',', s) <> 0 then begin
      Result := Result or (1 shl i);
    end;
  end;
end;
{/v0.44}

function FillPropNames(c: TObject; const AfterName: string;
  var FirstPropIndex:integer; Items: TStrings):boolean;
  { Fill Items with names of properties published in given object c;
    if AfterName <> '', then fills only with names of those properties that
    are defined after property of the name AfterName and the FirstPropIndex is set
    to the index of the first property that is after AfterName property. }
var
  ti: PTypeInfo;
  td: PTypeData;
  pl: TPropList;
  pi: PPropInfo;
  j:integer;
  isAfter:boolean;
begin
  Result := false;
  if Items = nil then
    exit;
  Items.Clear;
  isAfter := (AfterName = '');
  FirstPropIndex := 0;
  ti := PTypeInfo(c.ClassInfo);
  td := PTypeData(GetTypeData(ti));
  GetPropInfos(ti, @pl);
  for j := 0 to td^.PropCount - 1 do begin
    pi := pl[j];
    if not isAfter then begin
      isAfter := (pi^.Name = AfterName);
      if isAfter then
        FirstPropIndex := j + 1;
    end else begin
      Items.Add(pi^.Name);
    end;
  end;
  Result := true;
end;

function GetTypeSize(tk: TTypeKind; const td: TTypeData): integer;
var r: integer;
begin
  case tk of
    {tkUnknown,}
    {v0.44}tkSet,{/v0.44} tkInteger, tkChar, tkEnumeration, tkWChar: begin
      case td.OrdType of
        otSByte, otUByte: r := 1;
        otSWord, otUWord: r := 2;
        otSLong: r := 4;
      else
       raise EUnsupportedOrdType.Create('GetTypeSize ' + IntToStr(ord(td.OrdType)));
      end;
    end;
    tkFloat: begin
      case td.FloatType of
        ftSingle: r := 4;
        ftDouble: r := 8;
        ftExtended: r := 10;
        ftComp: r := 8;
        ftCurr: r := 8;
      else
        raise EUnsupportedFloatType.Create('GetTypeSize ' + IntToStr(ord(td.FloatType)));
      end;
    end;
    tkString: begin
      r := td.MaxLength + 1;
    end;
    {v0.44}{/v0.44
    tkSet: begin
      r := 32
    end;}
    {tkClass,
    tkMethod,}
    {v0.22}
    tkMethod: begin
      r := sizeof(TMethod);{8 4;}
    end;
    {/v0.22}
    tkWString, tkLString: begin
      r := 4;
    end;
    {
    tkVariant,
    tkArray,
    tkRecord,
    tkInterface,
    tkInt64,
    tkDynArray);}
  else
    raise EUnsupportedTypeKind.Create('GetTypeSize ' + GetTypeKindEnumName(tk));
  end;
  Result := r;
end;

function ClassWritePropsToStream(c: TObject; FromPropIndex: integer; AStream: TStream): integer;
var
  ti: PTypeInfo;
  td, ttd: PTypeData;
  tk: TTypeKind;

  pl: TPropList;
  pi: PPropInfo;

  j : integer;
  size, startpos: integer;

  {b: byte;
  w: word;}
  l: longint;

  e: extended;
  s: Single absolute e;
  d: double absolute e;
  com: comp absolute e;
  cur: currency absolute e;

  ss: shortstring;

  st: string;
  strm: TStringStream;
  {v0.22}
  m: TMethod;
  {/v0.22}
  {v0.44}
{  sob: set of byte;}
  {/v0.44}
begin
  Result := 0;
  ti := PTypeInfo(c.ClassInfo);
  td := PTypeData(GetTypeData(ti));
  GetPropInfos(ti, @pl);
  if (FromPropIndex < 0) or (FromPropIndex >= td^.PropCount) then
    exit;
  j := FromPropIndex;
  startpos := AStream.Position;
  while j < td^.PropCount do begin
    pi := pl[j];
    ttd := PTypeData(GetTypeData(pi^.PropType^));
   {AName := pi^.Name;
    AValue := '';}
    tk := pi^.PropType^^.Kind;
    size := GetTypeSize(tk, ttd^);
    case tk of
      {v0.44}tkSet,{/v0.44}tkInteger, tkChar, tkEnumeration, tkWChar: begin
        l := GetOrdProp(c, pi);
        AStream.WriteBuffer(l, size);
      end;
      {v0.22}
      tkMethod: begin
        fillchar(m, size, 0);
        {size := 4;}
        AStream.WriteBuffer(m, size);
      end;
      {/v0.22}{variant}
      tkFloat: begin
        e := GetFloatProp(c, pi);
        case ttd^.FloatType of
          ftSingle: s := e;
          ftDouble: d := e;
          {ftExtended }
          ftComp: com := e;
          ftCurr: cur := e;
        end;
        AStream.WriteBuffer(e, size);
      end;
      tkString: begin
        ss := GetStrProp(c, pi);
        AStream.WriteBuffer(ss, size);
      end;
      {tkEnumeration: AValue := GetEnumPropStr(c, pi);}
      tkLString{, tkWString}: begin
        st := GetStrProp(c, pi);
        l := length(st);
        AStream.WriteBuffer(l, sizeof(l));
        if l > 0 then begin
          strm := TStringStream.Create(st);
          AStream.CopyFrom(strm, 0);
          strm.Free;
        end;
      end;
    else
      raise EUnsupportedTypeKind.Create('ClassWritePropsToStream ' + GetTypeKindEnumName(tk));
    end;
    inc(j);
  end;
  Result := AStream.Position - startpos;
end;

function ClassSumStringLength(c: TObject): integer;
  { return sum of all lengths of all c's properties of type = tkLString }
var
  ti: PTypeInfo;
  td: PTypeData;
  pl: TPropList;
  j : integer;
  l: longint;
begin
  l := 0;
  ti := PTypeInfo(c.ClassInfo);
  td := PTypeData(GetTypeData(ti));
  GetPropInfos(ti, @pl);
  for j := 0 to td^.PropCount - 1 do begin
    if pl[j]^.PropType^^.Kind = tkLString then begin
      inc(l, length(GetStrProp(c, pl[j])));
    end;
  end;
  Result := l;
end;


function ClassReadPropsFromStream(c: TObject; FromPropIndex: integer; MaxSize: integer; AStream: TStream): integer;
var
  ti: PTypeInfo;
  td: PTypeData;
  tk: tTypeKind;
  ttd: PTypeData;

  pl: TPropList;
  pi: PPropInfo;

  j : integer;
  size, startpos: integer;

  {b: byte;
  w: word;}
  l: longint;

  e: extended;
  s: Single absolute e;
  d: double absolute e;
  com: comp absolute e;
  cur: currency absolute e;

  ss: shortstring;

  st: string;
  strm: TStringStream;
  {v0.22}
  m: TMethod;
  {/v0.22}
begin
  Result := 0;
  {v0.24}
  if MaxSize = 0 then
    exit;
  {/v0.24}
  ti := PTypeInfo(c.ClassInfo);
  td := PTypeData(GetTypeData(ti));
  GetPropInfos(ti, @pl);
  if (FromPropIndex < 0) or (FromPropIndex >= td^.PropCount) then
    exit;
  j := FromPropIndex;
  startpos := AStream.Position;
  while j < td^.PropCount do begin
    pi := pl[j];
    ttd := PTypeData(GetTypeData(pi^.PropType^));
    {AName := pi^.Name;
    AValue := '';}
    tk := pi^.PropType^^.Kind;
    size := GetTypeSize(tk, ttd^);
    case tk of
      {v0.44}tkSet,{/v0.44}tkInteger, tkChar, tkEnumeration, tkWChar: begin
        l := 0;
        AStream.ReadBuffer(l, size);
        SetOrdProp(c, pi, l);
      end;
      {v0.22}
      tkMethod: begin
        AStream.ReadBuffer(m, size);
        fillchar(m, size, 0);
      end;
      {/v0.22}

      tkFloat: begin
        AStream.ReadBuffer(e, size);
        case ttd^.FloatType of
          ftSingle: e := s;
          ftDouble: e := d;
          {ftExtended }
          ftComp: e := com;
          ftCurr: e := cur;
        end;
        SetFloatProp(c, pi, e);
      end;
      tkString: begin
        AStream.ReadBuffer(ss, size);
        SetStrProp(c, pi, ss);
      end;
      {tkEnumeration: AValue := GetEnumPropStr(c, pi);}
      tkLString, tkWString: begin
        size := sizeof(l);
        AStream.ReadBuffer(l, size);
        if l > 0 then begin
          strm := TStringStream.Create('');
          strm.CopyFrom(AStream, l);
          st := strm.DataString;
          SetStrProp(c, pi, strm.DataString);
          strm.Free;
        end else begin
          SetStrProp(c, pi, '');
        end;
        {v0.14}
        size := l + size;
        {/v0.14}
      end;
    else
      raise EUnsupportedTypeKind.Create('ClassReadPropsFromStream ' + GetTypeKindEnumName(tk));
    end;
    inc(j);
    {v0.06}
    if MaxSize > 0 then begin
      dec(MaxSize, size);
      if MaxSize <= 0 then
        break;
    end;
    {/v0.06}
  end;
  Result := AStream.Position - startpos;
end;

{v0.45}
function GetFloatStr(c: TObject; pi: PPropInfo): string;
begin
  if pi^.PropType^^.Name = 'TDateTime' then begin
    Result := FloatToStr(GetFloatProp(c, pi));
  end else begin
    Result := FloatToRoundStr(GetFloatProp(c, pi), DefValidDigits, 0);
  end;
end;
{/v0.45}

function ClassGetPropStr(c: TObject; j: integer;
  var AValue: AnsiString): boolean;
var
  ti: PTypeInfo;
  td: PTypeData;
  pl: TPropList;
  pi: PPropInfo;
begin
  ClassGetPropStr := false;
  ti := PTypeInfo(c.ClassInfo);
  td := PTypeData(GetTypeData(ti));
  GetPropInfos(ti, @pl);
  if (j < 0) or (j >= td^.PropCount) then
    exit;
  pi := pl[j];
  (*v0.47*)
  AValue := ClassGetPropStr(c, pi);
  (*v0.47
  AValue := '';
  case pi^.PropType^^.Kind of
    tkInteger: AValue := IntToStr(GetOrdProp(c, pi));
    tkFloat: begin
      {v0.45}
      AValue := GetFloatStr(c, pi);
      {/v0.45
      AValue := FloatToRoundStr(GetFloatProp(c, pi), DefValidDigits, 0);}
    end;
    tkString, tkLString: AValue := GetStrProp(c, pi);
    tkEnumeration: begin
      AValue := GetEnumPropStr(c, pi);
    end;
    {v0.44}
    tkSet: AValue := IntToStr(GetOrdProp(c, pi));
    {/v0.44}
  end;
  *)
  ClassGetPropStr := true;
end;

{v0.47}
function ClassGetPropStr(c: TObject; APropInfo: PPropInfo): string;
begin
  Result := '';
  case APropInfo^.PropType^^.Kind of
    tkInteger: Result := IntToStr(GetOrdProp(c, APropInfo));
    tkFloat: Result := GetFloatStr(c, APropInfo);
    tkString, tkLString: Result := GetStrProp(c, APropInfo);
    tkEnumeration: Result := GetEnumPropStr(c, APropInfo);
    tkSet: Result := IntToStr(GetOrdProp(c, APropInfo));
  end;
end;

{v0.22}
{function ClassGetPropInt(c: TObject; j: integer;
  var AValue: integer): boolean;
var
  ti: PTypeInfo;
  td: PTypeData;
  pl: TPropList;
  pi: PPropInfo;
begin
  Result := false;
  ti := PTypeInfo(c.ClassInfo);
  td := PTypeData(GetTypeData(ti));
  GetPropInfos(ti, @pl);
  if (j < 0) or (j >= td^.PropCount) then
    exit;
  pi := pl[j];
  if pi^.PropType^^.Kind = tkInteger then begin
    AValue := GetOrdProp(c, pi);
    Result := true;
  end;
end;
}
{/v0.22}

function ClassGetPropNameAndValue(c: TObject; j: integer;
  var AName: shortstring; var AValue: AnsiString): boolean;
var
  ti: PTypeInfo;
  td: PTypeData;
  pl: TPropList;
  pi: PPropInfo;
begin
  Result := false;
  ti := PTypeInfo(c.ClassInfo);
  td := PTypeData(GetTypeData(ti));
  GetPropInfos(ti, @pl);
  if (j < 0) or (j >= td^.PropCount) then
    exit;
  pi := pl[j];
  {
  case pi^.PropType^^.Kind of
    tkInteger: SetOrdProp(c, pi, StrToInt(AValue));
    tkFloat: SetFloatProp(c, pi, StrToFloat());
    tkString: SetStrProp(c, pi, vs);
  end;
  }
  AName := pi^.Name;
  AValue := '';{typinfo}
  case pi^.PropType^^.Kind of
    tkInteger: AValue := IntToStr(GetOrdProp(c, pi));
    tkFloat: begin
      {v0.45}
      AValue := GetFloatStr(c, pi);
      {/v0.45
      AValue := FloatToRoundStr(GetFloatProp(c, pi), DefValidDigits, 0);}
    end;
      {FloatToStr(GetFloatProp(c, pi));}
    tkString, tkLString: AValue := GetStrProp(c, pi);
    tkEnumeration: begin
      AValue := GetEnumPropStr(c, pi);
    end;
    {v0.44}
    tkSet: begin
      AValue := IntToStr(GetOrdProp(c, pi));
    end;
    {/v0.44}
  end;
  Result := true;
end;

{v0.47}
function ClassSetPropStr(c: TObject; APropInfo: PPropInfo; const AValue: AnsiString): integer;
var
  l: integer;
  tk: TTypeKind;
  ttd: PTypeData;
begin
  l := 0;
  tk := APropInfo^.PropType^^.Kind;
  case tk of
    tkInteger: SetOrdProp(c, APropInfo, StrToInt(AValue));
    tkFloat: SetFloatProp(c, APropInfo, StrToFloat(AValue));
    tkString: SetStrProp(c, APropInfo, AValue);
    tkLString: begin SetStrProp(c, APropInfo, AValue); inc(l, 4);end;
    tkEnumeration: SetEnumPropStr(c, APropInfo, AValue);
    tkSet: SetOrdProp(c, APropInfo, StrToInt(AValue));
  end;
  ttd := PTypeData(GetTypeData(APropInfo^.PropType^));
  Result := GetTypeSize(tk, ttd^) + l;
end;
{/v0.47}

function ClassSetPropStr(c: TObject; i: integer; const AValue: AnsiString): integer;
var
{  j: integer;}
  ti: PTypeInfo;
  td: PTypeData;
  {v0.47}{/v0.47
  l: integer;
  tk: TTypeKind;
  ttd: PTypeData;}
  pl: TPropList;
  pi: PPropInfo;
begin
  Result := 0;
  {v0.47}{/v0.47
  l := 0;}
  ti := PTypeInfo(c.ClassInfo);
  td := PTypeData(GetTypeData(ti));
  if (i < 0) or (i >= td.PropCount) then
    exit;
  GetPropInfos(ti, @pl);
{  for j := 0 to td^.PropCount - 1 do begin}
    pi := pl[i];
    {if pi^.Name = AName then begin}

      {v0.47}
      Result := ClassSetPropStr(c, pi, AValue);
      {/v0.47
      tk := pi^.PropType^^.Kind;
      case tk of
        tkInteger: SetOrdProp(c, pi, StrToInt(AValue));
        tkFloat: SetFloatProp(c, pi, StrToFloat(AValue));
        tkString: SetStrProp(c, pi, AValue);
        tkLString: begin SetStrProp(c, pi, AValue); inc(l, 4);end;
        tkEnumeration: SetEnumPropStr(c, pi, AValue);
        tkSet: SetOrdProp(c, pi, StrToInt(AValue));
      end;
      ttd := PTypeData(GetTypeData(pi^.PropType^));
      Result := GetTypeSize(tk, ttd^) + l;
      exit;
      }
    {end;}
{  end;}
end;

function ClassSetPropStr(c: TObject; const AName: shortstring;
  const AValue: AnsiString): integer;
var
  j: integer;
  ti: PTypeInfo;
  td, ttd: PTypeData;
  tk: TTypeKind;
  pl: TPropList;
  pi: PPropInfo;
  l: integer;
begin
  Result := 0;
  l := 0;
  ti := PTypeInfo(c.ClassInfo);
  td := PTypeData(GetTypeData(ti));
  GetPropInfos(ti, @pl);
  for j := 0 to td^.PropCount - 1 do begin
    pi := pl[j];
    if pi^.Name = AName then begin
      tk := pi^.PropType^^.Kind;
      case tk of
        tkInteger: SetOrdProp(c, pi, StrToInt(AValue));
        tkFloat: SetFloatProp(c, pi, StrToFloat(AValue));
        tkString: SetStrProp(c, pi, AValue);
        tkLString: begin SetStrProp(c, pi, AValue); inc(l, 4);end;
        tkEnumeration: SetEnumPropStr(c, pi, AValue);
        {v0.44}
        tkSet: SetOrdProp(c, pi, StrToInt(AValue));
        {/v0.44}
      end;
      ttd := PTypeData(GetTypeData(pi^.PropType^));
      Result := GetTypeSize(tk, ttd^) + l;
      exit;
    end;
  end;
end;

{v0.21}
{function GetClass(const AClassTypeName: string): TClass;
var ti:TTypeInfo;
begin
  ti.tkClass;
  ti.Name := AClassTypeName;
end;}{tmethod}
{/v0.21}

{v0.22}
function ClassGetMethod(c: TObject; const AMethodName: shortstring;
  var AMethod: TMethod): boolean;
var
  ti: PTypeInfo;
  ttd: PTypeData;
{  tk: TTypeKind;}
  pl: TPropList;
  pi: PPropInfo;
  i: integer;
begin
  Result := false;
  ti := PTypeInfo(c.ClassInfo);
  ttd := PTypeData(GetTypeData(ti));
  GetPropInfos(ti, @pl);
  for i := 0 to ttd^.PropCount - 1 do begin
    pi := pl[i];
    if pi^.Name = AMethodName then begin
      if pi^.PropType^^.Kind = tkMethod then begin
        AMethod := GetMethodProp(c, pi);
        Result := true;
        exit;
      end;
    end;
  end;
end;

function ClassGetMethod(c: TObject; i: integer; var AMethod: TMethod): boolean;
var
  ti: PTypeInfo;
{  ttd: PTypeData;
  tk: TTypeKind;}
  pl: TPropList;
  pi: PPropInfo;
begin
  Result := false;
  ti := PTypeInfo(c.ClassInfo);
  GetPropInfos(ti, @pl);
  pi := pl[i];
  if pi^.PropType^^.Kind = tkMethod then begin
    AMethod := GetMethodProp(c, pi);
    Result := true;
  end;
end;

function ClassSetMethod(c: TObject; const AMethodName: shortstring;
  const AMethod: TMethod): boolean;
var
  ti: PTypeInfo;
  ttd: PTypeData;
{  tk: TTypeKind;}
  pl: TPropList;
  pi: PPropInfo;
  i: integer;
begin
  Result := false;
  ti := PTypeInfo(c.ClassInfo);
  ttd := PTypeData(GetTypeData(ti));
  GetPropInfos(ti, @pl);
  for i := 0 to ttd^.PropCount - 1 do begin
    pi := pl[i];
    if pi^.Name = AMethodName then begin
      if pi^.PropType^^.Kind = tkMethod then begin
        SetMethodProp(c, pi, AMethod);
        Result := true;
        exit;
      end;
    end;
  end;
end;

function ClassSetMethod(c: TObject; i: integer; const AMethod: TMethod): boolean;
var
  ti: PTypeInfo;
{  ttd: PTypeData;
  tk: TTypeKind;  }
  pl: TPropList;
  pi: PPropInfo;
begin
  Result := false;
  ti := PTypeInfo(c.ClassInfo);
  GetPropInfos(ti, @pl);
  pi := pl[i];
  if pi^.PropType^^.Kind = tkMethod then begin
    SetMethodProp(c, pi, AMethod);
    Result := true;
  end;
end;
{/v0.22}

{v0.39}
function ClassReadPropsFromFile(c: TObject; FromPropIndex: integer;
  MaxSize: integer; const AFileName: string): integer;
  { Read values of all published properties with field index value FromPropIndex
    and higher from FileName (if MaxSize <> 0, then reads from stream maximaly
    that count of bytes) }
var
  s: TStream;
begin
  {Result := -1;}
  s := TFileStream.Create(AFileName, fmOpenRead);
  try
    Result := ClassReadPropsFromStream(c, FromPropIndex, MaxSize, s);
  finally
    s.Free;
  end;
end;

function ClassWritePropsToFile(c: TObject; FromPropIndex: integer;
  const AFileName: string): integer;
  { Read values of all published properties with field index value = FromPropIndex
    and higher from FileName }
var
  s: TStream;
begin
  {Result := -1;}
  s := TFileStream.Create(AFileName, fmCreate);
  try
    Result := ClassWritePropsToStream(c, FromPropIndex,s);
  finally
    s.Free;
  end;
end;

function UpdateDecimalSeparator(vs: string): string;
var
  ch: char;
  p: integer;
begin
  ch := DecimalSeparator;
  if ch = ',' then
    ch := '.'
  else
    ch := ',';
  p := pos(ch, vs);
  if p <> 0 then begin
    vs[p] := DecimalSeparator;
  end;
  Result := vs;
end;

procedure ClassReadWriteIniFile(c: TComponent; {v0.40}FromPropIndex: integer; {/v0.40}const AFileName: string; Read: boolean);
var
  f: TIniFile;
  fn: string;
  j: integer;
  ti: PTypeInfo;
  td: PTypeData;
  pl: TPropList;
  pi: PPropInfo;
  vs: shortstring;
{  ext: shortstring;}
  secpref: shortstring;
begin
  if c = nil then
    exit;
  fn := AFileName;
  if fn = '' then begin
    {v0.50}
    fn := FindIniFile;
    {/v0.50
    fn := paramstr(0);}
  end;
  fn := ChangeFileExt(fn, '.INI');

  f := TIniFile.Create(fn);
  try
    secpref := c.Name;
    if secpref = '' then
      secpref := c.ClassName;

    ti := PTypeInfo(c.ClassInfo);
    td := PTypeData(GetTypeData(ti));
    GetPropInfos(ti, @pl);

    for j := 0 to td^.PropCount - 1 do begin
      {v0.40}
      if j < FromPropIndex then
        continue;
      {/v0.40}
      pi := pl[j];

      if read then begin
        vs := f.ReadString(secpref, pi^.Name, '');
        if (vs <> '') then begin
          case pi^.PropType^^.Kind of
            {v0.44}tkSet,{/v0.44}tkEnumeration, tkInteger: begin
              SetOrdProp(c, pi, StrToInt(vs));
            end;
            tkFloat: begin
              {v0.40}
              vs := UpdateDecimalSeparator(vs);
              {/v0.40}
              SetFloatProp(c, pi, StrToFloat(vs));
            end;
            tkString,tkLString: SetStrProp(c, pi, vs);

          end;
        end;
      end else begin
        vs := '';
        case pi^.PropType^^.Kind of
          tkEnumeration, tkInteger{v0.44},tkSet{/v0.44}: vs := IntToStr(GetOrdProp(c, pi));
          tkFloat: vs := FloatToStr(GetFloatProp(c, pi));
          tkString, tkLString: vs := GetStrProp(c, pi);
        end;
        if vs <> '' then
          f.WriteString(secpref, pi^.Name, vs);
      end;
    end;
  finally
    f.Free;
  end;
end;


{confu}
procedure StrToVar(const AString: string; var AValue; t:TPropertyType);
var
  st: string;
  code: integer;
  s: shortstring absolute AValue;
  i: smallint absolute AValue;
  b: byte absolute AValue;
  w: word absolute AValue;
  r: real absolute AValue;
  c: char absolute AValue;
  p: array[0..pred(maxword)] of char absolute AValue;
  l: LongInt absolute AValue;
{  tp: PString absolute AValue;}
  si: single absolute AValue;
  {v0.40}
  d: double absolute AValue;
  {/v0.40}
begin
  st := Trim(AString);
  case t of
    ptString: s := st;
    ptInteger: val(st, i, code);
    ptLongint: val(st, l, code);
    ptReal: val(st, r, code);
    ptSingle: val(st, si, code);
    ptChar: c := st[1];
    ptWord: val(st, w, code);
    ptPChar: StrPCopy(P, st);
    ptByte: val(st, b, code);
    ptHex: w := HexToWord(st);
    {ptPString: SetString(tp, st);}
    {v0.40}
    ptDouble: val(st, d, code);{d := StrToFloat(CheckDecimalSeparator(st));}
    {/v0.40}
  else
    raise Exception.Create('PropUtl.StrToVar invalid PropType');
  end;
end;

procedure ConfigReadValue(AIniFile: TIniFile; const ASection: string;
  const AName: string; var AValue; ATyp: TPropertyType);
var s: string;
begin
  s := AIniFile.ReadString(ASection, AName, NonsenseString);
  if s <> NonsenseString then begin
    StrToVar(s, AValue, ATyp);
  end;
end;


procedure VarToStr(var value; var st: string; t:TPropertyType);
var
  l: longint absolute value;
  b: byte absolute value;
  i: smallint absolute value;
  w: word absolute value;
  s: shortstring absolute value;
  r: real absolute value;
  c: char absolute value;
  p: array[0..pred(maxword)] of char absolute value;
  {tp:PString absolute value;}
  si: single absolute value;
  {v0.40}
  d: double absolute value;
  {/v0.40}
  {len:byte;}
begin
  st := '';
  case t of
    ptLongint: str(l, st);
    ptByte: str(b, st);
    ptInteger: str(i, st);
    ptWord: str(w, st);
    ptReal: str(r, st);
    ptSingle: str(si, st);
    ptChar: st := c;
    ptPChar: st := StrPas(p);
    ptString: st := s;
    ptHex: st := WordToHex(w);
    {ptPString: st := GetString(tp)}
    {v0.40}
    ptDouble: str(d, st);
    {/v0.40}
  else
    raise Exception.Create('PropUtl.VarToStr invalid PropType');
  end;
end;

procedure ConfigWriteValue(AIniFile: TIniFile; const ASection: string;
  const AName: string; var AValue; ATyp: TPropertyType);
var s: string;
begin
  VarToStr(AValue, s, ATyp);
  AIniFile.WriteString(ASection, AName, s);
end;

procedure ConfigReadWriteValue(AIniFile: TIniFile; what:TReadWrite; const ASection: string;
  AName: string; AAddress: pointer; ATyp: TPropertyType);
var
  f: TIniFile;
begin
  if AIniFile = nil then begin
    f := TIniFile.Create(FindIniFile);
  end else
    f := AIniFile;
  try
    case what of
      rwRead: ConfigReadValue(f, ASection, AName, AAddress^, ATyp);
      rwWrite: ConfigWriteValue(f, ASection, AName, AAddress^, ATyp);
    end;
  finally
    if AIniFile = nil then
      f.Free;
  end;
end;
{/v0.39}

end.
