qimport2dbf.pas

Delphi Advanced Import Component_v2.48.With Full Source.

unit QImport2DBF;

{$I VerCtrl.inc}

interface

uses Classes, QImport2, DBFFile, IniFiles;

type
  TQImport2DBF = class(TQImport2)
  private
    FDBF: TDBFRead;
    FSourceFields: TStringList;

    FSkipDeleted: boolean;

    function DBFStrToDateTime(const Str: string): TDateTime;
  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;

    procedure BeforeImport; override;
    procedure AfterImport; override;

    procedure DoLoadConfiguration(IniFile: TIniFile); override;
    procedure DoSaveConfiguration(IniFile: TIniFile); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property SkipDeleted: boolean read FSkipDeleted write FSkipDeleted
      default true;

    property FileName;
    property SkipFirstRows default 0;
  end;

implementation

uses Db, SysUtils, QImport2Common;

const
  sLogicalTrue = '1';
  sLogicalFalse = '0';

{ TQImport2DBF }

procedure TQImport2DBF.BeforeImport;
begin
  FDBF := TDBFRead.Create(FileName);
  FTotalRecCount := FDBF.RecordCount;
  inherited;
end;

procedure TQImport2DBF.AfterImport;
begin
  if Assigned(FDBF) then FDBF.Free;
  inherited;
end;

procedure TQImport2DBF.DoLoadConfiguration(IniFile: TIniFile);
begin
  inherited;
  with IniFile do begin
    SkipFirstRows := ReadInteger(DBF_OPTIONS, DBF_SKIP_LINES, SkipFirstRows);
  end;
end;

procedure TQImport2DBF.DoSaveConfiguration(IniFile: TIniFile);
begin
  inherited;
  with IniFile do begin
    WriteInteger(DBF_OPTIONS, DBF_SKIP_LINES, SkipFirstRows);
  end;
end;

constructor TQImport2DBF.Create(AOwner: TComponent);
begin
  inherited;
  SkipFirstRows := 0;
  FSkipDeleted := true;
  {FLogicalTrue := sLogicalTrue;
  FLogicalFalse := sLogicalFalse;}
end;

procedure TQImport2DBF.StartImport;
var
  i: integer;
begin
  FSourceFields := TStringList.Create;
  for i := 0 to Map.Count - 1 do
    FSourceFields.AddObject(Map.Values[Map.Names[i]], TObject(i));
  FSourceFields.Sort;
end;

function TQImport2DBF.CheckCondition: boolean;
begin
  Result := not FDBF.EOF;
end;

function TQImport2DBF.Skip: boolean;
begin
  Result := false;
end;

procedure TQImport2DBF.FillImportRow;
var
  i, j, k: integer;
  DataStr: string;
  Find: boolean;
begin
  FImportRow.ClearValues;
  for i := 0 to FDBF.FieldCount - 1 do
  begin
    DataStr := Trim(FDBF.GetData(i));
    Find := FSourceFields.Find(FDBF.FieldName[i], j);
    if Find and (j > -1) and (j < FSourceFields.Count) then
    begin
      j := Integer(FSourceFields.Objects[j]);
      if IsCSV or (QImportDestinationFindColumn(IsCSV, ImportDestination, DataSet,
           {$IFNDEF NOGUI}DBGrid, ListView, StringGrid, GridCaptionRow,{$ENDIF}
	          Map.Names[j]) > -1) or
         (ImportDestination = qidUserDefined) then
      begin
        if (FDBF.FieldType[i] = dftDate) and (DataStr <> EmptyStr) then
          DataStr := DateTimeToStr(DBFStrToDateTime(DataStr));
        FImportRow.SetValue(Map.Names[j], DataStr, false);
        DoUserDataFormat(FImportRow.ColByName(Map.Names[j]));
      end;
    end
  end;
  for i := 0 to FImportRow.Count - 1 do
  begin
    k := Map.IndexOfName(FImportRow[i].Name);
    if k = -1 then
      DoUserDataFormat(FImportRow[i]);
  end;
end;

function TQImport2DBF.ImportData: TQImportResult;
begin
  Result := qirOk;
  try
    try
      if Canceled  and not CanContinue then begin
        Result := qirBreak;
        Exit;
      end;
      if (SkipFirstRows > 0) and (FDBF.RecNo <= SkipFirstRows) then begin
        DestinationCancel;
        Result := qirContinue;
        Exit;
      end;

      if FSkipDeleted and FDBF.Deleted then begin
        Result := qirContinue;
        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 TQImport2DBF.ChangeCondition;
begin
  //
end;

procedure TQImport2DBF.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 Assigned(FSourceFields) then FSourceFields.Free;
  end;
end;

function TQImport2DBF.DBFStrToDateTime(const Str: string): TDateTime;
var
  Year, Month, Day: word;
begin
  try
    Year := StrToIntDef(Copy(Str, 1, 4), 0);
    Month := StrToIntDef(Copy(Str, 5, 2), 0);
    Day := StrToIntDef(Copy(Str, 7, 2), 0);
    Result := EncodeDate(Year, Month, Day);
  except
    Result := 0;
  end;
end;

end.