ado_qimport2access.pas

Delphi Advanced Import Component_v2.48.With Full Source.

unit ADO_QImport2Access;

{$I VerCtrl.inc}

interface

uses Classes, QImport2, ADODb;

type
  TQImportAccessSourceType = (isTable, isSQL);

  TADO_QImport2Access = class(TQImport2)
  private
    FSQL: TStrings;
    FTableName: string;
    FPassword: string;
    FSourceType: TQImportAccessSourceType;
    FADO: TADOQuery;
    FSkipCounter: integer;
    procedure SetSQL(const Value: TStrings);
  protected
    procedure StartImport; override;
    function CheckCondition: boolean; override;
    function Skip: boolean; override;
    procedure FillImportRow; override;
    function ImportData: TQImportResult; override;
    procedure ChangeCondition; override;
    procedure FinishImport; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure GetTableNames(List: TStrings);
    procedure GetFieldNames(List: TStrings);
  published
    property FileName;
    property SkipFirstRows default 0;
    property TableName: string read FTableName write FTableName;
    property SQL: TStrings read FSQL write SetSQL;
    property SourceType: TQImportAccessSourceType read FSourceType
      write FSourceType default isTable;
    property Password: string read FPassword write FPassword;
  end;

implementation

uses SysUtils, Db, QImport2Common;

const
  SelectFromTable = 'select * from [%s]';
  ConnectionString = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s';
  PasswordString = ';Jet OLEDB:Database Password=%s';

{ TADO_QImport2Access }

constructor TADO_QImport2Access.Create(AOwner: TComponent);
begin
  inherited;
  SkipFirstRows := 0;
  FSourceType := isTable;
  FSQL := TStringList.Create;
  FPassword := EmptyStr;
end;

destructor TADO_QImport2Access.Destroy;
begin
  FSQL.Free;
  inherited;
end;

procedure TADO_QImport2Access.StartImport;
var
  connStr: string;
begin
  if FPassword <> EmptyStr then
    connStr := ConnectionString + Format(PasswordString, [FPassword])
  else
    connStr := ConnectionString;

  FADO := TADOQuery.Create(nil);
  FADO.ConnectionString := Format(connStr, [FileName]);

  if SourceType = isSQL
    then FADO.SQL.Assign(SQL)
    else FADO.SQL.Text := Format(SelectFromTable, [TableName]);
  FADO.Open;

  FSkipCounter := SkipFirstRows;
  if FSkipCounter < 0 then FSkipCounter := 0;
end;

function TADO_QImport2Access.CheckCondition: boolean;
begin
  Result := not FADO.Eof;
end;

function TADO_QImport2Access.Skip: boolean;
begin
  Result := FSkipCounter > 0;
end;

procedure TADO_QImport2Access.FillImportRow;
var
  i, k, j: integer;
  SField: TField;
begin
  FImportRow.ClearValues;
  for i := 0 to FImportRow.Count - 1 do begin
    k := Map.IndexOfName(FImportRow[i].Name);
    if (k > -1) then begin
      j := QImportDestinationFindColumn(IsCSV, ImportDestination, DataSet,
             DBGrid, ListView, StringGrid, GridCaptionRow, Map.Names[k]);
      SField := FADO.FindField(Map.Values[Map.Names[k]]);
      if (IsCSV or (j > -1)) and Assigned(SField) then
        FImportRow.SetValue(Map.Names[k], SField.AsString, SField.IsBlob);
    end;
    DoUserDataFormat(FImportRow[i]);
  end;
end;

function TADO_QImport2Access.ImportData: TQImportResult;
begin
  Result := qirOk;
  try
    try
      if Canceled  and not CanContinue then begin
        Result := qirBreak;
        Exit;
      end;

      DataManipulation;

    except
      on E:Exception do begin
        try
          DestinationCancel;
        except
        end;
        DoImportError(E);
        Result := qirContinue;
        Exit;
      end;
    end;
  finally
    if (CommitRecCount > 0) and
       ((ImportedRecs + ErrorRecs) mod CommitRecCount = 0) then DoNeedCommit;
    if (ImportRecCount > 0) and
       ((ImportedRecs + ErrorRecs) mod ImportRecCount = 0) then Result := qirBreak;
  end;
end;

procedure TADO_QImport2Access.ChangeCondition;
begin
  FADO.Next;
  if FSkipCounter > 0 then Dec(FSkipCounter);
end;

procedure TADO_QImport2Access.FinishImport;
begin
  try
    if CommitAfterDone and not Canceled then DoNeedCommit;
  finally
    if FADO.Active then FADO.Close;
    if Assigned(FADO) then FADO.Free;
  end;
end;

procedure TADO_QImport2Access.GetFieldNames(List: TStrings);
var
  ADO: TADOQuery;
  connStr: string;
begin
  if FPassword <> EmptyStr then
    connStr := ConnectionString + Format(PasswordString, [FPassword])
  else
    connStr := ConnectionString;

  ADO := TADOQuery.Create(nil);
  try
    ADO.ConnectionString := Format(connStr, [FileName]);
    if SourceType = isSQL then
      ADO.SQL.Assign(Self.SQL)
    else
      ADO.SQL.Text := Format(SelectFromTable, [TableName]);

    if ADO.SQL.Text <> '' then
    begin
      ADO.Open;
      try
{$IFDEF VCL10}
  {$WARN SYMBOL_DEPRECATED OFF}
{$ENDIF}
        ADO.GetFieldNames(List);
{$IFDEF VCL10}
  {$WARN SYMBOL_DEPRECATED ON}
{$ENDIF}
      finally
        ADO.Close;
      end;
    end;
  finally
    ADO.Free;
  end;
end;

procedure TADO_QImport2Access.GetTableNames(List: TStrings);
var
  ADO: TADOConnection;
  connStr: string;
begin
  if FPassword <> EmptyStr then
    connStr := ConnectionString + Format(PasswordString, [FPassword])
  else
    connStr := ConnectionString;

  ADO := TADOConnection.Create(nil);
  try
    ADO.LoginPrompt := false;
    ADO.ConnectionString := Format(connStr, [FileName]);
    ADO.Open;
    try
      ADO.GetTableNames(List, false);
    finally
      ADO.Close;
    end;
  finally
    ADO.Free;
  end;
end;

procedure TADO_QImport2Access.SetSQL(const Value: TStrings);
begin
  FSQL.Assign(Value);
end;

end.