qimport3dbf.pas

Advanced Data Import Component Suite for Borland Delphi and C++ Builder allows you to import your da

unit QImport3DBF;

{$I QImport3VerCtrl.Inc}

interface

uses
  Classes, Windows, QImport3, DBFFile3, IniFiles, EZDSLHsh, QImport3StrTypes;

type
  TDBFCharSet = (dcsNone, dcsOEM, dcsANSI);

  TQImport3DBF = class(TQImport3)
  private
    FDBF: TDBFRead;
    FSourceFieldsHash: THashTable;

    FSkipDeleted: boolean;
    FCharSet: TDBFCharSet;
    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 SkipFirstRows default 0;
    property CharSet: TDBFCharSet read FCharSet
      write FCharSet default dcsNone;
    property FileName;
  end;

implementation

uses Db, SysUtils, QImport3Common;

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

{ TQImport3DBF }

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

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

procedure TQImport3DBF.DoLoadConfiguration(IniFile: TIniFile);
begin
  inherited;
  with IniFile do
  begin
    SkipFirstRows := ReadInteger(DBF_OPTIONS, DBF_SKIP_LINES, SkipFirstRows);
    CharSet := TDBFCharSet(ReadInteger(DBF_OPTIONS, DBF_CHARSET, Integer(CharSet)));
  end;
end;

procedure TQImport3DBF.DoSaveConfiguration(IniFile: TIniFile);
begin
  inherited;
  with IniFile do
  begin
    WriteInteger(DBF_OPTIONS, DBF_SKIP_LINES, SkipFirstRows);
    WriteInteger(DBF_OPTIONS, DBF_CHARSET, Integer(CharSet));
  end;
end;

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

procedure TQImport3DBF.StartImport;
var
  i: integer;
begin
  FSourceFieldsHash := THashTable.Create(False);
  FSourceFieldsHash.TableSize := Map.Count;
  for i := 0 to Map.Count - 1 do
{$IFDEF VCL7}
    FSourceFieldsHash.Insert(Map.ValueFromIndex[i], Pointer(i));
{$ELSE}
    FSourceFieldsHash.Insert(Map.Values[Map.Names[i]], Pointer(i));
{$ENDIF}
end;

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

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

procedure TQImport3DBF.FillImportRow;
var
  i, j: integer;
  dataStr: AnsiString;
  p: Pointer;
begin
  FImportRow.ClearValues;
  for i := 0 to FDBF.FieldCount - 1 do
  begin
    dataStr := FDBF.GetData(i);
    if FCharSet <> dcsNone then
      if FCharSet = dcsOEM then
      begin
        GetMem(p, Length(dataStr));
        try
          OemToCharBuff(PAnsiChar(@dataStr[1]), p, Length(dataStr));
        finally
          FreeMem(p);
        end;
      end else
      if FCharSet = dcsANSI then
      begin
        GetMem(p, Length(dataStr));
        try
          CharToOemBuff(PChar(@dataStr[1]), PAnsiChar(p), Length(dataStr));
        finally
          FreeMem(p)
        end;
      end;
    if FSourceFieldsHash.Search({$IFDEF VCL12}string{$ENDIF}(FDBF.FieldName[i]), p) then
    begin
      j := Integer(p);
      if (FDBF.FieldType[i] = dftDate) and (dataStr <> '') then
        dataStr := {$IFDEF VCL12}AnsiString{$ENDIF}(DateTimeToStr(DBFStrToDateTime(
          {$IFDEF VCL12}string{$ENDIF}(dataStr))));
      FImportRow.SetValue(Map.Names[j], qiString(dataStr), False);
      DoUserDataFormat(FImportRow.ColByName(Map.Names[j]));
    end
  end;

  for i := 0 to FImportRow.Count - 1 do
  begin
    if not FImportRow.MapNameIdxHash.Search(FImportRow[i].Name, p) then
      DoUserDataFormat(FImportRow[i]);
  end;
end;

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

procedure TQImport3DBF.ChangeCondition;
begin
  //
end;

procedure TQImport3DBF.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
    FSourceFieldsHash.Free;
  end;
end;

function TQImport3DBF.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.