ClientDataSet中的Data结构，大家发表一下意见！(300分)

procedure TDataPacketWriter.PutBlobField(Info: PPutFieldInfo);
begin
  if not (poFetchBlobsOnDemand in Options) then
  begin
    Info.Size := Info.DataSet.GetBlobFieldData(Info.FieldNo, TBlobByteData(FBuffer));
    if Info.Size <> 0 then
    begin
      if Length(FBuffer) <= Info.Size then
        SetLength(FBuffer, Info.Size + 1);
      FBuffer[Info.Size] := 0;
      if TBlobField(Info.Field).Transliterate then
        Info.Size := Info.DataSet.Translate(PChar(FBuffer), PChar(FBuffer), False);
      FIDSWriter.PutField(fldIsChanged, Info.Size, PByte(FBuffer))
    end else
      FIDSWriter.PutField(fldIsNull, 0, nil);
  end else
    FIDSWriter.PutField(fldIsChanged, dsDELAYEDBIT or 1, @Info.Size);
end;

procedure TDataPacketWriter.PutCalcField(Info: PPutFieldInfo);
begin
  if Info.DataSet.GetFieldData(Info.Field, FBuffer) then
  begin
    if (Info.Field is TStringField) then
      if TStringField(Info.Field).Transliterate then
        Info.Size := Info.DataSet.Translate(PChar(FBuffer), PChar(FBuffer), False) else
        Info.Size := StrLen(PChar(FBuffer));
    FIDSWriter.PutField(fldIsChanged, Info.Size, PByte(FBuffer));
  end else
    FIDSWriter.PutField(fldIsNull, 0, nil);
end;

procedure TDataPacketWriter.PutField(Info: PPutFieldInfo);
begin
  if Info.DataSet.GetFieldData(Info.FieldNo, FBuffer) then
    FIDSWriter.PutField(fldIsChanged, Info.Size, PByte(FBuffer)) else
    FIDSWriter.PutField(fldIsNull, 0, nil);
end;

procedure TDataPacketWriter.PutStringField(Info: PPutFieldInfo);
begin
  if Length(FBuffer) <= Info.Size then
    SetLength(FBuffer, Info.Size + 1);
  if Info.DataSet.GetFieldData(Info.FieldNo, FBuffer) then
  begin
    if TStringField(Info.Field).Transliterate then
      Info.Size := Info.DataSet.Translate(PChar(FBuffer), PChar(FBuffer), False) else
      Info.Size := StrLen(PChar(FBuffer));
    FIDSWriter.PutField(fldIsChanged, Info.Size, PByte(FBuffer));
  end else
    FIDSWriter.PutField(fldIsNull, 0, nil);
end;

procedure TDataPacketWriter.PutWideStringField(Info: PPutFieldInfo);
var
  W: WideString;
begin
  if Info.DataSet.GetFieldData(Info.field, @W, False) then
  begin
    Info.Size := Length(W);
    FIDSWriter.PutField(fldIsChanged, Info.Size * 2, PByte(W));
  end else
    FIDSWriter.PutField(fldIsNull, 0, nil);
end;

procedure TDataPacketWriter.PutVarBytesField(Info: PPutFieldInfo);
begin
  if Info.DataSet.GetFieldData(Info.FieldNo, FBuffer) then
    FIDSWriter.PutField(fldIsChanged, PWord(FBuffer)^, @FBuffer[SizeOf(Word)]) else
    FIDSWriter.PutField(fldIsNull, 0, nil);
end;

procedure TDataPacketWriter.PutADTField(Info: PPutFieldInfo);
var
  i: Integer;
begin
  if Info.Field.IsNull then
    FIDSWriter.PutField(fldIsNull, 0, nil) else
    FIDSWriter.PutField(fldIsChanged, 0, nil);
  for i := 0 to High(TInfoArray(Info.FieldInfos)) do
    with TInfoArray(Info^.FieldInfos)[i] do
      PutProc(@TInfoArray(Info.FieldInfos)[i]);
end;

procedure TDataPacketWriter.PutArrayField(Info: PPutFieldInfo);

  procedure RefreshInfos(Src: TField; Dest: PPutFieldInfo);
  var
    i: Integer;
  begin
    with Dest^ do
    begin
      Field := Src;
      FieldNo := Src.FieldNo;
      if (FieldInfos <> nil) then { Must be an ADT }
      begin
        if not (Src is TADTField) then
          raise EDSWriter.CreateFmt(SArrayElementError,[Src.ClassName]);
        with (Src as TADTField) do
          for i := 0 to FieldCount - 1 do
            RefreshInfos(Fields[i], @TInfoArray(FieldInfos)[i]);
      end;
    end;
  end;

var
  i: Integer;
begin
  if Info.Field.IsNull then
    FIDSWriter.PutField(fldIsNull, 0, nil) else
    FIDSWriter.PutField(fldIsChanged, 0, nil);
  for i := 0 to TArrayField(Info.Field).FieldCount - 1 do
    with TInfoArray(Info^.FieldInfos)[0] do
    begin
      RefreshInfos(TArrayField(Info.Field).Fields[i], @TInfoArray(Info.FieldInfos)[0]);
      PutProc(@TInfoArray(Info.FieldInfos)[0]);
    end;
end;

procedure TDataPacketWriter.PutDataSetField(Info: PPutFieldInfo);
var
  Count: DWord;
  DataSet: TDataSet;
begin
  if Info.Field <> nil then
  begin
    if Info.Field.IsNull then
    begin
      FIDSWriter.PutField(fldIsNull, 0, nil);
      Exit;
    end;
    DataSet := TDataSetField(Info.Field).NestedDataSet;
  end else
    DataSet := Info.DataSet;
  if (poFetchDetailsOnDemand in Options) then
    Count := dsDELAYEDBIT else
    Count := DWord(-1);
  FIDSWriter.PutField(fldIsChanged, SizeOf(Count), @Count);
  if (not (poFetchDetailsOnDemand in Options)) and (Count = DWord(-1)) then
  begin
    DataSet.UpdateCursorPos;
    DataSet.First;
    DataSet.BlockReadSize := MaxInt;
    try
      WriteDataSet(DataSet, TInfoArray(Info.FieldInfos), -1);
      FIDSWriter.EndOfNestedRows;
    finally
      DataSet.BlockReadSize := 0;
    end;
  end;
end;

function TDataPacketWriter.WriteDataSet(DataSet: TDataSet; var Info: TInfoArray;
  RecsOut: Integer): Integer;
const
  B: Byte = 0;
var
  i: Integer;
  ChildOpened: Boolean;

  function OpenCloseDetails(Info: TInfoArray; ActiveState: Boolean): Boolean;
  var
    I: Integer;
  begin
    Result := False;
    for I := 0 to High(Info) do
    begin
      if Info[I].IsDetail and (Info[I].DataSet.Active <> ActiveState) then
      begin
        Info[I].DataSet.Active := ActiveState;
        Info[I].Opened := ActiveState;
        Result := True;
      end;
    end;
  end;

begin
  Result := 0;
  if RecsOut = AllRecords then
    RecsOut := High(Integer);
  if DataSet.DefaultFields then
    RefreshPutProcs(DataSet, Info);
  ChildOpened := OpenCloseDetails(Info, True);
  while (not DataSet.EOF) and (Result < RecsOut) do
  begin
    FIDSWriter.PutField(fldIsChanged, 1, @B);
    for i := 0 to High(Info) do
      Info[i].PutProc(@Info[i]);
    Inc(Result);
    if Result < RecsOut then
      DataSet.Next;
  end;
  if ChildOpened then
    OpenCloseDetails(Info, False);
end;

{ Writing meta data }

procedure TDataPacketWriter.AddDataSetAttributes(DataSet: TDataSet);
var
  i: Integer;
  List: TList;
begin
  if Assigned(FOnGetParams) then
  begin
    List := TList.Create;
    try
      FOnGetParams(DataSet, List);
      for i := 0 to List.Count - 1 do
        with PPacketAttribute(List[i])^ do
        begin
          AddAttribute(pcktAttrArea, Name, Value, IncludeInDelta);
          Dispose(PPacketAttribute(List[i]));
        end;
    finally
      List.Free;
    end;
  end;
end;

function TDataPacketWriter.GetFieldIdx(const FieldName: string; const Info: TInfoArray): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i := 0 to High(Info) do
    if (Info[i].Field <> nil) and (Info[i].Field.FieldName = FieldName) then
    begin
      Result := Info[i].LocalFieldIndex;
      break;
    end;
end;

type
  TPropWriter = class(TWriter);

procedure TDataPacketWriter.AddExtraFieldProps(Field: TField);

  procedure WriteProp(Instance: TPersistent; const PropName: string;
    Writer: TPropWriter);
  var
    PropInfo: PPropInfo;
  begin
    PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, PropName);
    if (PropInfo <> nil) and IsStoredProp(Instance, PropInfo) then
      Writer.WriteProperty(Instance, PropInfo);
  end;

var
  Writer: TPropWriter;
  Stream: TMemoryStream;
  i: Integer;
  Attr: Cardinal;
begin
  Stream := TMemoryStream.Create;
  try
    Writer := TPropWriter.Create(Stream, 1024);
    try
      Writer.WriteListBegin;
      for i := 0 to High(ExtraFieldProps) do
        WriteProp(Field, ExtraFieldProps[i], Writer);
      Writer.WriteListEnd;
      Writer.FlushBuffer;
      if Stream.Size > 2 then
      begin
        Attr := (dsfldBYTES shl dsSizeBitsLen) or dsArrayFldType or SizeOf(Byte) or dsIncInDelta;
        PInteger(FBuffer)^ := Stream.Size;
        Move(Stream.Memory^, FBuffer[SizeOf(Integer)], Stream.Size);
        Check(FIDSWriter.AddAttribute(fldAttrArea, szFIELDPROPS, Attr,
          Stream.Size + SizeOf(Integer), FBuffer));
      end;
    finally
      Writer.Free;
    end;
  finally
    Stream.Free;
  end;
end;

procedure TDataPacketWriter.AddColumn(const Info: TPutFieldInfo);

  procedure AddFieldDesc(const FldName: string; FldType, Attributes: Integer);
  var
    FldDesc: TDSDataPacketFldDesc;
  begin
    if Length(FldName) >= SizeOf(FldDesc.szFieldName) then
      raise EDSWriter.CreateFmt(SFieldNameTooLong,[SizeOf(FldDesc.szFieldName) - 1]);
    FillChar(FldDesc, SizeOf(FldDesc), 0);
    StrLCopy(FldDesc.szFieldName, PChar(FldName), SizeOf(FldDesc.szFieldName) - 1);
    FldDesc.iFieldType := FldType;
    FldDesc.iAttributes := Attributes;
    Check(FIDSWriter.AddColumnDesc(FldDesc));
  end;

  function ComputeInfoCount(Info: TInfoArray): Integer;
  var
    i: Integer;
  begin
    Result := Length(Info);
    for i := 0 to High(Info) do
      if Info[i].FieldInfos <> nil then
        Inc(Result, ComputeInfoCount(Info[i].FieldInfos));
  end;

  procedure AddMinMax(AField: TField);
  begin
    case AField.DataType of
      ftInteger, ftSmallInt:    
        if (TIntegerField(AField).MinValue <> 0) or
           (TIntegerField(AField).MaxValue <> 0)  then
           begin
             AddAttribute(fldAttrArea, szMINVALUE, 
                           TIntegerField(AField).MinValue, False);
             AddAttribute(fldAttrArea, szMAXVALUE, 
                          TIntegerField(AField).MaxValue, False);
           end;
      ftCurrency, ftFloat:
        if (TFloatField(AField).MinValue <> 0 ) or 
           (TFloatField(AField).MaxValue <> 0 ) then
           begin
             AddAttribute(fldAttrArea, szMINVALUE,
                           TFloatField(AField).MinValue, False);
             AddAttribute(fldAttrArea, szMAXVALUE, 
                          TFloatField(AField).MaxValue, False);
           end;
      ftBCD:
        if (TBCDField(AField).MinValue <> 0 ) or 
           (TIntegerField(AField).MaxValue <> 0 ) then
           begin
             AddAttribute(fldAttrArea, szMINVALUE, 
                           TBCDField(AField).MinValue, False);
             AddAttribute(fldAttrArea, szMAXVALUE, 
                          TBCDField(AField).MaxValue, False);
           end;
      ftFMTBcd:
        if (TFMTBcdField(AField).MaxValue <> '') or
           (TFMTBcdField(AField).MinValue <> '') then
           begin
             AddAttribute(fldAttrArea, szMINVALUE, 
                    VarFMTBcdCreate(TFMTBCDField(AField).MinValue, TFMTBCDField(AField).Precision, TFMTBCDField(AField).Size), False);
             AddAttribute(fldAttrArea, szMAXVALUE,
                    VarFMTBcdCreate(TFMTBCDField(AField).MaxValue, TFMTBCDField(AField).Precision, TFMTBCDField(AField).Size), False);
           end;
    end;
  end;

var
  FldType, Prec, Attr, i, Width: Integer;
  TempStr: string;
begin
  if Info.IsDetail and (Info.Field = nil) then
  begin
    FldType := (dsfldEMBEDDEDTBL shl dsSizeBitsLen) or
      ComputeInfoCount(Info.FieldInfos) or dsPseudoFldType;
    AddFieldDesc(Info.DataSet.Name, FldType, 0);
    WriteMetaData(Info.DataSet, TInfoArray(Info.FieldInfos));
  end else
  begin
    Width := 0;
    Attr := 0;
    if Info.Field.ReadOnly or (Info.Field.FieldKind <> fkData) then Attr := Attr or fldAttrREADONLY;
    if Info.Field.Required and (Info.Field.DataType <> ftAutoInc) then Attr := Attr or fldAttrREQUIRED;
    if (pfHidden in Info.Field.ProviderFlags) then Attr := Attr or fldAttrHIDDEN or fldAttrREADONLY;
    FldType := PacketTypeMap[Info.Field.DataType];
    case Info.Field.DataType of
      ftTimeStamp:
        FldType := (FldType shl dsSizeBitsLen) or sizeof(TSQLTimeStamp);
      ftString, ftFixedChar, ftVarBytes, ftGUID, ftWideString:
      begin
        FldType := FldType shl dsSizeBitsLen or dsVaryingFldType;
        if Info.Size < 255 then
          FldType := FldType or SizeOf(Byte) else
          FldType := FldType or SizeOf(Word);
        Width := Info.Size;
      end;
      ftBCD:
      begin
        if TBCDField(Info.Field).Precision = 0 then
          Width := 32 else
          Width := TBCDField(Info.Field).Precision;
        Prec := Width shr 1;
        Inc(Prec, Prec and 1);  { Make an even number }
        FldType := (FldType shl dsSizeBitsLen) or (Prec + 2);
      end;
      ftFMTBcd:
      begin
        if TFMTBCDField(Info.Field).Precision = 0 then
          Width := 32 else
          Width := TFMTBCDField(Info.Field).Precision;
        Prec := Width shr 1;
        Inc(Prec, Prec and 1);  { Make an even number }
        FldType := (FldType shl dsSizeBitsLen) or (Prec + 2);
      end;
      ftArray:
        FldType := (FldType shl dsSizeBitsLen) or dsPseudoFldType or
          dsCompArrayFldType or TObjectField(Info.Field).Size;
      ftADT:
        FldType := (FldType shl dsSizeBitsLen) or dsPseudoFldType or
          TObjectField(Info.Field).FieldCount;
      ftDataSet, ftReference:
        FldType := (FldType shl dsSizeBitsLen) or dsPseudoFldType or
          dsEmbeddedFldType or ComputeInfoCount(TInfoArray(Info.FieldInfos));
    else
      if Info.Field.IsBlob then
      begin
        FldType := (FldType shl dsSizeBitsLen) or dsVaryingFldType or SizeOf(Integer);
        Width := Info.Field.Size;
      end else
        FldType := (FldType shl dsSizeBitsLen) or Info.Size;
    end;
    AddFieldDesc(Info.Field.FieldName, FldType, Attr);
    if (Info.Field.FieldKind <> fkData) then
      AddAttribute(fldAttrArea, szSERVERCALC, True, True);
    if Info.Field.ProviderFlags <> [pfInWhere, pfInUpdate] then
      AddAttribute(fldAttrArea, szPROVFLAGS, Byte(Info.Field.ProviderFlags), True);
    if Info.Field.Origin <> '' then
      AddAttribute(fldAttrArea, szORIGIN, Info.Field.Origin, True);
    if Width > 0 then
      AddAttribute(fldAttrArea, szWIDTH, Width, False);
    if Info.Field is TBCDField then
    begin
      if TBCDField(Info.Field).Size <> 0 then
        AddAttribute(fldAttrArea, szDECIMALS, TBCDField(Info.Field).Size, False);
    end
    else if Info.Field is TFMTBCDField then 
    begin
      if TFMTBCDField(Info.Field).Size <> 0 then
        AddAttribute(fldAttrArea, szDECIMALS, TFMTBCDField(Info.Field).Size, False);
    end;
    AddMinMax(Info.Field);
    case Info.Field.DataType of
      ftCurrency: TempStr := szstMONEY;
      ftAutoInc: TempStr := szstAUTOINC;
      ftVarBytes, ftBlob: TempStr := szstBINARY;
      ftMemo: TempStr := szstMEMO;
      ftFmtMemo: TempStr := szstFMTMEMO;
      ftParadoxOle: TempStr := szstOLEOBJ;
      ftGraphic: TempStr := szstGRAPHIC;
      ftDBaseOle: TempStr := szstDBSOLEOBJ;
      ftTypedBinary: TempStr := szstTYPEDBINARY;
      ftADT:
        if (Info.Field.ParentField <> nil) and
           (Info.Field.ParentField.DataType in [ftDataSet, ftReference]) then
          TempStr := szstADTNESTEDTABLE;
      ftReference: TempStr := szstREFNESTEDTABLE;
      ftString:
        if TStringField(Info.Field).FixedChar then
          TempStr := szstFIXEDCHAR else
          TempStr := '';
      ftGUID: TempStr := szstGUID;
      ftOraClob: TempStr := szstHMEMO;
      ftOraBlob: TempStr := szstHBINARY;
    else
        TempStr := '';
    end;
    if TempStr <> '' then
      AddAttribute(fldAttrArea, szSUBTYPE, TempStr, False);
    if Info.Field is TObjectField then
      AddAttribute(fldAttrArea, szTYPENAME, TObjectField(Info.Field).ObjectType, False);
    if poIncFieldProps in Options then
      AddExtraFieldProps(Info.Field);
    case Info.Field.DataType of
      ftADT, ftArray: { Array will only have 1 child field }
        for i := 0 to High(TInfoArray(Info.FieldInfos)) do
          AddColumn(TInfoArray(Info.FieldInfos)[i]);
      ftDataSet, ftReference:
        with TDataSetField(Info.Field) do
          WriteMetaData(NestedDataSet, TInfoArray(Info.FieldInfos),
            Info.Field.DataType = ftReference);
    end;
  end;
end;

procedure TDataPacketWriter.AddConstraints(DataSet: TDataSet);
type
  TConstraintType = (ctField, ctRecord, ctDefault);

  procedure AddSQLExprAttr(ExprParser: TExprParser; const ExprText, ExprErrMsg,
    FieldName: string; FieldIndex: Integer; ConstraintType: TConstraintType;
    Required: Boolean);
  type
    PSQLExprInfo = ^TSQLExprInfo;
    TSQLExprInfo = packed record
      iErrStrLen: Integer;
      iFldNum: Integer;
      bReqExpr: BYTE;
    end;
  const
    TypeStr: array[TConstraintType] of PChar = (szBDEDOMX, szBDERECX, szBDEDEFX);
    Attr: Integer = dsVaryingFldType or SizeOf(Integer) or (dsfldBYTES shl dsSizeBitsLen);
  var
    ErrorStr: string;
    AttrType: PChar;
    Len, AttrSize: Integer;
    SQLExprInfo: PSQLExprInfo;
    Options: TParserOptions;
  begin
    if ExprText = '' then Exit;
    if (ConstraintType <> ctDefault) and (ExprErrMsg = '') then
    begin
      if (ConstraintType = ctField) and (FieldName <> '') then
        ErrorStr := Format('%s %s: %s %s',[SConstraintFailed, SField, FieldName, ExprText]) else
        ErrorStr := Format('%s %s',[SConstraintFailed, ExprText]);
    end else
      ErrorStr := ExprErrMsg;
    Len := Length(ErrorStr);
    if (Len > 0) then Inc(Len);
    SQLExprInfo := @FBuffer[SizeOf(Integer)];
    SQLExprInfo.iErrStrLen := Len;
    SQLExprInfo.iFldNum := FieldIndex;
    SQLExprInfo.bReqExpr := Ord(Required);
    Options := [poExtSyntax];
    if ConstraintType = ctDefault then Include(Options, poDefaultExpr);
    if ConstraintType = ctRecord then Include(Options, poUseOrigNames);
    if FieldName <> '' then Include(Options, poFieldNameGiven);
    with ExprParser do
    begin
      SetExprParams(ExprText, [], Options, FieldName);
      Move(FilterData[0], FBuffer[SizeOf(TSQLExprInfo) + Len + SizeOf(Integer)], DataSize);
      AttrSize := DataSize + SizeOf(TSQLExprInfo) + Len;
    end;
    PInteger(FBuffer)^ := AttrSize;
    if Len > 0 then
      StrLCopy(@FBuffer[SizeOf(TSQLExprInfo) + SizeOf(Integer)], PChar(ErrorStr), Length(FBuffer) - SizeOf(TSQLExprInfo) - SizeOf(Integer) - 1);
    AttrType := TypeStr[ConstraintType];
    Check(FIDSWriter.AddAttribute(pcktAttrArea, AttrType, Attr, AttrSize + SizeOf(Integer), PByte(FBuffer)));
  end;

var
  i: Integer;
  ExprParser: TExprParser;
  Constraints: TCheckConstraints;
  Obj: TObject;
  ErrMsg: string;
begin
  ExprParser := TExprParser.Create(DataSet, '', [], [], '', nil, FieldTypeMap);
  try
    Obj := GetObjectProperty(DataSet, 'Constraints'); { Do not localize }
    if (Obj <> nil) and (Obj is TCheckConstraints) then
    begin
      Constraints := Obj as TCheckConstraints;
      try
        for i := 0 to Constraints.Count - 1 do
          with Constraints[i] do
          begin
            AddSQLExprAttr(ExprParser, ImportedConstraint, ErrorMessage, '', 0,
              ctRecord, False);
            AddSQLExprAttr(ExprParser, CustomConstraint, ErrorMessage, '', 0,
              ctRecord, False);
          end;
      except
        if DataSet.Name <> '' then
          ErrMsg := Format('%s: %s',[DataSet.Name, SRecConstFail]) 
        else
          ErrMsg := SRecConstFail;
        if ExceptObject is Exception then
          raise EDSWriter.CreateFmt(ErrMsg, [Exception(ExceptObject).Message])
        else
          raise EDSWriter.CreateFmt(ErrMsg, ['']);
      end;
    end;
    for i := 0 to DataSet.FieldList.Count - 1 do
      with DataSet.FieldList[i] do
      begin
        try
          AddSQLExprAttr(ExprParser, DefaultExpression, '', FullName, i + 1,
            ctDefault, False);
        except
          if Name <> '' then
            ErrMsg := Format('%s: %s',[Name, SDefExprFail]) else
          if DataSet.Name <> '' then
            ErrMsg := Format('%s.%s: %s',[DataSet.Name, FullName, SDefExprFail]) else
            ErrMsg := Format('%s: %s', [FullName, SDefExprFail]);
          if ExceptObject is Exception then
            raise EDSWriter.CreateFmt(ErrMsg, [Exception(ExceptObject).Message])
          else
            raise EDSWriter.CreateFmt(ErrMsg, ['']);
        end;
        try
          AddSQLExprAttr(ExprParser, ImportedConstraint, ConstraintErrorMessage,
            FullName, i + 1, ctField, False);
          AddSQLExprAttr(ExprParser, CustomConstraint, ConstraintErrorMessage,
            FullName, i + 1, ctField, False);
        except
          if Name <> '' then
            ErrMsg := Format('%s: %s',[Name, SFieldConstFail]) else
          if DataSet.Name <> '' then
            ErrMsg := Format('%s.%s: %s',[DataSet.Name, FullName, SFieldConstFail]) else
            ErrMsg := Format('%s: %s', [FullName, SFieldConstFail]);
          if ExceptObject is Exception then
            raise EDSWriter.CreateFmt(ErrMsg, [Exception(ExceptObject).Message])
          else
            raise EDSWriter.CreateFmt(ErrMsg, ['']);
        end;
      end;
  finally
    ExprParser.Free;
  end;
end;

procedure TDataPacketWriter.AddIndexDefs(DataSet: TDataSet; const Info: TInfoArray);
var
  FieldList, CaseList, DescList: TList;

  function GetKeyData(Index: TIndexDef): OleVariant;
  var
    i: Integer;
    x: Integer;
  begin
    with Index do
    begin
      FieldList.Clear;
      CaseList.Clear;
      DescList.Clear;
      DataSet.GetFieldList(FieldList, Fields);
      DataSet.GetFieldList(CaseList, CaseInsFields);
      DataSet.GetFieldList(DescList, DescFields);
      Result := VarArrayCreate([0, FieldList.Count - 1], varInteger);
      for i := 0 to FieldList.Count - 1 do
      begin
        x := GetFieldIdx(TField(FieldList[i]).FieldName, Info);
        if (CaseList.IndexOf(FieldList[i]) <> -1) or
           ((i = 0) and (FieldList.Count = 1) and (ixCaseInSensitive in Options)) then
          x := x or dskeyCASEINSENSITIVE;
        if (DescList.IndexOf(FieldList[i]) <> -1) or
           ((i = 0) and (FieldList.Count = 1) and (ixDescending in Options)) then
          x := x or dskeyDESCENDING;
        Result[i] := x;
      end;
    end;
  end;

var
  i: Integer;
  DefIdx, KeyIndex: TIndexDef;
  IndexDefs: TIndexDefs;
  KeyList: OleVariant;
  KeyFields: string;
begin
  FieldList := TList.Create;
  try
    CaseList := TList.Create;
    try
      DescList := TList.Create;
      try
        { Get the DEFAULT_ORDER }
        if not (poRetainServerOrder in Options) then
          DefIdx := IProviderSupport(DataSet).PSGetDefaultOrder
        else
          DefIdx := nil;
        if Assigned(DefIdx) then
        try
          KeyList := GetKeyData(DefIdx);
          AddAttribute(pcktAttrArea, szDEFAULT_ORDER, KeyList, False);
        finally
          DefIdx.Free;
        end;
        KeyFields := IProviderSupport(DataSet).PSGetKeyFields;
        IndexDefs := IProviderSupport(DataSet).PSGetIndexDefs([ixUnique]);
        try
          if KeyFields <> '' then
          begin
            { PRIMARY_KEY is used to define the keyfields }
            KeyList := NULL;
            if Assigned(IndexDefs) then
            begin
              KeyIndex := IndexDefs.GetIndexForFields(KeyFields, False);
              if Assigned(KeyIndex) then
              begin
                KeyList := GetKeyData(KeyIndex);
                KeyIndex.Free;{ KeyIndex is already used, remove it from the list }
              end;
            end;
            if VarIsNull(KeyList) then
            begin
              DataSet.GetFieldList(FieldList, KeyFields);
              KeyList := VarArrayCreate([0, FieldList.Count - 1], varSmallInt);
              for i := 0 to FieldList.Count - 1 do
                KeyList[i] := GetFieldIdx(TField(FieldList[i]).FieldName, Info);
            end;
            if not VarIsNull(KeyList) then
              AddAttribute(pcktAttrArea, szPRIMARY_KEY, KeyList, False);
          end;
          if Assigned(IndexDefs) then
            for i := 0 to IndexDefs.Count - 1 do
              with IndexDefs[i] do
              begin
                KeyList := GetKeyData(IndexDefs[i]);
                AddAttribute(pcktAttrArea, szUNIQUE_KEY, KeyList, False);
              end;
        finally
          IndexDefs.Free;
        end;
      finally
        DescList.Free;
      end;
    finally
      CaseList.Free;
    end;
  finally
    FieldList.Free;
  end;
end;

procedure TDataPacketWriter.AddFieldLinks(const Info: TInfoArray);
var
  MasterFields, DetailFields: TList;
  i, j: Integer;
  LinkFields: Variant;
begin
  MasterFields := TList.Create;
  try
    DetailFields := TList.Create;
    try
      for i := 0 to High(Info) do
        if Info[i].IsDetail and (Info[i].Field = nil) then
        begin
          Info[i].DataSet.GetDetailLinkFields(MasterFields, DetailFields);
          if (MasterFields.Count > 0) and (MasterFields.Count <= DetailFields.Count) then
          begin
            LinkFields := VarArrayCreate([0, MasterFields.Count * 2], varSmallInt);
            LinkFields[0] := Info[i].LocalFieldIndex;
            for j := 0 to MasterFields.Count - 1 do
              LinkFields[j + 1] := GetFieldIdx(TField(MasterFields[j]).FieldName,
                Info);
            for j := 0 to MasterFields.Count - 1 do
              LinkFields[j + MasterFields.Count + 1] :=
                GetFieldIdx(TField(DetailFields[j]).FieldName, TInfoArray(Info[i].FieldInfos));
            AddAttribute(pcktAttrArea, szMD_FIELDLINKS, LinkFields, False);
          end;
        end;
    finally
      DetailFields.Free;
    end;
  finally
    MasterFields.Free;
  end;
end;

procedure TDataPacketWriter.WriteMetaData(DataSet: TDataSet; const Info: TInfoArray;
  IsReference: Boolean);
var
  i, MDOptions: Integer;
begin
  for i := 0 to High(Info) do
    AddColumn(Info[i]);
  if (poReadOnly in Options) or IsReference then
    AddAttribute(pcktAttrArea, szREADONLY, True, False);
  if (poDisableEdits in Options) then
    AddAttribute(pcktAttrArea, szDISABLE_EDITS, True, False);
  if (poDisableInserts in Options) then
    AddAttribute(pcktAttrArea, szDISABLE_INSERTS, True, False);
  if (poDisableDeletes in Options) then
    AddAttribute(pcktAttrArea, szDISABLE_DELETES, True, False);
  if (poNoReset in Options) then
    AddAttribute(pcktAttrArea, szNO_RESET_CALL, True, False);
  if Constraints then
    AddConstraints(DataSet);
  AddIndexDefs(DataSet, Info);
  AddFieldLinks(Info);
  MDOptions := 0;
  if poCascadeDeletes in Options then MDOptions := dsCASCADEDELETES;
  if poCascadeUpdates in Options then MDOptions := MDOptions or dsCASCADEUPDATES;
  if MDOptions <> 0 then
    AddAttribute(pcktAttrArea, szMD_SEMANTICS, MDOptions, True);
  AddDataSetAttributes(DataSet);
  if Info <> FPutFieldInfo then
    Check(FIDSWriter.AddAttribute(pcktAttrArea, nil, 0, 0, nil));
end;

procedure TDataPacketWriter.RefreshPutProcs(ADataSet: TDataSet; var Info: TInfoArray);

  procedure RefreshInfo(ADataSet: TDataSet; AField: TField; var Info: TPutFieldInfo);
  var
    j: Integer;
  begin
    Info.Field := AField;
    if AField = nil then
      Info.DataSet := ADataSet
    else
    begin
      Info.DataSet := AField.DataSet;
      if AField.DataType = ftADT then
      begin
        with TADTField(AField) do
        for j := 0 to FieldCount - 1 do
          RefreshInfo(ADataSet, Fields[j], TInfoArray(Info.FieldInfos)[j]);
      end;
    end;
  end;

var
  i: Integer;
  List: TList;
begin
  List := TList.Create;
  try
    ADataSet.GetDetailDataSets(List);
    for i := 0 to ADataSet.FieldCount - 1 do
      RefreshInfo(ADataSet, ADataSet.Fields[i], Info[i]);
    for i := 0 to List.Count - 1 do
      RefreshInfo(TDataSet(List[i]), nil, Info[ADataSet.FieldCount + i]);
  finally
    List.Free;
  end;
end;

function TDataPacketWriter.InitPutProcs(ADataSet: TDataSet;
  var GlobalIdx: Integer): TInfoArray;

  procedure InitInfoStruct(var Info: TPutFieldInfo; AField: TField;
    var GlobalIdx, LocalIdx: Integer);
  begin
    FillChar(Info, SizeOf(Info), 0);
    with Info do
    begin
      IsDetail := AField = nil;
      Field := AField;
      Inc(GlobalIdx);
      LocalFieldIndex := LocalIdx;
      Inc(LocalIdx);
      if Field <> nil then
      begin
        FieldNo := Field.FieldNo;
        Size := Field.DataSize;
        DataSet := Field.DataSet;
      end;
    end;
  end;

  procedure InitFieldProc(ADataSet: TDataSet; AField: TField;
    var Info: TPutFieldInfo; var GlobalIdx, LocalIdx: Integer);
  var
    i: Integer;
    NestedIdx: Integer;
  begin
    with Info do
    begin
      InitInfoStruct(Info, AField, GlobalIdx, LocalIdx);
      if AField = nil then { Linked dataset }
      begin
        Opened := not ADataSet.Active;
        if Opened then ADataSet.Open;
        DataSet := ADataSet;
        PutProc := PutDataSetField;
        TInfoArray(FieldInfos) := InitPutProcs(DataSet, GlobalIdx);
      end else
      begin
        case Field.DataType of
          ftString, ftFixedChar, ftGUID:
          begin
            PutProc := PutStringField;
            Dec(Size);  { Don't count the null terminator }
          end;
          ftWideString:
          begin
            PutProc := PutWideStringField;
            Size := AField.Size * 2;
          end;
          ftVarBytes:
          begin
            PutProc := PutVarBytesField;
            Dec(Size, 2); { Don't write size bytes }
          end;
          ftADT:
          with TADTField(Field) do
          begin
            PutProc := PutADTField;
            SetLength(TInfoArray(FieldInfos), FieldCount);
            for i := 0 to FieldCount - 1 do
              InitFieldProc(ADataSet, Fields[i], TInfoArray(FieldInfos)[i],
                GlobalIdx, LocalIdx);
          end;
          ftArray:
          with TArrayField(Field) do
          begin
            PutProc := PutArrayField;
            SetLength(TInfoArray(FieldInfos), 1);
            NestedIdx := LocalIdx;
            InitFieldProc(ADataSet, Fields[0], TInfoArray(FieldInfos)[0],
                GlobalIdx, LocalIdx);
            LocalIdx := (LocalIdx - NestedIdx) * (FieldCount - 1) + LocalIdx;
          end;
          ftDataSet, ftReference:
          with TDataSetField(Field).NestedDataSet do
          begin
            PutProc := PutDataSetField;
            NestedIdx := 1;
            SetLength(TInfoArray(FieldInfos), FieldCount);
            for i := 0 to FieldCount - 1 do
              InitFieldProc(TDataSetField(Field).NestedDataSet, Fields[i],
                TInfoArray(FieldInfos)[i], GlobalIdx, NestedIdx);
          end;
          ftSmallint, ftInteger, ftWord, ftBoolean, ftFloat, ftCurrency, ftBCD,
          ftDate, ftTime, ftDateTime, ftAutoInc, ftLargeint, ftBytes, ftTimeStamp, ftFMTBcd:
            PutProc := PutField;
          ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftOraBlob, ftOraClob:
            PutProc := PutBlobField;
        else
          DatabaseErrorFmt(SUnknownFieldType, [Field.FieldName]);
        end;
        if Field.FieldKind <> fkData then
          PutProc := PutCalcField;
      end;
    end;
  end;

var
  i, LocalIdx: Integer;
  List: TList;
begin
  LocalIdx := 1;
  List := TList.Create;
  try
    ADataSet.GetDetailDataSets(List);
    SetLength(Result, ADataSet.FieldCount + List.Count);
    for i := 0 to ADataSet.FieldCount - 1 do
      InitFieldProc(ADataSet, ADataSet.Fields[i], Result[i], GlobalIdx, LocalIdx);
    for i := 0 to List.Count - 1 do
      InitFieldProc(TDataSet(List[i]), nil, Result[ADataSet.FieldCount + i],
        GlobalIdx, LocalIdx);
  finally
    List.Free;
  end;
end;

procedure TDataPacketWriter.GetDataPacket(DataSet: TDataSet;
  var RecsOut: Integer; out Data: OleVariant);

  procedure CheckMetaData(DataSet: TDataSet);
  var
    Idx: Integer;
    TempPacket: TDataPacket;
    Version: Integer;
  begin
    Idx := 1;
    if (FPutFieldInfo = nil) or (grMetaData in PacketOptions) then
    begin
      CreateDBClientObject(CLSID_DSWriter, IDSWriter, FIDSWriter);
      if FPutFieldInfo <> nil then
      begin
        FreeInfoRecords(FPutFieldInfo);
        FPutFieldInfo := nil;
      end;
      FPutFieldInfo := InitPutProcs(DataSet, Idx);
      if poFetchBlobsOnDemand in Options then
        Version := PACKETVERSION_3 else
        Version := PACKETVERSION_1;
      if grXMLUTF8 in PacketOptions then
        FIDSWriter.SetXMLMode(xmlUTF8)
      else if grXML in PacketOptions then
        FIDSWriter.SetXMLMode(xmlON)
      else
        FIDSWriter.SetXMLMode(0);
      Check(FIDSWriter.Init_Sequential(Version, Idx - 1));
      WriteMetaData(DataSet, FPutFieldInfo);
      if not (grMetaData in PacketOptions) then
      begin
        FIDSWriter.GetDataPacket(TempPacket);
        SafeArrayCheck(SafeArrayDestroy(TempPacket));
        TempPacket := nil;
      end;
    end;
    if not (grMetaData in PacketOptions) then
      Check(FIDSWriter.Reset);
  end;

var
  DataPacket: TDataPacket;
begin
    CheckMetaData(DataSet);
    RecsOut := WriteDataSet(DataSet, FPutFieldInfo, RecsOut);
    FIDSWriter.GetDataPacket(DataPacket);
    DataPacketToVariant(DataPacket, Data);
end;