ADO的数据泵

{*******************************************************}
{                                                       }
{       ADO数据泵                                       }
{                                                       }
{       版权所有 (C) 2008 咏南工作室(陈新光)            }
{                                                       }
{*******************************************************}

//==============================================================================
// batCopy 先删除已存在的表，再创建新表，再往表中增加数据
// batAppend 往已存在的表中追加数据
// dsQuery 源数据集控件是TADOQUERY
// dsTable 源数据集控件是TADOTABLE
// 不同的数据库，关键只在datatypetoaccesstypeandsize()，即字段类型转换
//==============================================================================

unit ADOBatchMove;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, stdctrls,Forms,
  Dialogs,Db, ADODB;

type TADOBatchMode = (batAppend, batCopy);

type TADOSourceMode = (dsTable,dsQuery);

type
  TADOBatchMove = class(TComponent)
private
  FDESTADOQuery: TADOQuery;
  FDESTADOTable: TADOTable;
  FSOURCEADOQuery: TADOQuery ;
  FSOURCEADOTable: TADOTable;
  FADOConnection: TADOConnection; //目标数据库连接件
  FStringList: TStringList;
  FMode:TADOBatchMode;
  FSourceMode:TADOSourceMode;
  function ADObatchmoveTabletoTableTest():boolean;
  function ADObatchmoveQuerytoTableTest():boolean;
  function ADOTableExistTest(ADOTableTest: TADOTable):boolean;
  function ADOTableCreatefromTable(ADOTablepara: TADOTable):boolean;
  function ADOTableCreatefromQuery(ADOTablepara: TADOTable):boolean;
  function ADOTableDatafromTable(ADOTablepara: TADOTable):boolean;
  function ADOTableDatafromQuery(ADOTablepara: TADOTable):boolean;
  procedure SETSOURCEADOQuery(Value: Tadoquery);
  procedure SETSOURCEADOTable(Value: TadoTable);
  function datatypetoaccesstypeandsize(ftdef:TFielddef):string;
  { Private declarations }
protected
  { Protected declarations }
public
  procedure ADObatchmoveTabletoTable();
  procedure ADObatchmoveQuerytoTable();
  procedure Execute;
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  { Public declarations }
published
  property SourceMode: TADOSourceMode read FSourceMode write FSourceMode;
  property Mode: TADOBatchMode read FMode write FMode;
  property SourceQuery: TADOQuery read FSOURCEADOQuery write SETSOURCEADOQuery ;
  property SourceTable: TADOTable read FSOURCEADOTable write SETSOURCEADOTable;
  property DestTable: TADOTable read FDESTADOTable write FDESTADOTable;
  { Published declarations }
end;

procedure Register;

implementation

uses Registry, TypInfo, unitgauge;

procedure Register;
begin
  RegisterComponents('ado', [TADOBatchMove]);   //edit by cxg
end;

constructor TADOBatchMove.Create(AOwner: TComponent);
begin
  inherited;
  FDestADOTable:= TADOTable.create(self);
  FDESTADOQuery:= TADOQuery.create(self);
  FSOURCEADOTable:= TADOTable.create(self);
  FSOURCEADOQuery:= TADOQuery.create(self);
  FSOURCEADOtable:= nil;
  FSOURCEADOQuery:= nil;
  FDestADOTable:= nil;
  FADOConnection:= TADOConnection.create(self);
  FStringList:= TStringList.create;
end;

destructor TADOBatchMove.Destroy;
begin
  inherited;
end;

//==============================================================================
// 转换DELPHI字段类型为ACCESS字段类型
//==============================================================================

function TADOBatchMove.datatypetoaccesstypeandsize(ftdef:TFielddef):string;
begin
  with ftdef do
  begin
    case DataType of
      ftstring: Result:='varchar(100)';
      ftWideString: Result:='varchar(100)';
      ftsmallint: result:='integer';
      ftinteger: Result:='integer';
      ftfloat: Result:='double';
      ftcurrency: result:='money';
      ftbcd: Result:='decimal(18,2)';
      ftboolean: result:='bit';
      ftDateTime: Result:='datetime';
    else Result:='varchar(100)';
    end;
  end;
end;

procedure TADOBatchMove.SETSOURCEADOQuery(Value: Tadoquery);
begin
  FSOURCEADOQuery := Value;
  FSOURCEADOtable:= nil;
  FSourceMode:=dsquery;
  if Value <> nil then Value.FreeNotification(Self);
end;

procedure TADOBatchMove.SETSOURCEADOTable(Value: TadoTable);
begin
  FSOURCEADOtable := Value;
  FSOURCEADOQuery:= nil;
  FSourceMode:=dsTable;
  if Value <> nil then Value.FreeNotification(Self);
end;

{ 测试将要建立的数据表是否已经存在，如存在，则删除后重建 }
function TADOBatchMove.ADOTableExistTest(ADOTableTest: TADOTable):boolean;
var
  i:integer;
begin
  result:=false;
  ADOTableTest.Close;
  FADOConnection.close;
  FADOConnection.loginprompt:=false;
  FADOConnection.connectionString:=ADOTableTest.connectionString;
  FADOConnection.open;
  FADOConnection.GetTableNames(FStringList, False);
  for i:=0 to FStringList.count-1 do
  begin
    if FStringList.Strings[i]=ADOTableTest.Tablename then
    begin
      result:=true;
      exit;
    end;
  end;
end;

function TADOBatchMove.ADOTableCreatefromTable(ADOTablepara: TADOTable):boolean;
var
  i:integer;
begin
  //下面利用源数据（ado表）创建新表
  result:=false;
  FDESTADOQuery.connectionString:=ADOTablepara.connectionString;
  FSOURCEADOTable.open;
  FDESTADOQuery.sql.Clear;
  FDESTADOQuery.sql.add('create table '+ADOTablepara.Tablename +' (');
  for i:=0 to FSOURCEADOTable.fielddefs.count-1 do
  begin
    if i< FSOURCEADOTable.fielddefs.count-1 then
      FDESTADOQuery.sql.add(FSOURCEADOTable.fielddefs[i].name+' '+
        datatypetoaccesstypeandsize(FSOURCEADOTable.fielddefs[i]) +',')
    else
      FDESTADOQuery.sql.add(FSOURCEADOTable.fielddefs[i].name+' '+
        datatypetoaccesstypeandsize(FSOURCEADOTable.fielddefs[i]) +' )');
  end;
  FDESTADOQuery.execsql;
  FDESTADOQuery.close;
  result:=true;
end;

function TADOBatchMove.ADOTableDatafromTable(ADOTablepara: TADOTable):boolean;
var
  i:integer;
begin
  //下面从源表传输数据
  result:=false;
  Frmgauge:=TFrmgauge.create(self);
  FSOURCEADOTable.open;
  Frmgauge.Gauge.MaxValue:=0;
  Frmgauge.ShowModal;
  Frmgauge.Gauge.MaxValue:=FSOURCEADOTable.RecordCount;
  ADOTablepara.active:=true;
  while not FSOURCEADOTable.eof do
  begin
    ADOTablepara.insert;
    for i:=0 to FSOURCEADOTable.fieldcount-1 do
      ADOTablepara.Fields.Fields[i]:=FSOURCEADOTable.Fields.Fields[i];
    ADOTablepara.post;
    Frmgauge.Gauge.Progress:=FSOURCEADOTable.Recno;
    FSOURCEADOTable.next;
  end;
  ADOTablepara.close;
  FSOURCEADOTable.close;
  Frmgauge.Free;
  result:=true;
end;

function TADOBatchMove.ADOTableCreatefromQuery(ADOTablepara: TADOTable):boolean;
var
  i:integer;
begin
  result:=false;     //下面利用源数据(ado查询）创建新表
  FDESTADOQuery.connectionString:=ADOTablepara.connectionString;
  FDESTADOQuery.sql.Clear;
  FDESTADOQuery.sql.add('create table '+ ADOTablepara.Tablename +'(');
  for i:=0 to FSOURCEADOQuery.fielddefs.Count-1 do begin
    if i<FSOURCEADOQuery.fielddefs.Count-1 then
      FDESTADOQuery.SQL.Add(FSOURCEADOQuery.fielddefs[i].Name+' '+
        datatypetoaccesstypeandsize(FSOURCEADOQuery.fielddefs[i])+',')
    else FDESTADOQuery.SQL.Add(FSOURCEADOQuery.fielddefs[i].name+' '+
      datatypetoaccesstypeandsize(FSOURCEADOQuery.fielddefs[i])+')');
  end;
  FDESTADOQuery.execsql;
  FDESTADOQuery.close;
  result:=true;
end;

function TADOBatchMove.ADOTableDatafromQuery(ADOTablepara: TADOTable):boolean;
var
  i:integer;
begin
  result:=false;   //下面从源查询传输数据
  Frmgauge:=TFrmgauge.create(self);
  FSOURCEADOQuery.open;
  ADOTablepara.Open;
  FSOURCEADOQuery.First;
  while not FSOURCEADOQuery.eof do
  begin
    ADOTablepara.insert;
    for i:=0 to FSOURCEADOQuery.fieldcount-1 do
    begin
      ADOTablepara.Fields.Fields[i]:=FSOURCEADOQuery.Fields.Fields[i];
    end;
    ADOTablepara.post;
    Frmgauge.Gauge.MaxValue:=FSOURCEADOQuery.RecordCount;   //显示进度条
    Frmgauge.Gauge.Progress:=FSOURCEADOQuery.Recno;
    Frmgauge.Show;
    FSOURCEADOQuery.next;
  end;
  ADOTablepara.close;
  Frmgauge.Free;                                         //释放进度条窗口
  result:=true;
end;

function TADOBatchMove.ADObatchmoveTabletoTableTest():boolean;
var
  sourcefield,destfield:string;
  i:integer;
begin
  if Fmode=batAppend then
  begin
    result:=false;
    FSOURCEADOTable.active:=true;
    FDESTADOTable.active:=true;
    IF FSOURCEADOTable.active=true AND FDESTADOTable.active=true THEN
    begin
      if FSOURCEADOTable.fieldcount=FDESTADOTable.fieldcount then
      begin
        result:=true;
        for i:=0 to FSOURCEADOTable.fieldcount-1 do
        begin
        sourcefield:=datatypetoaccesstypeandsize(FSOURCEADOTable.fielddefs[i]);
        destfield:=datatypetoaccesstypeandsize(FDESTADOTable.fielddefs[i]);
        if sourcefield<>destfield then result:=false;
        end;
      end;
    end;
  end else begin
    if ADOTableExistTest(FDESTADOTable) then result:=true
    else result:=false;
  end;
end;
procedure TADOBatchMove.ADObatchmoveTabletoTable();
var
  i:integer;
begin
  if Fmode=batAppend then
  begin
    if ADObatchmoveTabletoTableTest then
    begin
      FSOURCEADOTable.Open;
      FDESTADOTable.open;
      while not FSOURCEADOTable.eof do
      begin
        FDESTADOTable.insert;
        for i:=0 to FSOURCEADOTable.fieldcount-1 do
          FDESTADOTable.Fields.Fields[i]:=FSOURCEADOTable.Fields.Fields[i];
        FDESTADOTable.post;
        FSOURCEADOTable.next;
      end;
      FSOURCEADOTable.close;
      FDESTADOTable.close;
    end else showmessage('传输数据失败！');
  end else begin
    if ADObatchmoveTabletoTableTest then
    begin
      FDESTADOTable.close;
      FDESTADOQuery.connectionString:=FDESTADOTable.connectionString;
      FDESTADOQuery.SQL.Clear;
      FDESTADOQuery.sql.Add('drop table '+FDESTADOTable.TableName);
      FDESTADOQuery.execsql;
      ADOTableCreatefromTable(FDESTADOTable);
      ADOTableDatafromTable(FDESTADOTable);
    end else begin
      ADOTableCreatefromTable(FDESTADOTable);
      ADOTableDatafromTable(FDESTADOTable);
    end;
  end;
end;

function TADOBatchMove.ADObatchmoveQuerytoTableTest():boolean;
var
  sourcefield,destfield:string;
  i:integer;
begin
  result:=false;
  if Fmode=batAppend then      //批增加
  begin
    result:=false;
    FSOURCEADOQuery.active:=true;
    FDESTADOTable.active:=true;
    IF FSOURCEADOQuery.active=true AND FDESTADOTable.active=true THEN
    begin
      if FSOURCEADOQuery.fieldcount=FDESTADOTable.fieldcount then
      begin
        result:=true;
        for i:=0 to FSOURCEADOQuery.fieldcount-1 do
        begin
          sourcefield:=datatypetoaccesstypeandsize(FSOURCEADOQuery.fielddefs[i]);
          destfield:=datatypetoaccesstypeandsize(FDESTADOTable.fielddefs[i]);
          if sourcefield<>destfield then result:=false;
        end;
      end;
    end;
  end else begin             //批复制             
    if ADOTableExistTest(FDESTADOTable) then result:=true
    else result:=false;
  end;
end;

//==============================================================================
// drop table 改在分组统计之后立即进行
// 放在此处不合理
//==============================================================================

procedure TADOBatchMove.ADObatchmoveQuerytoTable();
var
  i:integer;
begin
  if Fmode=batAppend then                    //批增加
  begin
    if ADObatchmoveQuerytoTableTest then
    begin
      FSOURCEADOQuery.open;
      FDESTADOTable.open;
      while not FSOURCEADOQuery.eof do
      begin
        FDESTADOTable.insert;
        for i:=0 to FSOURCEADOQuery.fieldcount-1 do
        begin
        FDESTADOTable.Fields.Fields[i]:=FSOURCEADOQuery.Fields.Fields[i];
        end;
        FDESTADOTable.post;
        FSOURCEADOQuery.next;
      end;
      FDESTADOTable.close;
      FSOURCEADOQuery.close;
    end else showmessage('传输数据失败！');
  end else begin                           //批复制
    if ADObatchmoveQuerytoTableTest then   //如果数据表已经存在，则删除重建
    begin
      FDESTADOTable.close;                
      FDESTADOQuery.connectionString:=FDESTADOTable.connectionString;
      FDESTADOQuery.SQL.Clear;
      FDESTADOQuery.sql.Add('drop table '+FDESTADOTable.TableName);
      FDESTADOQuery.execsql;
      ADOTableCreatefromQuery(FDESTADOTable);
      ADOTableDatafromQuery(FDESTADOTable);
    end else begin
      ADOTableCreatefromQuery(FDESTADOTable);
      ADOTableDatafromQuery(FDESTADOTable);
    end;
  end;
end;

//==============================================================================
// 此处必须延时，否则之后的分组统计有误
//==============================================================================

procedure TADOBatchMove.Execute;
begin
  if fsourcemode=dsTable then ADObatchmoveTabletoTable
  else ADObatchmoveQuerytoTable;
  Sleep(1000);                    
end;

end.