ADODATASetConnection til en Paradox-DB

(Har 'leget' lidt med et program, der indeholder nogen komponenter TAOAdoDataSet, der faktisk udfra beskrivelsen snakker lidt om denne funktionalitet, - og der findes en slags BDE-driver til ADO-forbindelse i programmet, men det er ikke lykkedes mig at få det til at fungere.Der kommer en slags fejlmeddelse om at der skal installeres en DNS-forbindelse til driveren.Har så forsøgt dette udfra deres anvisninger, men uden held).

Jeg ved godt det ikke er det rigtige men den kan da konvaterer databaser.
Måske kan du bruge noget af den ?
***************


unit DBCopy;

interface

uses
  Windows, Messages, Dialogs, SysUtils, ThreadPool, DBClient, ActiveX,
  Classes, ADODB, DB;

const
  TM_Base = WM_User + 50;
  TM_Start = TM_Base + 1;
  TM_Update = TM_Base + 2;
  TM_Finish = TM_Base + 3;

type
  TDatabaseCopyItem = class(TThreadPoolItem)
  private
    FCDS: TClientDataSet;
    FTableName: string;
    FDirectory: string;
    FADOQuery: TADOQuery;
    FConnectionString: string;
    FSaveAsXML: Boolean;
    FNotifyHandle: THandle;
    FThread: TThreadPoolWorker;
    FCount: Integer;
    procedure SetDirectory(const Value: string);
    procedure SetTableName(const Value: string);
  protected
    procedure Execute(Thread: TThreadPoolWorker); override;
  public
    constructor Create;
    destructor Destroy; override;
    property Directory: string read FDirectory write SetDirectory;
    property ConnectionString: string read FConnectionString write FConnectionString;
    property SaveAsXML: Boolean read FSaveAsXML write FSaveAsXML;
    property TableName: string read FTableName write SetTableName;
    property NotifyHandle: THandle read FNotifyHandle write FNotifyHandle;
  end;


implementation

{ TDatabaseCopyItem }

constructor TDatabaseCopyItem.Create;
begin
  inherited Create;
  FADOQuery := TADOQuery.Create(nil);
  FCDS := TClientDataSet.Create(nil);
  SaveAsXML := False;
end;

destructor TDatabaseCopyItem.Destroy;
begin
  FADOQuery.Free;
  FCDS.Free;
  inherited Destroy;
end;

{*******************************************************************************
  Procedure Execute;
  Using the Field Member Query/ClientDataSet save the data from the database
  table to a file, creating the Directory if it doesn't exist. Using the FileExt
  to save it out in native CDS format or as XML. 
*******************************************************************************}
procedure TDatabaseCopyItem.Execute(Thread: TThreadPoolWorker);
const
  FileExt: array [Boolean] of PChar = ('.cds', '.xml');
  FileNameStr = '%s%s%s';
  SQL = 'Select * from %s';

  procedure PopulateCDS;
  var
    i: Integer;
  begin
    FADOQuery.ConnectionString := ConnectionString;
    FADOQuery.SQL.Text := Format(SQL, [TableName]);
    FADOQuery.Open;
    SendMessage(FNotifyHandle, TM_Start, FThread.ThreadID, FADOQuery.RecordCount+1);
    FCDS.FieldDefs.Assign(FADOQuery.FieldDefs);
    FCDS.CreateDataSet;
    for i := 0 to FCDS.Fields.Count - 1 do
      FCDS.Fields[i].ReadOnly := False;
     
    while not FADOQuery.Eof and not Thread.Terminated do
    begin
      FCDS.Insert;
      for i := 0 to FCDS.Fields.Count - 1 do
        FCDS.Fields[i].Value := FADOQuery.Fields[i].Value;
      FCDS.Post;
      FADOQuery.Next;
      Inc(FCount);
      if ((FCount and 127) = 127) and not FThread.Terminated then
        SendMessage(FNotifyHandle, TM_Update, FThread.ThreadID, 127);
    end;
  end;
begin
  CoInitialize(nil);
  try
    FThread := Thread;
    FCount := 0;
    PopulateCDS;
    if not FThread.Terminated then
    begin
      ForceDirectories(FDirectory);
      FCDS.SaveToFile(Format(FileNameStr, [FDirectory,
        StringReplace(FTableName, '"', '', [rfReplaceAll, rfIgnoreCase]),
        FileExt[SaveAsXML]]));
      if not FThread.Terminated then
        SendMessage(FNotifyHandle, TM_Finish,  FThread.ThreadID, 0);
    end;
  finally
    FCDS.EmptyDataSet;
    FCDS.Close;
    FADOQuery.Close;
    CoUninitialize;
  end;
end;

{*******************************************************************************
  procedure SetDirectory
  Validate that the save path is complete if it is not then add the '\'
*******************************************************************************}
procedure TDatabaseCopyItem.SetDirectory(const Value: string);
begin
  if Value[Length(Value)] <> '\' then
    FDirectory := Value + '\'
  else
    FDirectory := Value;
end;

procedure TDatabaseCopyItem.SetTableName(const Value: string);
begin
  if Pos(' ', Value) > 0 then
    FTableName := '"' + Value + '"'
  else
    FTableName := Value;
end;

end.



*********************


unit Main;

interface

//Since Using ADO there is no need to see platform specific warings in D6
// ADO was used as the BDE Kept AVing which didn't happen with D5 and its BDE
{$IFDEF VER140}
  {$Warn UNIT_PLATFORM Off}
{$ENDIF}
uses
  Windows, Forms, Spin, StdCtrls, Buttons, Controls, DB, DBTables, Classes,
  ThreadPool, Dialogs, FileCtrl, DBCopy, ADODB, AdoConEd, Messages, SysUtils,
  ComCtrls, Gauges;

type
  TMainForm = class(TForm)
    TableListBox: TListBox;
    Label3: TLabel;
    TableListButton: TButton;
    DirectoryEdit: TEdit;
    Label4: TLabel;
    DirListButton: TButton;
    GoButton: TButton;
    ThreadCountSpinEdit: TSpinEdit;
    Label5: TLabel;
    Label1: TLabel;
    ConnectionStrEdit: TEdit;
    BuildConnectionButton: TButton;
    ADOConnection: TADOConnection;
    SaveAsXMLCheckBox: TCheckBox;
    ScrollBox1: TScrollBox;
    OverAllProgressBar: TProgressBar;
    Label6: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure TableListButtonClick(Sender: TObject);
    procedure DirListButtonClick(Sender: TObject);
    procedure GoButtonClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ThreadCountSpinEditChange(Sender: TObject);
    procedure BuildConnectionButtonClick(Sender: TObject);
    procedure ConnectionStrEditExit(Sender: TObject);
    procedure TableListBoxClick(Sender: TObject);
    procedure ConnectionStrEditChange(Sender: TObject);
  private
    { Private declarations }
    FThreadPool: TThreadPool;
    FGauges: TStringList;
    FClosing: Boolean;
    procedure ClearGauges;
    procedure ThreadPoolFinish(Sender: TObject);
    procedure TMFinish(var Msg: TMessage); message TM_Finish;
    procedure TMStart(var Msg: TMessage); message TM_Start;
    procedure TMUpdate(var Msg: TMessage); message TM_Update;
  public
    { Public declarations }
  end;


var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  //Create the Thread Pool
  FThreadPool := TThreadPool.Create;
  FThreadPool.OnFinish := ThreadPoolFinish;
  FThreadPool.ThreadCount := 3;
  FGauges := TStringList.Create;
  OverAllProgressBar.Max := 0;
  FClosing := False;
end;

procedure TMainForm.TableListButtonClick(Sender: TObject);
begin
  //Set the Ado COnnection and retrieve the List of Tables.
  ADOConnection.Open;
  try
    ADOConnection.GetTableNames(TableListBox.Items);
  finally
    ADOConnection.Close;
  end;
end;

procedure TMainForm.DirListButtonClick(Sender: TObject);
var
  Dir: string;
begin
  //Display directory listing for selection.
  SelectDirectory('', '', Dir);
  DirectoryEdit.Text := Dir;
end;

procedure TMainForm.GoButtonClick(Sender: TObject);
var
  CurItem: TDatabaseCopyItem;
  i: Integer;
begin
  //Spin through the Table List box and find the tables that are selected.
  //Create an item for each table so that it will be selected and saved to a
  //file
  ClearGauges;
  ThreadCountSpinEdit.Enabled := False;
  TableListButton.Enabled := False;
  GoButton.Enabled := False;
  for i := 0 to TableListBox.Count - 1 do
    if TableListBox.Selected[i] then
    begin
      CurItem := TDatabaseCopyItem.Create;
      CurItem.TableName := TableListBox.Items[i];
      CurItem.ConnectionString := ConnectionStrEdit.Text;
      CurItem.Directory := DirectoryEdit.Text;
      CurItem.OwnedByThreadPool := True;
      CurItem.SaveAsXML := SaveAsXMLCheckBox.Checked;
      CurItem.NotifyHandle := Handle;
      OverAllProgressBar.Max := OverAllProgressBar.Max + 1;
      FThreadPool.Add(CurItem);
    end;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if not FClosing then
  begin
    FClosing := False;
    ClearGauges;
    FThreadPool.Free;
    FGauges.Free;
  end;
end;

procedure TMainForm.ThreadCountSpinEditChange(Sender: TObject);
begin
  FThreadPool.ThreadCount := ThreadCountSpinEdit.Value;
end;

procedure TMainForm.BuildConnectionButtonClick(Sender: TObject);
begin
  //Display ADO connection String Builder
  if EditConnectionString(ADOConnection) then
  begin
    ConnectionStrEdit.Text := ADOConnection.ConnectionString;
    ConnectionStrEdit.SetFocus;
    TableListButton.Enabled := True;
  end;
  ADOConnection.Close;
end;

procedure TMainForm.ConnectionStrEditExit(Sender: TObject);
begin
  TableListButton.Enabled := ConnectionStrEdit.Text <> '';
  ADOConnection.ConnectionString := ConnectionStrEdit.Text;
end;

procedure TMainForm.TableListBoxClick(Sender: TObject);
begin
  GoButton.Enabled := TableListBox.SelCount > 0;
end;

procedure TMainForm.TMFinish(var Msg: TMessage);
var
  ThreadId: string;
  Index: Integer;
begin
  if not FClosing then
  begin
    OverAllProgressBar.StepIt;
    if OverAllProgressBar.Position >= OverAllProgressBar.Max then
    begin
      ThreadCountSpinEdit.Enabled := True;
      TableListButton.Enabled := True;
      GoButton.Enabled := True;
      ShowMessage('Tables have been Exported');
    end;
    ThreadId := IntToStr(Msg.WParam);
    Index := FGauges.IndexOf(ThreadId);
    if Index <> -1 then
      TGauge(FGauges.Objects[Index]).Progress :=
        TGauge(FGauges.Objects[Index]).MaxValue;
  end;
end;

procedure TMainForm.TMStart(var Msg: TMessage);
var
  ThreadId: string;
  Index: Integer;
  Gauge: TGauge;
begin
  if not FClosing then
  begin
    ThreadId := IntToStr(Msg.WParam);
    Index := FGauges.IndexOf(ThreadId);
    if Index = -1 then
    begin
      Gauge := TGauge.Create(nil);
      Gauge.Parent := ScrollBox1;
      Gauge.Height := OverAllProgressBar.Height;
      Gauge.Top := FGauges.Count * Gauge.Height;
      Gauge.Width := ScrollBox1.ClientWidth;
      Index := FGauges.AddObject(ThreadId, Gauge);
    end;

    Gauge := TGauge(FGauges.Objects[Index]);
    Gauge.Progress := 0;
    Gauge.MaxValue := Msg.LParam - 1;
  end;
end;

procedure TMainForm.TMUpdate(var Msg: TMessage);
var
  ThreadId: string;
  Index: Integer;
begin
  ThreadId := IntToStr(Msg.WParam);
  Index := FGauges.IndexOf(ThreadId);
  if (Index <> -1) then
    TGauge(FGauges.Objects[Index]).AddProgress(Msg.LParam);
end;

procedure TMainForm.ClearGauges;
begin
  while FGauges.Count <> 0 do
  begin
    FGauges.Objects[0].Free;
    FGauges.Delete(0);
  end;
end;

procedure TMainForm.ThreadPoolFinish(Sender: TObject);
begin
  ThreadCountSpinEdit.Enabled := True;
end;

procedure TMainForm.ConnectionStrEditChange(Sender: TObject);
begin
  TableListBox.Enabled := ConnectionStrEdit.Text <> '';
end;

end.

Jeg må imiddelbart betvivle at jeg er kløgtig nok til at trække noget lærdom ud af dit eks. koden12.Det skal nok være enten lige til at bruge eller mere omhyggelig forklaret.

Alle: Se venligst bort fra min vrøvlekommentar efter spm.Har kigget lidt mere på det og det lader til at være den anden vej rundt - at man kan køre en acces.mdb via BDE, hvilket nok osse er mere logisk.Så i et spm. fornylig at Stoney havde fundet ud af at man kunne viewe data men ikke reigere/editere/gemme via ADO og det er nok mest sandsynligt at det ikke er så let at konvertere formatet - hvorfor skulle det ellers være så besværligt i et stort dyrt købeprogram som Acces ?.Får faktisk tabellen ind i Acces ved import af data, som en px-tabel, men den virker så ikke lige når jeg bruger den i de programmer jeg har der ellers plejer at sluge en alm mdb-db.Jeg har dog nogle jeg har konverteret for år tilbage der tilsyneladende virker ok ?.Måske skulle jeg sørge i acces-kategorien, hvis ikke nogen lige kommer på noget - eller læse i nogen bøger (øv).

Det var fordi jeg havde sat importen til at være en linket tabel.(græmme græmme).Ja, undskyld det evt.elle bevær.

svar