ado_qimport3access.pas

在C++Builder中直接用于数据的输出

unit ADO_QImport3Access;

{$I VerCtrl.inc}

interface

uses Classes, QImport3, ADODb, DB, QImport3StrTypes;

type
  TQImportAccessSourceType = (isTable, isSQL);

  TADO_QImport3Access = class(TQImport3)
  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: TqiStrings);{$IFDEF QI_UNICODE}overload;
    procedure GetTableNames(List: TStrings); overload;{$ENDIF}
    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, QImport3Common{$IFDEF VCL6}, Variants{$ENDIF}, ComObj, ActiveX;

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

{ TADO_QImport3Access }

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

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

procedure TADO_QImport3Access.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_QImport3Access.CheckCondition: boolean;
begin
  Result := not FADO.Eof;
end;

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

procedure TADO_QImport3Access.FillImportRow;
var
  i, k: Integer;
  SField: TField;
{$IFDEF QI_UNICODE}
  fieldValue: Variant;
{$ENDIF}
  p: Pointer;
  mapValue: string;
begin
  FImportRow.ClearValues;
  for i := 0 to FImportRow.Count - 1 do
  begin
    if FImportRow.MapNameIdxHash.Search(FImportRow[i].Name, p) then
    begin
      k := Integer(p);
{$IFDEF VCL7}
      mapValue := Map.ValueFromIndex[k];
{$ELSE}
      mapValue := Map.Values[FImportRow[i].Name];
{$ENDIF}
      if Pos('=', mapValue) > 0 then
        mapValue := Copy(mapValue, 1, Pos('=', mapValue) - 1);
      SField := FADO.FindField(mapValue);
      if Assigned(SField) then
      begin
{$IFDEF QI_UNICODE}
        fieldValue := FADO.Recordset.Fields[mapValue].Value;
        
        if IsCSV and (SField.DataType in [ftDate, ftTime, ftDateTime]) then //for MySQL
          fieldValue := FormatDateTime('yyyy-mm-dd hh:mm:ss', fieldValue);

        if VarIsNull(fieldValue) or VarIsClear(fieldValue) then
          fieldValue := '';
        FImportRow.SetValue(Map.Names[k], fieldValue, SField.IsBlob);
{$ELSE}
        FImportRow.SetValue(Map.Names[k], SField.AsString, SField.IsBlob);
{$ENDIF}
      end;
    end;
    DoUserDataFormat(FImportRow[i]);
  end;
end;

function TADO_QImport3Access.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 (not IsCSV) and (CommitRecCount > 0) and not CommitAfterDone and
       ((ImportedRecs + ErrorRecs) mod CommitRecCount = 0) then
      DoNeedCommit;
    if (ImportRecCount > 0) and
       ((ImportedRecs + ErrorRecs) mod ImportRecCount = 0) then
      Result := qirBreak;
  end;
end;

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

procedure TADO_QImport3Access.FinishImport;
begin
  try
    if not Canceled and not IsCSV then
    begin
      if CommitAfterDone then
        DoNeedCommit
      else if (CommitRecCount > 0) and ((ImportedRecs + ErrorRecs) mod CommitRecCount > 0) then
        DoNeedCommit;
    end;
  finally
    if FADO.Active then FADO.Close;
    if Assigned(FADO) then FADO.Free;
  end;
end;

procedure TADO_QImport3Access.GetFieldNames(List: TStrings);

  function FieldTypeToStr(ADataType: TFieldType;
                          const AFieldSize: Integer): string;
  begin
    case ADataType of
      ftBlob,
      ftMemo:
        Result := 'Memo';
      ftWideString,
      ftString,
      ftGuid:
        Result := Format('Text(%d)', [AFieldSize]);
      ftAutoInc:
        Result := 'AutoNumber';
      ftSmallint,
      ftInteger,
      ftWord,
      ftLargeInt,
      ftFloat,
      {$IFDEF VCL6}ftFMTBcd,{$ENDIF}
      ftBCD:
        Result := 'Number';
      ftBoolean:
        Result := 'Yes/No';
      ftCurrency:
        Result := 'Currency';
      ftDate,
      ftTime,
      {$IFDEF VCL6}ftTimeStamp,{$ENDIF}
      ftDateTime:
        Result := 'Date/Time';
    else
      Result := 'Unknown';
    end;
  end;

var
  ADO: TADOQuery;
  connStr: string;
  i: Integer;
  fd: TFieldDef;
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
        for i := 0 to ADO.FieldCount - 1 do
        begin
          fd := ADO.FieldDefList.FieldDefs[i];
          if fd <> nil then
            List.Values[fd.Name] := FieldTypeToStr(fd.DataType, fd.Size);
        end;
      finally
        ADO.Close;
      end;
    end;
  finally
    ADO.Free;
  end;
end;

procedure TADO_QImport3Access.GetTableNames(List: TqiStrings);
var
  ADO: TADOConnection;
  connStr: string;
  Names: TStrings;
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;
    Names := TStringList.Create;
    try
      ADO.GetTableNames(Names, false);
      List.Assign(Names);
    finally
      ADO.Close;
      Names.Free;
    end;
  finally
    ADO.Free;
  end;
end;

{$IFDEF QI_UNICODE}
procedure TADO_QImport3Access.GetTableNames(List: TStrings);
var
  ADO: TADOConnection;
  connStr: string;
  Names: TStrings;
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;
    Names := TStringList.Create;
    try
      ADO.GetTableNames(Names, false);
      List.Assign(Names);
    finally
      ADO.Close;
      Names.Free;
    end;
  finally
    ADO.Free;
  end;
end;
{$ENDIF}

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

initialization
  CoInitialize(nil);

finalization
  CoUninitialize;

end.