// Getestet mit D4 unter XP
// Hiermit kann man eine Paradox-Tabelle mit allen Feldern, Sätzen und Indizes 
// kopieren. Sollen jedoch nur bestimmte Sätze kopiert werden, kann man die 
// Quell-Tabelle nach ausgewählten Kriterien filtern.
// (als Beispiel auskommentierter Teil)
 
uses 
  Windows, SysUtils, Classes, Forms, Dialogs, 
  DBTables, Controls, StdCtrls; 
 
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    { Public-Deklarationen } 
  end; 
 
var 
  Form1: TForm1; 
  SourceTable, DestTable: TTable; 
 
implementation 
 
{$R *.DFM} 
 
uses FileCtrl; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  SourceTable := TTable.create(self); 
  DestTable := TTable.create(self); 
  SourceTable.Tablename := 'C:\Programme\MyTable.db'; 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
const 
  bank = 'Test.db'; 
var 
  pfad: string; 
  x, i: integer; 
begin 
  i := 0; 
  pfad := extractfilepath(application.exename) + 'MyBank\'; 
  if fileexists(pfad + bank) then 
    if messageDlg('Tabelle bereits vorhanden, überschreiben?', 
      mtConfirmation, [mbYes, mbCancel], 0) <> mryes then exit; 
  screen.cursor := crhourglass; 
  try 
    forcedirectories(pfad); 
    with DestTable do begin 
      Active := False; 
      TableType := ttParadox; 
      TableName := pfad + bank; 
      { SourceTable.Filter := 'Name=' + chr(39) + 'A*' + chr(39) + 
          ' or Vorname=' + chr(39) + 'M*' + chr(39); 
        SourceTable.filtered := true; } 
      SourceTable.Active := True; 
      with SourceTable.FieldDefs do 
        for x := 0 to count - 1 do 
          FieldDefs.add(Items[x].Name, Items[x].DataType, 
            Items[x].Precision, Items[x].Required); 
      CreateTable; 
      i := BatchMove(SourceTable, batCopy); 
      with SourceTable.IndexDefs do begin 
        Update; 
        for x := 0 to count - 1 do 
          AddIndex(Items[x].Name, Items[x].Fields, Items[x].Options); 
      end; 
      SourceTable.close; 
    end; 
  finally 
    screen.cursor := crdefault; 
    showmessage(inttostr(i) + ' Sätze kopiert'); 
  end; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  DestTable.free; 
  SourceTable.free; 
end;



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke