⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 adobatchmove.pas

📁 是DELPHI的ADO批量导入程序
💻 PAS
字号:
{Adobatchmove for Delphi
作者:Liangu
URL: http://www.liangu.net
e-mail: ydl@findso.com
Version 1.0 - 10.08.2003
}
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 ;// adoconedxgj,

procedure Register;
begin
  RegisterComponents('Liangu', [TADOBatchMove]);
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;
function TADOBatchMove.datatypetoaccesstypeandsize(ftdef:TFielddef):string;
begin
case ftdef.datatype of
ftSmallint:result:='SHORT';
ftInteger:result:='LONG' ;
ftWord:result:='BYTE';
ftBoolean:result:='YESNO';
ftFloat:result:='SINGLE';
ftDate:result:='DATETIME';
ftTime:result:='DATETIME';
ftDateTime:result:='DATETIME';
ftAutoInc:result:='COUNTER';
ftWideString:result:='TEXT('+inttostr(ftdef.size)+')';
ftMemo:result:='LONGTEXT';
ftGuid:result:='GUID';
ftBlob:result:='LONGBINARY';
ftCurrency:result:='Currency';
ftBCD:result:='Currency';
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.active:=false;
FADOConnection.close;
FADOConnection.loginprompt:=false;
FADOConnection.connectionString:=ADOTableTest.connectionString;
FADOConnection.open;
FADOConnection.GetTableNames(FStringList, False);
for i:=0 to FStringList.count-1 do
if FStringList.Strings[i]=ADOTableTest.Tablename then
begin
result:=true;
exit;
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
begin
ADOTablepara.Fields.Fields[i]:=FSOURCEADOTable.Fields.Fields[i];
end;
ADOTablepara.post;
Frmgauge.Gauge.Progress:=FSOURCEADOTable.Recno;
FSOURCEADOTable.next;
end;
ADOTablepara.close;
FSOURCEADOTable.close;
sleep(1000);
Frmgauge.Free;
result:=true;
end;
function TADOBatchMove.ADOTableCreatefromQuery(ADOTablepara: TADOTable):boolean;
var i:integer;
begin
//下面利用源数据(ado查询)创建新表
result:=false;
FDESTADOQuery.connectionString:=ADOTablepara.connectionString;
FSOURCEADOQuery.open;
FDESTADOQuery.sql.Clear;
FDESTADOQuery.sql.add('create table '+ ADOTablepara.Tablename +' ( ');// ADOTablepara.Tablename
FStringList.clear;
for i:=0 to FSOURCEADOQuery.fielddefs.count-1 do
FStringList.Add(FSOURCEADOQuery.fielddefs[i].name+' '+datatypetoaccesstypeandsize(FSOURCEADOQuery.fielddefs[i]) );
{begin
if i<> FSOURCEADOTable.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; }
for i:=0 to FStringList.Count-2 do FDESTADOQuery.sql.add( FStringList.strings[i]+' , ');
FDESTADOQuery.sql.add( FStringList.strings[FStringList.Count-1]+' ) ');
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;
Frmgauge.Gauge.MaxValue:=0;
Frmgauge.ShowModal;
Frmgauge.Gauge.MaxValue:=FSOURCEADOQuery.RecordCount;
ADOTablepara.active:=true;
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.Progress:=FSOURCEADOQuery.Recno;
FSOURCEADOQuery.next;
end;
ADOTablepara.close;
FSOURCEADOQuery.close;
sleep(1000);
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
begin
FDESTADOTable.Fields.Fields[i]:=FSOURCEADOTable.Fields.Fields[i];
end;
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;

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;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -