unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,
DB, DBTables, ADODB, ComCtrls, ExtCtrls;
type
TForm1 =
class(TForm)
DB: TDatabase;
Memo1: TMemo;
AC: TADOConnection;
Panel1: TPanel;
Button1: TButton;
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
Edit2: TEdit;
ProgressBar1: TProgressBar;
Button2: TButton;
Connection: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
FBreak:Boolean;
FTablesList:TStringList;
procedure CreateTable(
const tn:
String);
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
Function GetFieldCreaString(
const s:
String;Size:Integer;
Const CName:
String;PrimaryKey:String='
'):
String;
begin
Result:='
['+s+'
] ';
if CName='
TAutoIncField'
then Result:=Result+'
int'
else if CName='
TBCDField'
then Result:=Result+'
money'
else if CName='
TBlobField'
then Result:=Result+'
varbinary(max)'
else if CName='
TBooleanField'
then Result:=Result+'
Bit'
else if CName='
TBytesField'
then Result:=Result+'
varbinary(max)'
else if CName='
TCurrencyField'
then Result:=Result+'
money'
else if CName='
TDateField'
then Result:=Result+'
DateTime'
else if CName='
TDateTimeField'
then Result:=Result+'
DateTime'
else if CName='
TDate'
then Result:=Result+'
DateTime'
else if CName='
TTimeField'
then Result:=Result+'
DateTime'
else if CName='
TFloatField'
then Result:=Result+'
float'
else if CName='
TGraphicField'
then Result:=Result+'
image'
else if CName='
TGuidField'
then Result:=Result+'
uniqueIdentifier'
else if CName='
TIDispatchField'
then Result:=Result+'
varbinary(max)'
else if CName='
TIntegerField'
then Result:=Result+'
int'
else if CName='
TLargeIntField'
then Result:=Result+'
int'
else if CName='
TMemoField'
then Result:=Result+'
varchar(max)'
else if CName='
TSmallintField'
then Result:=Result+'
smallint'
else if CName='
TStringField'
then Result:=Result+'
Varchar ('+IntToStr(Size)+'
)'
else if CName='
TWideStringField'
then Result:=Result+'
Varchar ('+IntToStr(Size)+'
)'
else if CName='
TVarBytesField'
then Result:=Result+'
varbinary(max)'
else if CName='
TWordField'
then Result:=Result+'
Byte'
else Showmessage(Cname);
if Pos('
['+Uppercase(s)+'
]',Uppercase(PrimaryKey))>0
then Result:=Result+'
NOT NULL'
else Result:=Result+'
NULL';
end;
Function Get1310Komma(i:Integer):
String;
begin
if i=0
then Result:='
'
else Result:='
,'#13#10;
end;
Function GenTableDupSQL(ADS:TTable;TableName:
String;PrimaryKey:String='
'):
String;
var
sl:TStringList;
i:Integer;
begin
Ads.Open;
sl:=TStringList.Create;
Ads.GetFieldNames(sl);
Result:='
CREATE TABLE ['+TableName+'
] (';
For i:=0
to sl.Count-1
do
begin
Result:=Result+Get1310Komma(i)+GetFieldCreaString(sl[i],Ads.FieldbyName(sl[i]).Size,Ads.FieldbyName(sl[i]).Classname,PrimaryKey);
end;
Result:=Result+'
)';
sl.Free;
end;
procedure TForm1.CreateTable(
const tn:
String);
var
t:TTable;
z:TAdodataset;
SQL:
String;
i,j:Integer;
begin
t:=TTable.Create(self);
z:=TAdodataset.Create(self);
z.Connection := AC;
try
t.DatabaseName :=
DB.DatabaseName;
t.TableName := tn + '
.db';
Session.AddPassword('
WasAuchImmerWennBenötigt');
t.Open;
ProgressBar1.Position := 0;
ProgressBar1.Max := t.RecordCount;
SQL := GenTableDupSQL(t,tn);
AC.Execute(
SQL);
z.CommandText := '
Select * from ' + tn;
z.Open;
j :=0;
Memo1.Lines.Add(FormatDateTime('
hh:nn:ss > ',now) + '
Importiere: ' + tn + '
(' + IntToStr(t.recordCount) + '
)');
While (
not t.EOF)
and (
Not FBreak)
do
begin
Application.ProcessMessages;
inc(j);
z.Append;
for i:=0
to z.Fieldcount-1
do
begin
try
z.Fields[i].Assign(t.FieldByName(z.Fields[i].FieldName));
except
ON E:
Exception do Memo1.Lines.Add('
Feldfehler Satz ' +IntToStr(j)+ '
: ' + z.Fields[i].FieldName );
end;
end;
try
z.Post;
except
ON E:
Exception do
begin
Memo1.Lines.Add('
POSTFEHLER ' + E.
Message );
z.Cancel;
end;
end;
ProgressBar1.Position := ProgressBar1.Position + 1;
t.Next;
end;
finally
t.Free;
z.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
C_Abgeschlossen='
Import abgeschlossen.';
var
i:Integer;
begin
// AC.ConnectionString := 'Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=master;Data Source=' + Edit2.Text;
// AC.Connected := true;
DB.Connected := false;
DB.Aliasname := Edit1.Text;
DB.DatabaseName := Edit1.Text;
DB.Connected := true;
AC.Execute('
Create Database ' + Edit2.Text);
AC.Execute('
USE ' + Edit2.Text);
DB.GetTableNames(FTablesList);
for i := 0
to FTablesList.Count - 1
do
begin
try
CreateTable(FTablesList[i] );
except
ON E:
Exception do Memo1.Lines.Add(StringOfChar('
_',50) + #13#10 + E.
Message + #13#10 + StringOfChar('
_',50) + #13#10 );
end;
end;
Memo1.Lines.Add(C_Abgeschlossen);
Messagedlg(C_Abgeschlossen,mtInformation,[mbok],0);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
FTablesList:=TStringList.Create;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
FTablesList.Free;
end;
procedure TForm1.Edit1Change(Sender: TObject);
begin
Button1.Enabled := (Length(Trim(Edit1.Text)) > 0)
and (Length(Trim(Edit2.Text)) > 0)
and AC.Connected;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
AC.Connected := false;
AC.ConnectionString := PromptDataSource(0, AC.ConnectionString);
AC.Properties.Item['
Initial Catalog'].Value := '
master';
Connection.Caption := AC.ConnectionString;
AC.Connected := true;
Edit1Change(
nil);
end;
end.