dataset2variantunit.pas

实达企业在线EOL源码

unit Dataset2VariantUnit;

interface
  uses db,AdoDb,dbClient,dialogs,SysUtils;

{数据打包函数
   输入：DataSet：要打包的数据集
         PakaetRecords：记录个数
                =-1：所有
                =-2:所有数据，不包括结构
                =0：只包括结构

   输出：
         Data：数据包
   函数返回值
         =0：成功
         =-1：不成功
}
function CreateDataPacket(Dataset:TDataSet;var Data:OleVariant;
  const RequireHead:Boolean=True;const PacketRecords:Integer=-1):Integer;
function ReleaseDataPacket(Dataset:TDataSet;Data:OleVariant;
  const RequireHead:Boolean=True;const PacketRecords:Integer=-1):Integer;
  //复制数据集，Method=0复制，Method=1移动
function CopyDataset(SrcDataset,DestDataset:TClientDataset;Method:integer):Integer;
function CopyStructure(SrcDataset,DestDataset:TclientDataset):integer;

function ReleaseToADO(Dataset:TADODataSet;Data:OleVariant;
  const RequireHead:Boolean=True;const PacketRecords:Integer=-1):Integer;
function ReleaseTOClnt(Dataset:TClientDataSet;Data:OleVariant;
  const RequireHead:Boolean=True;const PacketRecords:Integer=-1):Integer;

implementation

function CreateDataPacket(Dataset:TDataSet;var Data:OleVariant;
  const RequireHead:Boolean=True;const PacketRecords:Integer=-1):Integer;
var
  iColCount,iRowCount,iTotal,i:integer;
  //打包表头
  function PacketColInfo(iStart:integer):Variant;
  var
     i:integer;
     vColumn:Variant;
  begin
     Result:=Null;

     vColumn:=VarArrayCreate([0,2],VarVariant);
     for i:=0 to DataSet.FieldCount-1 do
     if Dataset.Fields[i].DataType<>ftDataset then
     begin
       vColumn[0]:=Dataset.Fields[i].FieldName;
       vColumn[1]:=Dataset.Fields[i].DataType;
       vColumn[2]:=Dataset.Fields[i].Size;
       Data[iStart]:=vColumn;
       Inc(iStart);
     end;
  end;

  procedure PacketRecord(PacketRecords,iStart:Integer);
  var
    bkPlace:TBookMark;
    vRecord:Variant;
    i,iCount,iCurCol:integer;
  begin
    if not (DataSet.Active) then Exit;
    if DataSet.RecordCount=0 then Exit;
    DataSet.DisableControls;
    bkPlace:=Dataset.GetBookmark;

    //如果不是打包所有记录，则从当前记录开始打包
    if PacketRecords<0 then Dataset.First;
    iCount:=0;
    while not Dataset.Eof do
    begin
       //创建一行的可变数组
       VRecord:=VarArrayCreate([0,iColCount-1],VarVariant);

       //对一行的数组赋值
       iCurCol:=0;
       for i:=0 to Dataset.FieldCount-1 do
         //忽略内嵌数据集
         if DataSet.Fields[i].DataType<>ftDataset then
         begin
            VRecord[iCurCol]:=DataSet.Fields[i].Value;
            Inc(iCurCol);
         end;

       Data[iStart]:=Vrecord;
       Inc(iStart);
       DataSet.Next;

       //增加记录条数变量，判断是否已打包了要求数量的记录
       Inc(iCount);
       if (PacketRecords>0) and (iCOunt>=PacketRecords) then Break;
    end;
    Dataset.GotoBookmark(bkPlace);
    Dataset.EnableControls;
  end;

begin
  Result:=-1;
  Data:=Null;
  //如果不要表头且记录个数为0 则直接退出
  if PacketRecords<>0 then
  begin
    if not DataSet.Active then Exit;
    if DataSet.RecordCount=0 then Exit;
    iRowCount:=Dataset.RecordCount;
  end
  else
  begin
    if not RequireHead then Exit;
    iRowCount:=0;
  end;


  //计算有多少列，去掉不需要的列
  iColCount:=0;
  for i:=0 to Dataset.FieldCount-1 do
    if Dataset.Fields[i].DataType<>ftDataset then Inc(iColCount);
  //首先计算打包的记录条数（每列一条，每行也一条）
  iTotal:=1;//至少一条，用于放行、列数量

  //表头的数量
  if RequireHead then
  begin
     iTotal:=iTotal+iColCount;
  end;

  //表体，记录的数量
  if (PacketRecords>0) and (PacketRecords<iRowCount) then
     iTotal:=iTotal+PacketRecords
  else
     iTotal:=iTotal+iRowCount;

  //创建数组，并在第一元素中记录列、行的数量
  Data:=VarArrayCreate([0,iTotal],varVariant);

  if RequireHead then
  begin
     if PacketRecords=0 then
     begin
       Data[0]:=VarArrayof([iColCount,0]);
       //打包表头
       PacketColInfo(1);
     end
     else if (PacketRecords>0) and (PacketRecords<iRowCount) then
     begin
       Data[0]:=VarArrayof([iColCount,PacketRecords]);
       //打包表头
       PacketColInfo(1);
       PacketRecord(PacketRecords,iColCount+1);
     end
     else
     begin
       Data[0]:=VarArrayof([iColCount,iRowCount]);
       //打包表头
       PacketColInfo(1);
       PacketRecord(PacketRecords,iColCount+1);
     end;
  end
  else
  begin
     //不要表头
     if (PacketRecords>0) and (PacketRecords<iRowCount) then
     begin
       Data[0]:=VarArrayof([0,PacketRecords]);
       //打包表头
       PacketColInfo(1);
       PacketRecord(PacketRecords,iColCount+1);
     end
     else
     begin
       Data[0]:=VarArrayof([iColCount,iRowCount]);
       //打包表头
       PacketColInfo(1);
       PacketRecord(PacketRecords,iColCount+1);
     end;
  end;
  Result:=0;
end;

function ReleaseToClnt(Dataset:TClientDataSet;Data:OleVariant;
  const RequireHead:Boolean=True;const PacketRecords:Integer=-1):Integer;
  procedure ReleaseCol(iStart:Integer);
  var
    i,iColCount:integer;
    szFieldName:string;
    dtDataType:TDataType;
    iSize:integer;
  begin
    iColCount:=Data[0][0];
    DataSet.FieldDefs.Clear;
    for i:=0 to iColCount-1 do
    begin
        szFieldName:=Data[iStart][0];
        dtDataType:=Data[iStart][1];
        iSize:=Data[iStart][2];
        Dataset.FieldDefs.Add(szFieldName,dtDataType,iSize);
        Inc(iStart);
    end;
  end;

  procedure ReleaseRow(PacketRecords,iStart:Integer);
  var
    iCol,iRow,iRowCount,iColCOunt:integer;
    vValue:Variant;
  begin
    iColCount:=Data[0][0];
    iRowCount:=Data[0][1];

    //如果指定了解包的数据记录条数，则限制只解开指定的记录数量
    if (PacketRecords>0) and (PacketRecords<iRowCount) then
       iRowCount:=PacketRecords;

    DataSet.CreateDataSet;
    for iRow:=0 to iRowCount-1 do
    begin
      Dataset.Append;
      for iCol:=0 to iColCount-1 do
      begin
        vValue:=Data[iStart][iCol];
        Dataset.Fields[iCol].Value:=vValue;
      end;
      Dataset.Post;
      Inc(iStart);
    end;
  end;
var
  iRowCount,iColCount:integer;
begin
  Result:=-1;
  Dataset.Close;
  if VarIsNUll(Data) then Exit;
  if VarisEmpty(Data) then Exit;
  if not VarisArray(Data) then exit;

  if (not RequireHead) and (PacketRecords=0) then Exit;

  iColCount:=Data[0][0];
  iRowCount:=Data[0][1];

  if RequireHead and (iColCount<=0) then Exit;
  if (PacketRecords<>0) and (iRowCount<=0) then Exit;

  if RequireHead then
  begin
     if PacketRecords=0 then
        ReleaseCol(1)
     else
     begin
        ReleaseCol(1);
        ReleaseRow(PacketRecords,iColCount+1);
     end;
  end
  else
     ReleaseRow(PacketRecords,1);

  Result:=0;
end;

function ReleaseToADO(Dataset:TADODataSet;Data:OleVariant;
  const RequireHead:Boolean=True;const PacketRecords:Integer=-1):Integer;
  procedure ReleaseCol(iStart:Integer);
  var
    i,iColCount:integer;
    szFieldName:string;
    dtDataType:TDataType;
    iSize:integer;
  begin
    iColCount:=Data[0][0];
    DataSet.FieldDefs.Clear;
    for i:=0 to iColCount-1 do
    begin
        szFieldName:=Data[iStart][0];
        dtDataType:=Data[iStart][1];
        iSize:=Data[iStart][2];
        Dataset.FieldDefs.Add(szFieldName,dtDataType,iSize);
        Inc(iStart);
    end;
  end;

  procedure ReleaseRow(PacketRecords,iStart:Integer);
  var
    iCol,iRow,iRowCount,iColCOunt:integer;
    vValue:Variant;
  begin
    iColCount:=Data[0][0];
    iRowCount:=Data[0][1];

    //如果指定了解包的数据记录条数，则限制只解开指定的记录数量
    if (PacketRecords>0) and (PacketRecords<iRowCount) then
       iRowCount:=PacketRecords;

    DataSet.CreateDataSet;
    for iRow:=0 to iRowCount-1 do
    begin
      Dataset.Append;
      for iCol:=0 to iColCount-1 do
      begin
        vValue:=Data[iStart][iCol];
        Dataset.Fields[iCol].Value:=vValue;
      end;
      Dataset.Post;
      Inc(iStart);
    end;
  end;
var
  iRowCount,iColCount:integer;
begin
  Result:=-1;
  Dataset.Close;
  if VarIsNUll(Data) or VarisEmpty(Data) then Exit;
  if not VarisArray(Data) then exit;
  if (not RequireHead) and (PacketRecords=0) then Exit;

  iColCount:=Data[0][0];
  iRowCount:=Data[0][1];
  if RequireHead and (iColCount<=0) then Exit;
  if (PacketRecords<>0) and (iRowCount<=0) then Exit;

  if RequireHead then
  begin
     if PacketRecords=0 then
        ReleaseCol(1)
     else
     begin
        ReleaseCol(1);
        ReleaseRow(PacketRecords,iColCount+1);
     end;
  end
  else
     ReleaseRow(PacketRecords,1);

  Result:=0;
end;

function ReleaseDataPacket(Dataset:TDataSet;Data:OleVariant;
  const RequireHead:Boolean=True;const PacketRecords:Integer=-1):Integer;
begin
  if Dataset is TClientDataset then
    Result:=ReleaseTOClnt(TClientDataset(DataSet),Data,RequireHead,
       PacketRecords)
  else if Dataset is TADODataset then
    Result:=ReleaseToAdo(TADODataset(DataSet),Data,RequireHead,
       PacketRecords)
  else Result:=-1;
end;

function CopyDataset(SrcDataset,DestDataset:TClientDataset;Method:integer):Integer;
var
  Data:OleVariant;
  i:integer;
  sFieldName:string;
begin
  Result:=-1;
  if not assigned(SrcDataset) then exit;
  if not assigned(DestDataset) then exit;
  if CreateDataPacket(SrcDataset,Data,True,0)<>0 then exit;
  if ReleaseDataPacket(DestDataset,Data,True,0)<>0 then exit;
  if SrcDataset.RecordCount>0 then
  begin
    SrcDataset.First;
    DestDataSet.CreateDataSet;
    while not SrcDataset.eof do
    begin
       DestDataset.Append;
       for i:=0 to SrcDataset.FieldCount-1 do
       begin
          sFieldName:=SrcDataset.Fields[i].FieldName;
          if DestDataset.FindField(sFieldName)<>nil then
              DestDataset.FieldByName(sFieldName).Value:=SrcDataset.Fields[i].Value;
       end;
       DestDataset.Post;
       if Method=0 then
          SrcDataset.Next
       else
         SrcDataset.Delete
    end;
  end;
  Result:=0;
end;

function CopyStructure(SrcDataset,DestDataset:TclientDataset):integer;
var
 Data:OleVariant;
begin
  Result:=-1;
  if not assigned(SrcDataset) then exit;
  if not assigned(DestDataset) then exit;
  if CreateDataPacket(SrcDataset,Data,True,0)<>0 then exit;
  if ReleaseDataPacket(DestDataset,Data,True,0)<>0 then exit;
  Result:=0;
end;

end.