then raise Exception.Create('Íåñîîòâåòñòâèå êîëè÷åñòâà ýëåìåíòîâ â ñïèñêàõ');

unit FieldInfo;

interface

uses
  Windows, Messages, SysUtils, Classes, Db, DbClient;

type
  PFieldProps = ^TFieldProps;
  TFieldProps = record
    FieldName: string;
    ClassType: TFieldClass;
    MemoryStream: TMemoryStream;
    LookUpDataSet: TDataSet;
  end;

  {New: Add Calculated fields}
procedure AddCalculatedFields(Dataset: TDataSet; const FieldsNames,
  FieldsTypes: array of string);
{New: Assign data and Fields to new structure}
{With this function you can add Data Field (not calculated) to client dataset
but this function is slow and heavy}
procedure AssignData(List: TList; Dataset: TClientDataSet);
{Streams Fields List Clear}
procedure ClearAllFieldsInfo(List: TList);
{New: Copy Old Data in Modified Dataset}
procedure CopyDatasetData(Source, Target: TDataSet);
{New: delete an Item from List}
procedure DeleteField(List: TList; index: integer);
{Get information about Field definition into Dataset and then put into List}
procedure GetAllFieldsInfo(List: TList; DataSet: TDataSet);
{Get information about one Field and then put into List}
procedure GetFieldInfo(List: TList; Field: TField);
{New:  get the FieldIndex of Item}
function GetFieldIndex(List: TList; FieldName: string): integer;
{New:  get the FieldName of Item}
function GetFieldName(List: TList; index: integer): string;
{Get information about Field definition into Stream List and then put into Dataset}
procedure SetAllFieldsInfo(List: TList; DataSet: TDataSet);
{Field Classes register}
procedure RegClasses;
{Field Classes Unregister}
procedure UnRegClasses;

implementation

uses
  Variants;

procedure AddCalculatedFields(Dataset: TDataSet; const FieldsNames,
  FieldsTypes: array of string);
var
  List: TList;
  i: integer;
  oField: TField;
  clFieldClass: TFieldClass;
begin
  if not DataSet.Active then
    raise Exception.Create('I can not create calculated Fields when dataset is closed' + #13
      + 'with function AddCalculatedFields')
  else
  begin
    List := TList.Create;
    GetAllFieldsInfo(List, DataSet);
    for i := Low(FieldsNames) to High(FieldsNames) do
      if not Assigned(Dataset.FindField(FieldsNames[i])) then
      begin
        clFieldClass := TFieldClass(GetClass(FieldsTypes[i]));
        oField := clFieldClass.Create(DataSet);
        oField.FieldName := FieldsNames[i];
        oField.Calculated := True;
        if oField is TStringField then
          oField.Size := 100; {!!!}
        oField.FieldKind := fkInternalCalc;
        GetFieldInfo(List, oField);
        oField.Free;
      end;
    DataSet.Close;
    SetAllFieldsInfo(List, DataSet);
    ClearAllFieldsInfo(List);
    List.Free;
    DataSet.Open;
  end;
end;

procedure AssignData(List: TList; Dataset: TClientDataSet);
var
  NewDs: TClientDataSet;
begin
  DataSet.DisableControls;
  NewDs := TClientDataSet.Create(nil);
  SetAllFieldsInfo(List, NewDs);
  NewDs.CreateDataSet;
  CopyDatasetData(Dataset, NewDs);
  Dataset.Data := Null;
  SetAllFieldsInfo(List, DataSet);
  Dataset.Data := NewDs.Data;
  NewDs.Data := Null;
  NewDs.Free;
  DataSet.EnableControls;
end;

procedure ClearAllFieldsInfo(List: TList);
var
  i: Integer;
begin
  {Free record in each element of list}
  for i := 0 to List.Count - 1 do
  begin
    TFieldProps(List[i]^).MemoryStream.Free;
    TFieldProps(List[i]^).ClassType := nil;
    TFieldProps(List[i]^).LookUpDataSet := nil;
    Dispose(List[i]);
  end;
  {Clear the List}
  List.Clear;
end;

procedure CopyDatasetData(Source, Target: TDataSet);
type
  TSourceTargetFields = array[0..1] of TField;
var
  i, index: Integer;
  aFields: array of TSourceTargetFields;
  oField: TField;
begin
  if not Source.Active then
    Source.Active := True;
  if not Target.Active then
    Target.Active := True;
  for i := 0 to Source.FieldCount - 1 do
  begin
    oField := Target.FindField(Source.Fields[i].FieldName);
    if oField <> nil then
    begin
      index := High(aFields) + 1;
      SetLength(aFields, index + 1);
      aFields[index][0] := Source.Fields[i];
      aFields[index][1] := oField;
    end;
  end;

  Source.First;
  while not Source.Eof do
  begin
    Target.Insert;
    for i := 0 to High(aFields) do
    begin
      aFields[i][1].Value := aFields[i][0].Value;
    end;
    Target.Post;
    Source.Next;
  end;
end;

procedure DeleteField(List: TList; index: integer);
begin
  if index < List.Count then
  begin
    TFieldProps(List[index]^).MemoryStream.Free;
    TFieldProps(List[index]^).ClassType := nil;
    TFieldProps(List[index]^).LookUpDataSet := nil;
    Dispose(List[index]);
    List.Delete(index);
  end;
end;

procedure GetAllFieldsInfo(List: TList; DataSet: TDataSet);
var
  i: Integer;
  Field: TField;
begin
  for i := 0 to DataSet.Fields.Count - 1 do
  begin
    Field := DataSet.Fields[i];
    {Put Field information into list}
    GetFieldInfo(List, Field)
  end;
end;

procedure GetFieldInfo(List: TList; Field: TField);
var
  FieldProps: PFieldProps;
  i: integer;
begin
  New(FieldProps);

  {FieldName is necesary to compare if exist into the list}
  FieldProps^.FieldName := Field.FieldName;
  FieldProps^.ClassType := TFieldClass(Field.ClassType);
  FieldProps^.MemoryStream := TMemoryStream.Create;
  FieldProps^.MemoryStream.WriteComponent(Field);
  {LookUpDataSet is necesary because is a pointer and WriteComponent do not keep this information}
  FieldProps^.LookUpDataSet := Field.LookupDataSet;

  for i := 0 to List.Count - 1 do
  begin
    if TFieldProps(List[i]^).FieldName = FieldProps^.FieldName then
    begin
      {if exist into list then delete it}
      TFieldProps(List[i]^).MemoryStream.Free;
      TFieldProps(List[i]^).ClassType := nil;
      TFieldProps(List[i]^).LookUpDataSet := nil;
      Dispose(List[i]);
      List.Delete(i);
      Break;
    end;
  end;

  {Add information into the list}
  List.Add(FieldProps);
end;

function GetFieldIndex(List: TList; FieldName: string): integer;
var
  i: integer;
begin
  result := -1;
  for i := 0 to List.Count - 1 do
  begin
    if AnsiCompareText(PFieldProps(List[i]).FieldName, FieldName) = 0 then
    begin
      result := i;
      Break;
    end;
  end;
end;

function GetFieldName(List: TList; index: integer): string;
begin
  if index < List.Count then
    result := PFieldProps(List[index]).FieldName
  else
    result := '';
end;

procedure SetAllFieldsInfo(List: TList; DataSet: TDataSet);
var
  i: Integer;
  LocalField: TField;
  FieldClass: TFieldClass;
  SourceInfo: TMemoryStream;
begin
  if DataSet.Active then
    DataSet.Active := False;

  {se recorre toda la lista de definiciones de campos}
  DataSet.Fields.Clear;
  DataSet.FieldDefs.Clear;

  {Add all List Field definition into List to DataSet}
  for i := 0 to List.Count - 1 do
  begin
    {Get Correct Class Type}
    FieldClass := TFieldProps(List[i]^).ClassType;

    {if Class exists}
    if FieldClass <> nil then
    begin
      {Goto the first position of stream}
      SourceInfo := TFieldProps(List[i]^).MemoryStream;
      SourceInfo.Seek(0, soFromBeginning);

      {Create Field with Dataset}
      LocalField := FieldClass.Create(DataSet);
      {Set Field information}
      LocalField := TField(SourceInfo.ReadComponent(LocalField));
      {Assign DataSet to Field}
      LocalField.DataSet := DataSet;
      LocalField.LookupDataSet := TFieldProps(List[i]^).LookUpDataSet;

      //      if FieldClass=TStringField then LocalField.Size:=100; {!!!}
    end;
  end;
end;

procedure RegClasses;
var
  AFieldClasses: array[0..25] of TPersistentClass;
begin
  AFieldClasses[0] := TADTField;
  AFieldClasses[1] := TAggregateField;
  AFieldClasses[2] := TArrayField;
  AFieldClasses[3] := TAutoIncField;
  AFieldClasses[4] := TBCDField;
  AFieldClasses[5] := TBinaryField;
  AFieldClasses[6] := TBlobField;
  AFieldClasses[7] := TBooleanField;
  AFieldClasses[8] := TBytesField;
  AFieldClasses[9] := TCurrencyField;
  AFieldClasses[10] := TDateField;
  AFieldClasses[11] := TDataSetField;
  AFieldClasses[12] := TDateTimeField;
  AFieldClasses[13] := TFloatField;
  AFieldClasses[14] := TGraphicField;
  AFieldClasses[15] := TIntegerField;
  AFieldClasses[16] := TLargeintField;
  AFieldClasses[17] := TMemoField;
  AFieldClasses[18] := TNumericField;
  AFieldClasses[19] := TObjectField;
  AFieldClasses[20] := TReferenceField;
  AFieldClasses[21] := TSmallintField;
  AFieldClasses[22] := TStringField;
  AFieldClasses[23] := TTimeField;
  AFieldClasses[24] := TVarBytesField;
  AFieldClasses[25] := TWordField;
  RegisterClasses(AFieldClasses);
end;

procedure UnRegClasses;
var
  AFieldClasses: array[0..25] of TPersistentClass;
begin
  AFieldClasses[0] := TADTField;
  AFieldClasses[1] := TAggregateField;
  AFieldClasses[2] := TArrayField;
  AFieldClasses[3] := TAutoIncField;
  AFieldClasses[4] := TBCDField;
  AFieldClasses[5] := TBinaryField;
  AFieldClasses[6] := TBlobField;
  AFieldClasses[7] := TBooleanField;
  AFieldClasses[8] := TBytesField;
  AFieldClasses[9] := TCurrencyField;
  AFieldClasses[10] := TDateField;
  AFieldClasses[11] := TDataSetField;
  AFieldClasses[12] := TDateTimeField;
  AFieldClasses[13] := TFloatField;
  AFieldClasses[14] := TGraphicField;
  AFieldClasses[15] := TIntegerField;
  AFieldClasses[16] := TLargeintField;
  AFieldClasses[17] := TMemoField;
  AFieldClasses[18] := TNumericField;
  AFieldClasses[19] := TObjectField;
  AFieldClasses[20] := TReferenceField;
  AFieldClasses[21] := TSmallintField;
  AFieldClasses[22] := TStringField;
  AFieldClasses[23] := TTimeField;
  AFieldClasses[24] := TVarBytesField;
  AFieldClasses[25] := TWordField;
  UnRegisterClasses(AFieldClasses);
end;

initialization
  RegClasses;

finalization
  UnRegClasses;
end.

begin

  CDS2 := TClientDataSet.Create(nil);
// çäåñü äîáàâèòü êîä äîáàâëåíèÿ äðóãèõ ïîëåé ...

 With CDS2 do
  begin
// 1
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftInteger;
     Name := 'NUMBER_LIST';
    end;
// 2
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftString;
     Size:=20;
     Name := 'NUMBER_SAKAS';
    end;
// 3
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftInteger;
     Name := 'TIPORASMER_H_OCNOVI';
    end;
// 4
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftString;
     Size:=20;
     Name := 'TOLCHINA_NAPLAVKI';
    end;
// 5
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftString;
     Size:=20;
     Name := 'TIP_LENTI';
    end;
// 6
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftInteger;
     Name := 'DLINA';
    end;
// 7
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftInteger;
     Name := 'CHIRINA';
    end;
// 8
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftString;
     Size:=20;
     Name := 'MARKA_OCNOVI';
    end;
// 9
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftString;
     Size:=20;
     Name := 'TIP_MARKA_LENTI';
    end;
// 10
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftDate;
     Name := 'DATA_SADANIJA';
    end;
// 11
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftTime;
     Name := 'VREMJA_SADANIJA';
    end;

// 12
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftMemo;
     Size:=240;
     Name := 'OPICANIE';
    end;

// 13
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftGraphic;
     Size:=240;
     Name := 'FOTO';
    end;
// 14
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftInteger;
     Name := 'USTANOVL_U';
    end;

// 15
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftInteger;
     Name := 'USTANOVL_A';
    end;
// 16
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftInteger;
     Name := 'SYPPORT_N';
    end;
// 17
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftInteger;
     Name := 'Mode_Napl';
    end;
// 18
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftInteger;
     Name := 'X_L1';
    end;
// 19
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftInteger;
     Name := 'A_L';
    end;
// 20
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftInteger;
     Name := 'B_L';
    end;
// 21
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftInteger;
     Name := 'Y_L1';
    end;
// 22
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftInteger;
     Name := 'R_R';
    end;
// 23
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftInteger;
     Name := 'XY_NUMBER';
    end;
// 24
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftInteger;
     Name := '_ZIKL';
    end;
// 25
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftInteger;
     Name := 'NOMER_MACHINE';
    end;
// 26
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftInteger;
     Name := 'NOMER_MACHINE_VIPOL';
    end;
// 27
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftGraphic;
     Size:=240;
     Name := 'PLAN_LISTA';
    end;
// 28
   With FieldDefs.AddFieldDef do
    begin
     DataType := ftString;
     Size:=20;
     Name := 'CVET';
    end;


   CreateDataSet;
   SaveToFile('C:\CLX_CLIENT_SERVER\csd\SAKAS2.cds');
  end;

end;