Code Examples

C# Examples Below you can find a couple of C# examples. Feel free to use and share them as you like as long as you credit the source.

Plugin Architecture

I have written a little article about how to implement a Plugin Architecture in C#. You can find the article along with the source code HERE

Delphi Examples Below you can find a couple of Delphi examples. Feel free to use and share them as you like as long as you credit the source.

TComInfo Object

This object is the result of a project I once had. The user could select from a list of installed Com objects. He/She could then select which method to execute. As a result I needed to query the interface of the Com and retrieve the the parameters and methods as well as the variables for each method. The result is this object which will give you a list of all the properties, methods and method variables available. You can get the result as XML but naturally also execute the methods through the object. It is naturally much more efficiant to call the com directly if you have that option but should you be in a similar situation as I was this could be of use. Please note that only automation compatible types are allowed and also that IUnknown will be treated as a stream.

Show / Hide Code

You can Download This Code Here

unit ComInfoObjU;
//****************************************************************************//
//**                                                                        **//
//** © Copyright 1995-2008 Mogens Nielsen                                   **//
//** You can freely distribute this code as long as you leave this message  **//
//** intact                                                                 **//
//**                                                                        **//
//****************************************************************************//
interface

uses Contnrs, SysUtils, ActiveX, comobj, MSXML2_TLB, variants;

type

  TParameterType = (ptSmallInt, ptInteger, ptSingle, ptDouble, ptCurrency,
                    ptDateTime, ptWideString, ptScode, ptWordBool, ptOleVariant,
                    ptIUnknown, ptByte, ptWord, ptNone);
  TParameterDirection = (pdIn,pdOut,pdInOut);

  TComInfoObj = class;

  TParameter = class(TObject)
  private
    Owner : TComInfoObj;
    FName: string;
    FpDirection: TParameterDirection;
    FpType: TParameterType;
    FValue: Variant;
    FParent: Tobject;
    procedure SetName(const Value: string);
    procedure SetpDirection(const Value: TParameterDirection);
    procedure SetpType(const Value: TParameterType);
    procedure SetValue(const Value: Variant);
    procedure SetParent(const Value: Tobject);
  public
    constructor create(aOwner : TComInfoObj;vName:string);
    destructor destroy; override;
  published
    property Parent:Tobject read FParent write SetParent;
    property Name:string read FName write SetName;
    property Value : Variant read FValue write SetValue;
    property pType:TParameterType read FpType write SetpType;
    property pDirection:TParameterDirection read FpDirection write SetpDirection;
  end;

  TParameters = class(TObjectlist)
  private
    function GetItem(index: integer): TParameter;
    function GetDefault(index: string): Tparameter;
  public
    property Items[index:integer] : TParameter read GetItem;
    property item[index:string]:Tparameter read GetDefault; default;
    function IndexOf(Name:String):integer; overload;
  end;

  TFunction = class(TObject)
  private
    Owner : TComInfoObj;
    FName: String;
    FParameters: TParameters;
    FReturnType: TParameterType;
    procedure SetName(const Value: String);
    function CallNoParam(Disp: IDispatch): variant;
    function CallWithParam(Disp: IDispatch): variant;
    function GetSingleDispid(Disp: IDispatch): integer;
  public
    constructor create(aOwner:TComInfoObj; vName:string);
    destructor destroy; override;
    function Execute:variant;
  published
    property Name:String read FName write SetName;
    property ReturnType : TParameterType read FReturnType write FReturnType;
    property Parameters : TParameters read FParameters;
  end;

  TFunctions = class(TObjectlist)
  private
    function GetItem(index: integer): TFunction;
    function GetDefault(index: string): TFunction;
  public
    property Items[index:integer] : TFunction read GetItem;
    property item[index:string]:TFunction read GetDefault; default;
    function IndexOf(Name:String):integer; overload;
  end;

  TComInfoObj = class
  private
    FName: String;
    FIntfName:string;
    FFunctions: TFunctions;
    FParameters: TParameters;
    XMLDocument: DOMDocument;
    procedure SetName(const Value: String);
    Procedure Init(AllFuncs : boolean = true);
    function IntfFunction(n:string):boolean;
    function IntfTypeToPTType(td:TYPEDESC):TParameterType;
    function IntfTypeTopTDirType(pd:PARAMDESC):TParameterDirection;
    function CorrectParameter(pDir:TParameterDirection; Dir:TParameterDirection):TParameterDirection;
    function CreateNode(ParentNode:IXMLDomNode; NodeName:string; Value:Variant):IXMLDomNode;
    procedure AddTextNode(ParentNode:IXMLDomNode; Value:Variant); 
    function CreateAttr(ParentNode:IXMLDomNode; NodeName:string; Value:Variant):IXMLDomNode;
    function ParamTypeToStr(pt : TParameterType):string;
    function ParamDirToStr(pd : TParameterDirection):string;
  public
    Disp: IDispatch;
    constructor create(vName:String; IncludeIntfFuncs:boolean = true);
    destructor destroy; override;
    function AsXML:widestring;
  published
    property Name:String read FName write SetName;
    property IntfName:string read FIntfName write FIntfName;
    Property Parameters : TParameters read FParameters;
    property Functions : TFunctions read FFunctions;
  end;

const IntfFunc : Array[1..7] of string=('QueryInterface','AddRef','Release','GetTypeInfoCount',
                      'GetTypeInfo','GetIDsOfNames','Invoke');

      CPARAMTYPE_IN  = 1;
      CPARAMTYPE_OUT = 2;
      CPARAMTYPE_VAR = 3;



implementation

uses typinfo, windows, classes;

{ TFunctions }

function TFunctions.GetDefault(index: string): TFunction;
var idx:integer;
begin
  result := nil;
  idx := indexof(index);
  if assigned(inherited Items[idx]) then
    result := TFunction(inherited Items[idx]);
end;

function TFunctions.GetItem(index: integer): TFunction;
begin
  result := nil;
  if assigned(inherited Items[index]) then
    result := TFunction(inherited Items[index]);
end;

function TFunctions.IndexOf(Name: String): integer;
var i:integer;
begin
  result := -1;
  for i := 0 to pred(count) do
  begin
    if ansicomparetext(items[i].Name,Name) = 0 then
    begin
      result := i;
      break;
    end;
  end;
end;

{ TParameters }

function TParameters.GetDefault(index: string): Tparameter;
var idx:integer;
begin
  result := nil;
  idx := indexof(index);
  if assigned(inherited Items[idx]) then
    result := TParameter(inherited Items[idx]);
end;

function TParameters.GetItem(index: integer): TParameter;
begin
  result := nil;
  if assigned(inherited Items[index]) then
    result := TParameter(inherited Items[index]);
end;

function TParameters.IndexOf(Name: String): integer;
var i:integer;
begin
  result := -1;
  for i := 0 to pred(count) do
  begin
    if ansicomparetext(items[i].Name,Name) = 0 then
    begin
      result := i;
      break;
    end;
  end;
end;

{ TParameter }

constructor TParameter.create(aOwner : TComInfoObj; vName: string);
begin
  inherited create;
  Owner := aOwner;
  fName := vName;
end;

destructor TParameter.destroy;
begin

  inherited;
end;

procedure TParameter.SetName(const Value: string);
begin
  fName := value;
end;

procedure TParameter.SetParent(const Value: Tobject);
begin
  FParent := Value;
end;

procedure TParameter.SetpDirection(const Value: TParameterDirection);
begin
  FpDirection := Value;
end;

procedure TParameter.SetpType(const Value: TParameterType);
begin
  FpType := Value;
end;

procedure TParameter.SetValue(const Value: Variant);
begin
  if (Parent is TComInfoObj) then  //only set value of global parameters (locals are handled before the call)
  begin
    if self.pDirection in [pdIn, pdInOut] then
      SetDispatchPropValue(Owner.Disp,fName,Value);
  end;
  FValue := Value;
end;

{ TFunction }

function TFunction.CallNoParam(Disp: IDispatch): variant;
var
  ID: integer;
  PropResult: OleVariant;
  DispParams: TDispParams;
begin
  VariantInit(PropResult);
  ID := GetSingleDispid(Disp);

 { Set up the dispparams structure for no parameters }
  DispParams.rgvarg := nil;
  DispParams.rgdispidNamedArgs := nil;
  DispParams.cArgs := 0;
  DispParams.cNamedArgs := 0;

  OleCheck(Disp.Invoke(ID, GUID_NULL, LOCALE_USER_DEFAULT,
  DISPATCH_METHOD, DispParams, @PropResult, nil, nil));
  Result := PropResult;
end;

function TFunction.CallWithParam(Disp: IDispatch): variant;
var
  PropResult: OleVariant;
  DispParams: TDispParams;
  Args:  array[0..2] of TVariantArg;
  iDispId   : TDispId;
  i:integer;
  idx:integer;
  pType: TParameterType;
  pValue : Variant;
  Sadapt:TStreamAdapter;
begin
 try
  VariantInit(PropResult);
  iDispId := GetSingleDispid(Disp);

{ Set up the params and dispparams structure }

  if Parameters.Count > 0 then
  begin
    for i := 0 to pred(Parameters.Count) do
    begin
      pType := Parameters.Items[i].pType;
      pValue := Parameters.Items[i].Value;
      // variables need to be in reverse order
      idx := pred(Parameters.Count) - i;
      case pType of
        ptSmallInt   : begin
                        Args[idx].vt := VT_I2;
                        Args[idx].iVal := pValue;
                       end;
        ptInteger    : begin
                        Args[idx].vt := VT_I4;
                        Args[idx].lVal := pValue;
                       end;
        ptSingle     : begin
                        Args[idx].vt := VT_R4;
                        Args[idx].fltVal := pValue;
                       end;
        ptDouble     : begin
                        Args[idx].vt := VT_R8;
                        Args[idx].dblVal := pValue;
                       end;
        ptCurrency   : begin
                        Args[idx].vt := VT_CY;
                        Args[idx].cyVal := pValue;
                       end;
        ptDateTime   : begin
                        Args[idx].vt := VT_DATE;
                        Args[idx].date := pValue;
                       end;
        ptWideString : begin
                        Args[idx].vt := VT_BSTR;
                        Args[idx].bstrVal := StringToOleStr(pValue);
                       end;
        ptScode      : begin
                        Args[idx].vt := VT_ERROR;
                        Args[idx].scode := pValue;
                       end;
        ptWordBool   : begin
                        Args[idx].vt := VT_BOOL;
                        Args[idx].vbool := pValue;
                       end;
        ptIUnknown   : begin
                         Sadapt:=TStreamAdapter.Create(TStringStream.Create(pValue));
                         try
                           Args[idx].vt := VT_UNKNOWN;
                           Args[idx].punkVal := pointer(Sadapt as IStream);
                         finally
                         end;
                       end;
        ptByte       : begin
                        Args[idx].vt := VT_UI1;
                        Args[idx].bVal := pValue;
                       end;
        ptWord       : begin
                        Args[idx].vt := VT_UI2;
                        Args[idx].uiVal := pValue;
                       end;
        else
        begin
          Args[idx].vt := VT_BSTR;
          Args[idx].bstrVal := StringToOleStr(pValue);
        end;
      end;{case}
    end;

 { Set up the dispparams structure for parameters }
    DispParams.rgvarg := PVariantArgList(@Args);
    DispParams.rgdispidNamedArgs := nil;
    DispParams.cArgs := Parameters.Count;
    DispParams.cNamedArgs := 0;

    OleCheck(Disp.Invoke(iDispId, GUID_NULL, LOCALE_USER_DEFAULT,
    DISPATCH_METHOD, DispParams, @PropResult, nil, nil));

    result := true;
    if Returntype <> ptNone then
      Result := PropResult;
  end
  else
  result := false;
  except on e:Exception do
    begin
      result := false;
    end;
  end;
end;

constructor TFunction.create(aOwner:TComInfoObj; vName:string);
begin
  inherited create;
  Owner := aOwner;
  fName := vName;
  fParameters := TParameters.Create;
end;

destructor TFunction.destroy;
begin
  fParameters.Free;
  inherited;
end;

function TFunction.Execute: variant;
var i:integer;
begin
  if Parameters.Count = 0 then
    result := CallNoParam(Owner.Disp)
  else
    result := CallWithParam(Owner.Disp);
  // run through all the parameters and get their values as they might have changed
  for i:=0 to pred(Owner.Parameters.Count) do
    Owner.Parameters.Items[i].Value := GetDispatchPropValue(Owner.Disp,Owner.Parameters.Items[i].Name);
end;

function TFunction.GetSingleDispid(Disp: IDispatch): integer;
var
  PropName: PWideChar;
begin
  PropName := StringToOleStr(Name);
  OleCheck(Disp.GetIDsOfNames(GUID_NULL, @PropName, 1, LOCALE_USER_DEFAULT, @Result));
end;

procedure TFunction.SetName(const Value: String);
begin
  fName := value;
end;

{ TComInfoObj }

function TComInfoObj.IntfFunction(n:string):boolean;
var i:integer;
begin
  result := false;
  for i:=low(IntfFunc) to High(IntfFunc) do
  begin
    if AnsiCompareText(n,IntfFunc[i]) = 0 then
    begin
      result := true;
      exit;
    end;
  end;
end;

function TComInfoObj.IntfTypeToPTType(td:TYPEDESC):TParameterType;
begin
  //only automation compatible used
  case td.vt of
    VT_I2 : Result := ptSmallInt;
    VT_I4	: Result := ptInteger;
    VT_R4 : Result := ptSingle;
    VT_R8 : Result := ptDouble;
    VT_CY	: Result := ptCurrency;
    VT_DATE	: Result := ptDateTime;
    VT_BSTR	: Result := ptWideString;
    VT_ERROR : Result := ptScode;
    VT_BOOL	: Result := ptWordBool;
    VT_VARIANT : Result := ptOleVariant;
    VT_UNKNOWN : Result := ptIUnknown;
    VT_UI1 : Result := ptByte;
    VT_UI2 : Result := ptWord;
  else
    Result := ptNone;
  end;{case}
end;

function TComInfoObj.IntfTypeTopTDirType(pd:PARAMDESC):TParameterDirection;
begin
  case pd.wParamFlags of
    CPARAMTYPE_IN  : result := pdIn;
    CPARAMTYPE_OUT : result := pdOut;
    CPARAMTYPE_VAR : result := pdInOut;
  else
    result := pdIn;
  end;{case}
end;

function TComInfoObj.CorrectParameter(pDir:TParameterDirection; Dir:TParameterDirection):TParameterDirection;
begin
  Result:=pDir;
  if pDir <> Dir then
  begin
    Result:= pdInOut;
  end;
end;

Procedure TComInfoObj.Init( AllFuncs : boolean = true);
var
    typeattr : pTypeAttr;
    typeinfo : ITypeInfo;
    i:integer;
    j:integer;
    TypeInfoCount:integer;
    FuncDesc:pFuncDesc;
    aName : WideString;
    aDocStr : WideString;
    aHelpContext : LongInt;
    vNames : pBstrlist;
    NamesCount : integer;
    k:integer;
    fCount:integer;
    pCount:integer;
    aDir:TParameterDirection;
begin
  Disp := CreateOleObject(fName);
  try
    disp.GetTypeInfoCount(TypeInfoCount);
    for i:=0 to pred(TypeInfoCount) do
    begin
      Disp.GetTypeInfo(i,0,TypeInfo);
      TypeInfo.GetDocumentation(-1,@aName,@aDocStr,@aHelpContext,nil);
      self.IntfName := aName;
      OleCheck(TypeInfo.GetTypeAttr(TypeAttr));
      new(vNames);
      try
        for j:=0 to pred(typeattr.cFuncs) do
        begin
          TypeInfo.GetFuncDesc(j,FuncDesc);
          try
            // regular function
            if (FuncDesc.invkind = INVOKE_FUNC) then
            begin
              TypeInfo.GetDocumentation(FuncDesc.memid,@aName,@aDocStr,@aHelpContext,nil);
              if (AllFuncs) or (not IntfFunction(aName)) then
              begin
                fCount := self.Functions.add(TFunction.create(self,aName));
                self.Functions.Items[fCount].ReturnType := IntfTypeToPTType(FuncDesc.elemdescFunc.tdesc);
                TypeInfo.GetNames(FuncDesc.memid,vNames,SizeOf(TBstrlist),NamesCount);

                for k := 0 to pred(FuncDesc.cParams) do
                begin
                  pCount := self.Functions.Items[fCount].Parameters.Add(TParameter.Create(self, vNames[k+1]));
                  self.Functions.Items[fCount].Parameters.Items[pCount].Parent := self.Functions.Items[fCount];
                  self.Functions.Items[fCount].Parameters.Items[pCount].pType := IntfTypeToPTType(FuncDesc.lprgelemdescParam[k].tdesc);
                  self.Functions.Items[fCount].Parameters.Items[pCount].pDirection := IntfTypeToPTDirType(FuncDesc.lprgelemdescParam[k].paramdesc);
                end;{for k}
              end;{if}
            end{if}
            else if (FuncDesc.invkind = INVOKE_PROPERTYGET) or (FuncDesc.invkind = INVOKE_PROPERTYPUT) then // parameters
            begin
              TypeInfo.GetDocumentation(FuncDesc.memid,@aName,@aDocStr,@aHelpContext,nil);
              if (AllFuncs) or (not IntfFunction(aName)) then
              begin
                if (FuncDesc.invkind = INVOKE_PROPERTYGET) then
                aDir:=pdOut
                else
                aDir:=pdIn;
                pCount := self.Parameters.IndexOf(aName);
                if pCount = -1 then
                begin
                  pCount := self.Parameters.Add(TParameter.Create(self, aName));
                  self.Parameters.Items[pCount].Parent := self;
                  self.Parameters.Items[pCount].pType :=IntfTypeToPTType(FuncDesc.elemdescFunc.tdesc);
                  self.Parameters.Items[pCount].pDirection := aDir;
                end
                else // modify parameter direction
                  self.Parameters.items[pCount].pDirection := CorrectParameter(self.Parameters.items[pCount].pDirection,aDir);
              end;{if}
            end;{elseif}
          finally
            typeInfo.ReleaseFuncDesc(FuncDesc);
          end;{try}
        end;{for j}
      finally
        dispose(vNames);
        TypeInfo.ReleaseTypeAttr(TypeAttr);
      end;
    end;{for i}
  except

  end;
end;

constructor TComInfoObj.create(vName:String; IncludeIntfFuncs:boolean = true);
begin
  inherited create;
  fName := vName;
  fParameters := TParameters.Create;
  fFunctions := TFunctions.Create;
  Init(IncludeIntfFuncs);
end;

destructor TComInfoObj.destroy;
begin
  FParameters.Free;
  FFunctions.Free;
  disp := nil;  
  inherited;
end;

procedure TComInfoObj.SetName(const Value: String);
begin
  fName := value;
end;

function TComInfoObj.AsXML: widestring;
var Root : IXMLDomNode;
    CurrNode:IXMLDomNode;
    ParamsNode:IXMLDomNode;
    FuncNode:IXMLDomNode;
    i,j:integer;
    value : variant;
begin
  XMLDocument := CoDomDocument.Create;
  try
    Root := XMLDocument.createElement('Com');
    XMLDocument.appendChild(root);
    CreateAttr(Root,'name',self.Name);
    CreateAttr(Root,'interface',self.IntfName);
    ParamsNode := CreateNode(Root,'Parameters','');
    for i:= 0 to Parameters.Count-1 do
    begin
      Value := null;
      if Parameters.Items[i].pType <> ptIUnknown then // ignore user defined types
        Value := Parameters.Items[i].Value;
      CurrNode := CreateNode(ParamsNode,Parameters.Items[i].Name,Value);
      CreateAttr(CurrNode,'type',ParamTypeToStr(Parameters.Items[i].pType));
      CreateAttr(CurrNode,'direction',ParamDirToStr(Parameters.Items[i].pDirection));
    end;
    FuncNode := CreateNode(Root,'Functions','');
    for i:= 0 to Functions.Count-1 do
    begin
      CurrNode := CreateNode(FuncNode,Functions.Items[i].Name,'');
      CreateAttr(CurrNode,'returntype',ParamTypeToStr(Functions.Items[i].ReturnType));
      ParamsNode := CreateNode(CurrNode,'Parameters','');
      for j:= 0 to Functions.Items[i].Parameters.Count-1 do
      begin
        Value := null;
        if Functions.Items[i].Parameters.Items[j].pType <> ptIUnknown then // ignore user defined types
          Value := Functions.Items[i].Parameters.Items[j].Value;
        CurrNode := CreateNode(ParamsNode,Functions.Items[i].Parameters.Items[j].Name,Functions.Items[i].Parameters.Items[j].Value);
        CreateAttr(CurrNode,'type',ParamTypeToStr(Functions.Items[i].Parameters.Items[j].pType));
        CreateAttr(CurrNode,'direction',ParamDirToStr(Functions.Items[i].Parameters.Items[j].pDirection));
      end;
    end;
  finally
    result := XMLDocument.xml;
    XMLDocument := nil;
  end;
end;

function TComInfoObj.CreateNode(ParentNode: IXMLDomNode; NodeName: string;
  Value: Variant): IXMLDomNode;
begin
  result := nil;
  if assigned(ParentNode) then
    result := ParentNode.ownerDocument.createElement(NodeName);
  if assigned(result) then
  begin
    if (not VarIsNull(value)) and (not VarIsEmpty(value)) then
       AddTextNode(result,value);
    ParentNode.appendChild(result);
  end;
end;

procedure TComInfoObj.AddTextNode(ParentNode: IXMLDomNode; Value: Variant);
begin
  ParentNode.appendChild(ParentNode.ownerDocument.createTextNode(value));
end;

function TComInfoObj.CreateAttr(ParentNode: IXMLDomNode; NodeName: string;
  Value: Variant): IXMLDomNode;
begin
  result := nil;
  if assigned(ParentNode) then
    result := ParentNode.ownerDocument.createAttribute(NodeName);
  if assigned(result) then
  begin
    result.nodeValue := value;
    ParentNode.attributes.setNamedItem(result);
  end;
end;

function TComInfoObj.ParamTypeToStr(pt: TParameterType): string;
begin
  result := '';
  try
    result := GetEnumName(TypeInfo(TParameterType), Ord(pt));
    delete(Result,1,2);
  except
  end;
end;

function TComInfoObj.ParamDirToStr(pd: TParameterDirection): string;
begin
  result := '';
  try
    result := GetEnumName(TypeInfo(TParameterDirection), Ord(pd));
    delete(Result,1,2);
  except
  end;
end;

SerializeU unit

More often that not do you find yourself needing to save the state of your application for later use. This unit contains a load and save method for writing and reading the state ( properties and values ) of your objects (and sub components if you want). This unit uses RTTI to run through all the objects and find the property values. So rather than trying to figure out what color the user selected, the size of a form or which checkbox was checked when the user last used the application, you can use this unit. The Serialize method takes 3 parameters. The Object to serialize, the filename of the xml file that will be created and finally a boolean value indicating whether to parse sub classes and components. The Deserialize method takes the same 3 parameters and set the object properties with the values found in the XML.

Show / Hide Code

You can Download This Code Here

unit SerializeU;

//****************************************************************************//
//**                                                                        **//
//** © Copyright 1995-2008 Mogens Nielsen                                   **//
//** You can freely distribute this code as long as you leave this message  **//
//** intact                                                                 **//
//**                                                                        **//
//****************************************************************************//

interface

uses TypInfo, sysutils;

procedure Serialize(Obj:TObject; FileName:TFileName; Deep:boolean = true);
procedure DeSerialize(var Obj:TObject; FileName:TFileName; Deep:boolean = true);

implementation

uses classes, variants, MSXML2_TLB;

function CreateNode(ParentNode:IXMLDomNode; NodeName:string):IXMLDomNode;
begin
  result := nil;
  if assigned(ParentNode) then
    result := ParentNode.ownerDocument.createElement(NodeName);
  if assigned(result) then
    ParentNode.appendChild(result);
end;

function CreateAttr(ParentNode: IXMLDomNode; NodeName: string;
  Value: Variant): IXMLDomNode;
begin
  result := nil;
  if assigned(ParentNode) then
    result := ParentNode.ownerDocument.createAttribute(NodeName);
  if assigned(result) then
  begin
    result.nodeValue := value;
    ParentNode.attributes.setNamedItem(result);
  end;
end;

procedure AddTextNode(ParentNode: IXMLDomNode; Value: Variant);
begin
  ParentNode.appendChild(ParentNode.ownerDocument.createTextNode(value));
end;

procedure ReadXML(Obj:TObject; ObjTypeInfo: PTypeInfo; oNode:IXMLDomNode; Deep:boolean);
var i:integer;
    AttrNode:IXMLDomNode;
    CurrNode:IXMLDomNode;
    PropInfo: PPropInfo;
    Kind : TTypeKind;
    KindStr : string;
    PropName: string;
    PropValue:Variant;
    PropValue64:integer;
    tmpObj : TObject;
    pValue : cardinal;
begin
  if assigned(oNode) and (oNode.hasChildNodes) then
  begin
    for i := 0 to oNode.childNodes.length - 1 do
    begin
      CurrNode := oNode.childNodes.item[i];
      AttrNode := CurrNode.attributes.getNamedItem('type');
      // we are only interested in properties and values for this component not child components (which has no type)
      if assigned(AttrNode) and (CurrNode.nodeType <> NODE_TEXT) then
      begin
        PropName := CurrNode.nodeName;
        PropValue := CurrNode.nodeTypedValue;
        KindStr := AttrNode.nodeValue;
        Kind := TTypeKind(GetEnumValue(TypeInfo(TTypeKind), KindStr));
        PropInfo := GetPropInfo(Obj.ClassInfo, PropName);
        if assigned(PropInfo) then
        begin
          case Kind of
            tkEnumeration,
            tkInteger,
            tkSet         : SetOrdProp(Obj,PropName,PropValue);
            tkChar,
            tkString,
            tkWChar,
            tkLString,
            tkWString     : SetStrProp(Obj,PropInfo,PropValue);//SetStrProp(Obj,PropName,PropValue);
            tkFloat       : SetFloatProp(Obj,PropInfo,PropValue);
            tkClass       : begin
                              pValue := GetOrdProp(Obj,PropInfo);
                              // "active" properties (ActiveControl,ActivePAge etc) are
                              // ignored as they reference objects set elsewhere
                              if (Deep) and (pValue > 0) and (pos('Active',PropName ) = 0)then
                              begin
                                tmpObj := TObject(pValue);
                                if CurrNode.hasChildNodes then
                                  ReadXML(tmpObj, tmpObj.ClassInfo, CurrNode, deep);
                              end;{if}
                            end;
            tkVariant     : SetVariantProp(Obj,PropInfo,PropValue);
            tkInt64       : begin
                              PropValue64 := PropValue;
                              SetInt64Prop(Obj,PropInfo,PropValue64);
                            end;
          end;{case}
        end;{if}
      end;{if}
    end;{for}
  end;{if}
end;

procedure WriteXML(Obj:TObject; ObjTypeInfo: PTypeInfo; oParentNode:IXMLDomNode; Deep:boolean);
var
  PropCount, i: Integer;
  PropList: PPropList;
  CurrNode:IXMLDomNode;
  tmpObj : TObject;
  pValue : cardinal;
  PropInfo: PPropInfo;
  Kind : TTypeKind;
begin
  PropCount := GetPropList(ObjTypeInfo, tkAny, nil);
  GetMem(PropList, PropCount * SizeOf(PPropInfo));
  try
    GetPropList(ObjTypeInfo, tkAny, PropList);
    for i := 0 to Pred(PropCount) do
    begin
      PropInfo := PropList^[i];
      CurrNode := CreateNode(oParentNode,PropInfo.Name);
      Kind := PropInfo.PropType^.Kind;
      CreateAttr(CurrNode,'type',GetEnumName(TypeInfo(TTypeKind),Ord(Kind)));
      case Kind of
        tkEnumeration,
        tkInteger,
        tkSet         : AddTextNode(CurrNode,GetOrdProp(Obj,PropInfo));
        tkChar,
        tkString,
        tkWChar,
        tkLString,
        tkWString     : AddTextNode(CurrNode,GetStrProp(Obj,PropInfo));
        tkFloat       : AddTextNode(CurrNode,GetFloatProp(Obj,PropInfo));
        tkClass       : begin
                          pValue := GetOrdProp(Obj,PropInfo);
                          if (Deep) and (pValue > 0) then
                          begin
                            tmpObj := TObject(pValue);
                            WriteXML(tmpObj, PropInfo.PropType^, CurrNode, deep);
                          end;
                        end;
        tkMethod      : AddTextNode(CurrNode,GetStrProp(Obj,PropInfo));
        tkVariant     : AddTextNode(CurrNode,GetVariantProp(Obj,PropInfo));
        tkInt64       : AddTextNode(CurrNode,GetInt64Prop(Obj,PropInfo));
      end;
    end;
  finally
    FreeMem(PropList, PropCount * SizeOf(PPropInfo))
  end;
end;

procedure ReadComponents(Comp:TComponent; Root:IXMLDomNode);
var i:integer;
    tmpComp:TComponent;
    CurrNode:IXMLDomNode;
begin
  for i := 0 to Comp.ComponentCount-1 do
  begin
    tmpComp := Comp.Components[i];
    CurrNode := Root.selectSingleNode(GetStrProp(tmpComp,'name'));
    ReadXML(tmpComp,tmpComp.ClassInfo, CurrNode, true);
  end;{for}
end;

procedure WriteComponents(Comp:TComponent; Root:IXMLDomNode);
var i:integer;
    tmpComp:TComponent;
    CurrNode:IXMLDomNode;
begin
  for i := 0 to Comp.ComponentCount-1 do
  begin
    tmpComp := Comp.Components[i];
    CurrNode := CreateNode(root,GetStrProp(tmpComp,'name'));
    WriteXML(tmpComp,tmpComp.ClassInfo, CurrNode, true);
  end;{for}
end;

procedure Serialize(Obj:TObject; FileName:TFileName; Deep:boolean = true);
var Doc : DomDocument;
    Root:IXMLDomNode;
begin
  Doc := CoDomDocument.Create;
  try
    Root := Doc.createElement(GetStrProp(Obj,'name'));
    Doc.appendChild(root);
    WriteXML(Obj, Obj.ClassInfo, Doc.documentElement, deep);
    if (Deep) and (Obj is TComponent) then
      WriteComponents(TComponent(Obj), root);
  finally
    Doc.save(FileName);
    Doc := nil;
  end;
end;

procedure DeSerialize(var Obj:TObject; FileName:TFileName; Deep:boolean = true);
var Doc : DomDocument;
    Root:IXMLDomNode;
begin
  Doc := CoDomDocument.Create;
  try
    if fileexists(Filename) then
    begin
      Doc.load(FileName);
      Root := Doc.documentElement;
      ReadXML(Obj, Obj.ClassInfo, Root, deep);
      if (Deep) and (Obj is TComponent) then
        ReadComponents(TComponent(Obj), root);
    end;{if}    
  finally
    Doc := nil;
  end;
end;