unit PropUtl;
{ Functions to access RTTI }
{
  (C) 2000 - 2002 Jindrich Jindrich, Pavel Pisa, PiKRON Ltd.

  Originators of the CHROMuLAN project:

  Jindrich Jindrich - http://www.jindrich.com
                      http://orgchem.natur.cuni.cz/Chromulan/
                      software developer, project coordinator
  Pavel Pisa        - http://cmp.felk.cvut.cz/~pisa
                      embeded software developer
  PiKRON Ltd.       - http://www.pikron.com
                      project initiator, sponsor, instrument developer

  The CHROMuLAN project is distributed under the GNU General Public Licence.
  See file COPYING for details.

  Originators reserve the right to use and publish sources
  under different conditions too. If third party contributors
  do not accept this condition, they can delete this statement
  and only GNU license will apply.
}

interface
uses
  SysUtils, Classes, TypInfo, IniFiles,
  UtlType, WinUtl, BinHex;

{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}

{ 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 ClassGetPropNameAndValue(c: TObject; j: integer; var AName: shortstring;
  var AValue: AnsiString): boolean;

{ 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; const AName: shortstring;
  const AValue: AnsiString): integer;overload;

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}


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

{v0.24}
{}
function FillEnumNames(APropInfo: PPropInfo; Items: TStrings): boolean;overload;
{/v0.24}

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

function FillSetEnumNames(APropInfo: PPropInfo; Items: TStrings): boolean; overload;

{ Converts bitflags in ASetInt to string using Items StringList with EnumNames. }
function SetToStr(ASetInt: integer; Items: TStrings): string;

{ Converts SetStr got by SetToStr to ASetInt using EnumNames in Items. }
function StrToSet(const ASetStr: string; Items: TStrings): integer;
{/v0.44}


{ 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 FillPropNames(c: TObject; const AfterName: string;
  var FirstPropIndex:integer; Items: TStrings): boolean;

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

{ Return sum of all lengths of all c's published properties of
  type = tkLString. }
function ClassSumStringLength(c: TObject): 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 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. }
function ClassWritePropsToStream(c: TObject; FromPropIndex: integer; AStream: TStream): integer;

{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}
{ 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 ClassReadPropsFromFile(c: TObject; FromPropIndex: integer;
  MaxSize: integer; const AFileName: string): integer;

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}

{v0.60}
{ Has c some published property with name that is a starting substring
    of ALongerName? }
function ClassHasPropertyContainedIn(c: TObject; const ALongerName: string;
  var APropInfo: PPropInfo): boolean;

{ Has c some property with name that contain ANameStart substring
  at its beggining? }
function ClassHasPropertyStartingWith(c: TObject;
  const ANameStart: string; var APropInfo: PPropInfo): boolean;
{/v0.60}
{v0.64}
{ Concatenate to string converted values of all variant open array parameters Args
  to the Result, delimited by the Delimiter.
  E.g. MakeStr('|', [128, 'blb', 456.7]) = '128|blb|456.7' }
function MakeStr(const Delimiter: string; const Args: array of const): string;
{/v0.64}
{v0.65}
type
  TClassAssignOption = (caoPropsClear, caoPropsCopy, caoChildrenClear, caoChildrenAdd);
  TClassAssignOptions = set of TClassAssignOption;
const
  caoAll = [caoPropsClear..caoChildrenAdd];
{ Assign the Src object to Dest object according to class assign options:
  caoPropsClear - values of all published properties of Dest will be cleared
                  before any copying from Src will be made (useful if Src has
                  less or different published props than the Dest)
  caoPropsCopy - values of published properties with the same names will be
                 copied from Src to Dest
  caoChildrenClear - all children Components in Dest will be destroyed before
                     copying from Src
  caoChildrenAdd - children from Src will be added to Dest children; if this option
                   is used, then all the classes involved must be registered by
                   RegisterClass procedure, must be TComponent descendants and
                   have eventually overriden Create constructor only with AOwner
                   parameter. }
function ClassAssign(Dest: TObject; Src: TObject; cao: TClassAssignOptions): integer;

{ Returns ordered comma separated list of C.Components[i].Name }
function ComponentChildList(C: TComponent): string;
{/v0.65}
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);
  if ti = nil then
    exit;
  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;

{v0.62}
function StripBrackets(const S: string): string;
begin
  Result := s;
  if (Result <> '') then begin
    if (Result[1] = '[') then
      Result := copy(Result, 2, length(Result));
    if (Result <> '') then begin
      if Result[length(Result)] = ']' then
        Result := copy(Result, 1, length(Result) - 1);
    end;
  end;
end;
{/v0.62}

procedure ConfigReadValue(AIniFile: TIniFile; const ASection: string;
  const AName: string; var AValue; ATyp: TPropertyType);
var
  s: string;
{v0.62}
  sec: string;
{/v0.62}
begin
  {v0.62}
  sec := StripBrackets(ASection);
  { in delphi6 must be ASection without brackets }
  {/v0.62}
  s := AIniFile.ReadString({v0.62}sec{/v0.62 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;
  {v0.62}
  sec: string;
  {/v0.62}
begin
  {v0.62}
  sec := StripBrackets(ASection);
  {/v0.62}
  VarToStr(AValue, s, ATyp);
  AIniFile.WriteString({v0.62}sec{/v0.62 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}

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

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

{v0.64}
function MakeStr(const Delimiter: string; const Args: array of const): string;
{const
  BoolChars: array[Boolean] of Char = ('F', 'T');}{typinfo BooleanIdents}
var
  i: Integer;
begin
  Result := '';
  for i := 0 to High(Args) do begin
    if i = 0 then
      Result := ''
    else
      Result := Result + Delimiter;
    with Args[i] do
      case VType of
        vtInteger:    Result := Result + IntToStr(VInteger);
        vtBoolean:    Result := Result + BooleanIdents[VBoolean];
        vtChar:       Result := Result + VChar;
        vtExtended:   Result := Result + FloatToStr(VExtended^);
        vtString:     Result := Result + VString^;
        vtPChar:      Result := Result + VPChar;
        vtObject:     Result := Result + VObject.ClassName;
        vtClass:      Result := Result + VClass.ClassName;
        vtAnsiString: Result := Result + string(VAnsiString);
        vtCurrency:   Result := Result + CurrToStr(VCurrency^);
        vtVariant:    Result := Result + string(VVariant^);
        vtInt64:      Result := Result + IntToStr(VInt64^);
    end;
  end;
end;
{/v0.64}

function ClassAssign(Dest: TObject; Src: TObject; cao: TClassAssignOptions): integer;
var
  i: integer;
  n: shortstring;
  v: AnsiString;
  s, d: TComponent;

begin
  Result := -1;
  if (Dest = nil) or (Src = nil) then
    exit;
  if caoPropsClear in cao then begin
    i := 0;
    while ClassGetPropStr(Dest, i, v) do begin
      ClassSetPropStr(Dest, i, '');
      inc(i);
    end;
  end;
  if caoPropsCopy in cao then begin
    i := 0;
    while ClassGetPropNameAndValue(Src, i, n, v) do begin
      ClassSetPropStr(Dest, n, v);
      inc(i);
    end;
  end;
  if caoChildrenClear in cao then begin
    if Dest is TComponent then with Dest as TComponent do begin
      DestroyComponents;
    end;
  end;
  if caoChildrenAdd in cao then begin
    if (Dest is TComponent) and (Src is TComponent) then begin
      for i := 0 to TComponent(Src).ComponentCount - 1 do begin
        s := TComponent(Src).Components[i];
        d := TComponentClass(FindClass(s.ClassName)).Create(TComponent(Dest));
        ClassAssign(d, s, [caoPropsCopy, caoChildrenAdd]);
      end;
    end;
  end;
  Result := 0;
end;

function ComponentChildList(C: TComponent): string;
var i: integer;
begin
  Result := '';
  for i := 0 to C.ComponentCount - 1 do begin
    Result := Result + C.Components[i].Name;
    if i <> C.ComponentCount - 1 then
      Result := Result + ',';  {classes}
  end;
end;
{/v0.65}

end.
