ADO Database Delphi

Codec By GeNiUS !
genius@turkiye.com
Bir tablo olduğu gibi , başka bir veri tabanına veya aynı veri tabanına kopyalanabilir. isimli bir tablo mevcutsa, eskisi silinir.. Bu fonksiyon oldukça güçlü bir veri taşıma aracıdır. Tablolar, BDE tarafından desteklenen, herhangi bir veri tabanı ortamından, başka bir veri tabanı ortamına kopyalanabilir. Aşağıdaki örnekte, "DBDemos" veri tabanındaki "Customer.db" isimli tablo, "Sybase" veri tabanına kopyalanmaktadır.,
Tablo yapısı, tablosundan alınmak suretiyle, karşı tarafta yeni bir tablo yaratılmaktadır. Tarafların, lokalde veya uzakta olmaları farketmez. Eğer karşı tarafta aynı adı taşıyan bir tablo varsa, silinir ve yerine yenisi yaratılır.
Function DBCreateTableBorrowStr(
SourceDatabaseName : String;
SourceTableName : String;
DestDatabaseName : String;
DestTableName : String): Boolean;
Var
S : TTable;
D : TTable;
i,j : Integer;
IMax : Integer;
IndexName : String;
IndexFields : String;
IndexFields2 : String;
Q : TQuery;
IDXO : TIndexOptions;
Begin
S := TTable.Create(nil);
D := TTable.Create(nil);
Try
Try
S.Active := False;
S.DatabaseName := SourceDatabaseName;
S.TableName := SourceTableName;
S.TableType := ttDefault;
S.Active := True;
D.DatabaseName := DestDatabaseName;
D.TableName := DestTableName;
D.TableType := ttDefault;
D.FieldDefs.Assign(S.FieldDefs);
D.CreateTable;
{Similar method could be used to create the indices}
{D.IndexDefs.Assign(S.IndexDefs);}
S.IndexDefs.Update;
D.IndexDefs.Update;
D.IndexDefs.Clear;
D.IndexDefs.Update;
For i := 0 To S.IndexDefs.Count - 1 Do
Begin
If Pos('.DB',UpperCase(DestTableName)) > 0 Then
Begin
{Paradox or DBase Tables}
If S.IndexDefs.Items[i].Name = '' Then
Begin
If Pos('.DB',UpperCase(DestTableName)) = 0 Then
Begin
IndexName := DestTableName+IntToStr(i);
End
Else
Begin
IndexName := '';
End;
End
Else
Begin
IndexName := DestTableName+IntToStr(i);
End;
IndexFields := S.IndexDefs.Items[i].Fields;
D.AddIndex(IndexName,IndexFields,
S.IndexDefs.Items[i].Options);
D.IndexDefs.Update;
End
Else
Begin
{Non Local Tables}
Q := TQuery.Create(nil);
Try
S.IndexDefs.Update;
D.IndexDefs.Update;
D.IndexDefs.Clear;
D.IndexDefs.Update;
IMax := S.IndexDefs.Count - 1;
For j := 0 To IMax Do
Begin
Q. Active := False;
Q.DatabaseName := DestDatabaseName;
IndexName := DestTableName+IntToStr(i);
IndexFields := S.IndexDefs.Items[i].Fields;
IndexFields2 :=
ReplaceCharInString(IndexFields,';',',');
Q.SQL.Clear;
Q.SQL.Add('Create');
If ixUnique in S. IndexDefs.Items[j].Options
Then Begin
Q.SQL.Add('Unique');
End;
If ixDescending in S.IndexDefs.Items[j].Options
Then Begin
Q.SQL.Add('Desc');
End
Else
Begin
Q.SQL.Add('Asc');
End;
Q.SQL.Add('Index');
Q.SQL.Add(IndexName);
Q.SQL.Add('On');
Q.SQL.Add(DestTableName);
Q.SQL.Add('(');
Q.SQL.Add(IndexFields2);
Q.SQL.Add(')');
Try
Q.ExecSql;
D.IndexDefs.Update;
D.AddIndex(IndexName,IndexFields,
S.IndexDefs.Items[j].Options);
D.IndexDefs.Update;
Except
On E : EDBEngineError Do
Begin
If E.Message = 'Invalid array of index
descriptors.'
Then Begin
Try
D.IndexDefs.Update;
D.DeleteIndex(IndexName);
D.IndexDefs.Update;
Except
End;
End
Else
Begin
Try
D.IndexDefs.Update;
IDXO := D.IndexDefs.Items[j].Options;
Except
End;
End;
End;
End;
End;
//i:= IMax;
Finally
Q.Free;
End;
End;
End;
S.Active := False;
Result := True;
Finally
S.Free;
D.Free;
End;
Except
On E : Exception Do
Begin
ShowMessage('DBCreateTableBorrowStr Error: '+E.Message);
Result := False;
End;
End;
End;