qimport3.pas

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

unit QImport3;

{$R QIResStr.res}
{$R QIEULA.res}

{$I QImport3VerCtrl.Inc}

{$IFDEF VCL6}
  {$WARN UNIT_PLATFORM OFF}
{$ENDIF}

interface

uses Classes, DB, SysUtils, EZDSLHsh, IniFiles
     {$IFNDEF NOGUI}, DBGrids, ComCtrls, Grids{$ENDIF}, QImport3StrTypes;

type
  TQImport3 = class;
  TAllowedImport = (aiXLS, aiDBF, aiXML, aiTXT, aiCSV, aiAccess, aiHTML,aiXMLDoc,
    aiXlsx, aiDocx, aiODS, aiODT);
  TAllowedImports = set of TAllowedImport;

  TQICharsetType = (
    ctWinDefined, ctLatin1, ctArmscii8, ctAscii, ctCp850, ctCp852, ctCp866,
    ctCp1250, ctCp1251, ctCp1256, ctCp1257, ctDec8, ctGeostd8, ctGreek,
    ctHebrew, ctHp8, ctKeybcs2, ctKoi8r, ctKoi8u, ctLatin2, ctLatin5,
    ctLatin7, ctMacce, ctMacroman, ctSwe7, ctUtf8, ctUtf16, ctUtf32,
    // unique in postrgesql
    ctLatin3, ctLatin4, ctLatin6, ctLatin8, ctIso8859_5, ctIso8859_6,
    //unique in db2
    ctCp1026, ctCp1254, ctCp1255, ctCp1258, ctCp437, ctCp500, ctCp737, ctCp855,
    ctCp856, ctCp857, ctCp860, ctCp862, ctCp863, ctCp864, ctCp865, ctCp869,
    ctCp874, ctCp875, ctIceland,
    //unique in IB/FB
    ctBig5, ctKSC5601, ctEUC, ctGB2312, ctSJIS_0208, ctLatin9, ctLatin13,
    ctCp1252, ctCp1253, ctCp775, ctCp858 );

  TQuoteAction = (qaNone, qaAdd, qaRemove);
  TQImportCharCase = (iccNone, iccUpper, iccLower, iccUpperFirst, iccUpperFirstWord);
  TQImportCharSet = (icsNone, icsAnsi, icsOem);

  TLocalizeEvent = procedure(StringID: Integer; var ResultString: String) of object;

  TQImportLocale = class(TObject)
  private
    FDllHandle: Cardinal;
    FLoaded: Boolean;
    FOnLocalize: TLocalizeEvent;
    FIDEMode: Boolean;
  public
    constructor Create;
    function LoadStr(ID: Integer): String;
    procedure LoadDll(const Name: string);
    procedure UnloadDll;
    property OnLocalize: TLocalizeEvent read FOnLocalize write FOnLocalize;
  end;

  TQImportFormats = class(TPersistent)
  private
    FDecimalSeparator: Char;
    FThousandSeparator: Char;
    FShortDateFormat: String;
    FLongDateFormat: String;
    FDateSeparator: Char;
    FShortTimeFormat: String;
    FLongTimeFormat: String;
    FTimeSeparator: Char;
    FBooleanTrue: TStrings;
    FBooleanFalse: TStrings;
    FNullValues: TStrings;

    FOldDecimalSeparator: Char;
    FOldThousandSeparator: Char;
    FOldShortDateFormat: string;
    FOldLongDateFormat: string;
    FOldDateSeparator: Char;
    FOldShortTimeFormat: string;
    FOldLongTimeFormat: string;
    FOldTimeSeparator: Char;

    function IsDecimalSeparator: boolean;
    function IsThousandSeparator: boolean;
    function IsShortDateFormat: boolean;
    function IsLongDateFormat: boolean;
    function IsDateSeparator: boolean;
    function IsShortTimeFormat: boolean;
    function IsLongTimeFormat: boolean;
    function IsTimeSeparator: boolean;

    procedure SetBooleanTrue(const Value: TStrings);
    procedure SetBooleanFalse(const Value: TStrings);
    procedure SetNullValues(const Value: TStrings);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure StoreFormats;
    procedure RestoreFormats;
    procedure ApplyParams;
  published
    property DecimalSeparator: Char read FDecimalSeparator
      write FDecimalSeparator stored IsDecimalSeparator;
    property ThousandSeparator: Char read FThousandSeparator
      write FThousandSeparator stored IsThousandSeparator;
    property ShortDateFormat: String read FShortDateFormat
      write FShortDateFormat stored IsShortDateFormat;
    property LongDateFormat: String read FLongDateFormat
      write FLongDateFormat stored IsLongDateFormat;
    property DateSeparator: Char read FDateSeparator write FDateSeparator
      stored IsDateSeparator;
    property ShortTimeFormat: String read FShortTimeFormat
      write FShortTimeFormat stored IsShortTimeFormat;
    property LongTimeFormat: String read FLongTimeFormat
      write FLongTimeFormat stored IsLongTimeFormat;
    property TimeSeparator: Char read FTimeSeparator write FTimeSeparator
      stored IsTimeSeparator;
    property BooleanTrue: TStrings read FBooleanTrue write SetBooleanTrue;
    property BooleanFalse: TStrings read FBooleanFalse write SetBooleanFalse;
    property NullValues: TStrings read FNullValues write SetNullValues;
  end;

  TQImportReplacement = class(TCollectionItem)
  private
    FTextToFind: qiString;
    FReplaceWith: qiString;
    FIgnoreCase: Boolean;
  protected
    function  GetDisplayName: string; override;
  public
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
  published
    property TextToFind: qiString
      read FTextToFind write FTextToFind;
    property ReplaceWith: qiString
      read FReplaceWith write FReplaceWith;
    property IgnoreCase: Boolean read FIgnoreCase
      write FIgnoreCase default False;
  end;

  TQImportReplacements = class(TCollection)
  private
    FHolder: TPersistent;
    function GetItem(Index: integer): TQImportReplacement;
    procedure SetItem(Index: integer; Replacement: TQImportReplacement);
  protected
    function GetOwner: TPersistent; override;
  public
    property Holder: TPersistent read FHolder;
    constructor Create(Holder: TPersistent);
    function Add: TQImportReplacement;
    property Items[Index: integer]: TQImportReplacement read GetItem
      write SetItem; default;
    function ItemExists(
      const ATextToFind, AReplaceWith: qiString;
      AIgnoreCase: Boolean): Boolean;
  end;

  TQImportFieldFormat = class(TCollectionItem)
  private
    FFieldName: string;
    FGeneratorValue: Integer;
    FGeneratorStep: Integer;

    FConstantValue: qiString;
    FNullValue: qiString;
    FDefaultValue: qiString;
    FLeftQuote: qiString;
    FRightQuote: qiString;

    FQuoteAction: TQuoteAction;
    FCharCase: TQImportCharCase;
    FCharSet: TQImportCharSet;
    FReplacements: TQImportReplacements;

    function IsConstant: Boolean;
    function IsNull: Boolean;
    function IsDefault: Boolean;
    function IsLeftQuote: Boolean;
    function IsRightQuote: Boolean;

    procedure SetReplacements(const Value: TQImportReplacements);
  protected
    function GetDisplayName: string; override;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function IsDefaultValues: boolean;
  published
    property FieldName: string read FFieldName write FFieldName;
    property GeneratorValue: integer read FGeneratorValue
      write FGeneratorValue default 0;
    property GeneratorStep: integer read FGeneratorStep
      write FGeneratorStep default 0;

    property ConstantValue: qiString
      read FConstantValue write FConstantValue stored IsConstant;
    property NullValue: qiString
      read FNullValue write FNullValue stored IsNull;
    property DefaultValue: qiString
      read FDefaultValue write FDefaultValue stored IsDefault;
    property LeftQuote: qiString
      read FLeftQuote write FLeftQuote stored IsLeftQuote;
    property RightQuote: qiString
      read FRightQuote write FRightQuote stored IsRightQuote;

    property QuoteAction: TQuoteAction read FQuoteAction
      write FQuoteAction default qaNone;
    property CharCase: TQImportCharCase read FCharCase
      write FCharCase default iccNone;
    property CharSet: TQImportCharSet read FCharSet
      write FCharSet default icsNone;
    property Replacements: TQImportReplacements read FReplacements
      write SetReplacements;
  end;

  TQImportFieldFormats = class(TCollection)
  private
    FHolder: TComponent;
    function GetItem(Index: integer): TQImportFieldFormat;
    procedure SetItem(Index: integer; FieldFormat: TQImportFieldFormat);
  protected
    function GetOwner: TPersistent; override;
  public
    property Holder: TComponent read FHolder;
    constructor Create(AHolder: TComponent);
    function Add: TQImportFieldFormat;
    function IndexByName(const FieldName: string): integer;
    property Items[Index: integer]: TQImportFieldFormat read GetItem write SetItem; default;
  end;

  TQImportCol = class
  private
    FValue: qiString;
    FName: string;
    FIsBinary: Boolean;
    FColumnIndex: Integer;
  public
    constructor Create;
    property Name: string read FName write FName;
    property Value: qiString read FValue write FValue;
    property IsBinary: Boolean read FIsBinary;
  end;

  TQImportRow = class(TList)
  private
    FMapNameIdxHash: THashTable;
    FColHash: THashTable;
    FQImport: TQImport3;

    function Get(Index: Integer): TQImportCol;
    procedure Put(Index: Integer; const Value: TQImportCol);
  public
    constructor Create(AImport: TQImport3);
    destructor Destroy; override;
    function Add(const AName: string): TQImportCol;
    procedure Clear; {$IFNDEF VCL3} override; {$ENDIF}
    procedure Delete(Index: integer);
    function First: TQImportCol;
    procedure SetValue(const AName, AValue: qiString;
      AIsBinary: Boolean);
    procedure ClearValues;
    function Last: TQImportCol;
    function IndexOf(Item: TQImportCol): Integer;

    function ColByName(const AName: string): TQImportCol;

    property QImport: TQImport3 read FQImport;
    property Items[Index: Integer]: TQImportCol read Get write Put; default;
    property MapNameIdxHash: THashTable read FMapNameIdxHash;
  end;

  TQImportGenerator = class
  private
    FName: string;
    FValue: integer;
    FStep: integer;
  public
    function GetNewValue: integer;
    property Name: string read FName write FName;
    property Value: integer read FValue write FValue;
    property Step: integer read FStep write FStep;
  end;

  TQImportGenerators = class(TList)
  private
    function Get(Index: Integer): TQImportGenerator;
    procedure Put(Index: Integer; const Value: TQImportGenerator);
  public
    destructor Destroy; override;
    function Add(const AName: string; AValue, AStep: integer): TQImportGenerator;
    procedure Delete(Index: integer);
    function GetNewValue(const AName: string): integer;
    function GenByName(const AName: string): TQImportGenerator;

    property Items[Index: Integer]: TQImportGenerator read Get write Put; default;
  end;

  TQImportFieldType = (iftUnknown, iftString, iftInteger, iftBoolean,
    iftDouble, iftCurrency, iftDateTime, iftBytes);
  EQImportError = class(Exception);
  TQImportAddType = (qatAppend, qatInsert);
  TQImportDestination = (qidDataSet, qidDBGrid, qidListView, qidStringGrid,
    qidUserDefined);
  TQImportResult = (qirOk, qirContinue, qirBreak);
  TQImportMode = (qimInsertAll, qimInsertNew, qimUpdate, qimUpdateOrInsert,
    qimDelete, qimDeleteOrInsert);
  TQImportAction = (qiaNone, qiaInsert, qiaUpdate, qiaDelete);

  TImportCancelEvent = procedure(Sender: TObject;
    var Continue: boolean) of object;
  TImportBeforePostEvent = procedure(Sender: TObject;
    Row: TQImportRow; var Accept: boolean) of object;
  TUserDefinedImportEvent = procedure(Sender: TObject;
    Row: TQImportRow) of object;
  TImportAfterPostEvent = procedure(Sender: TObject;
    Row: TQImportRow) of object;
  TImportLoadTemplateEvent = procedure(Sender: TObject;
    const FileName: string) of object;
  TDestinationLocateEvent = procedure(Sender: TObject; KeyColumns: TStrings;
    Row: TQImportRow; var KeyFields: string; var KeyValues: Variant) of object;
  TSetCharsetTypeEvent = procedure(Sender: TObject; const Charset: AnsiString) of object;
  TWideStringToCharsetEvent = procedure(Sender: TObject;
    const SourceStr: WideString; var EncodedStr: AnsiString) of object;

  TQImport3 = class(TComponent)
  private
    FLastError: AnsiString;
    FDataSet: TDataSet;
{$IFNDEF NOGUI}
    FDBGrid: TDBGrid;
    FListView: TListView;
    FStringGrid: TStringGrid;
    FGridCaptionRow: integer;
    FGridStartRow: integer;
{$ENDIF}

    FFileName: string;
    FErrors: TStrings;
    FMap: TStrings;
    FImportRecCount: integer;
    FCommitRecCount: integer;
    FCommitAfterDone: boolean;
    FErrorLog: boolean;
    FErrorLogFileName: string;
    FRewriteErrorLogFile: boolean;
    FShowErrorLog: boolean;
    FErrorLogFS: TFileStream;
//    FSQLLog: boolean;
//    FSQLLogFileName: string;
//    FSQLLogFileRewrite: boolean;
//    FSQL: TFileStream;
    FSkipFirstRows: integer;
    FSkipFirstCols: integer;
    FImportedRecs: integer;
    FCanceled: boolean;
    FFormats: TQImportFormats;
    FFieldFormats: TQImportFieldFormats;
    FAddType: TQImportAddType;
    FImportDestination: TQImportDestination;
    FImportMode: TQImportMode;
    FKeyColumns: TStrings;
    FCurrentLineNumber: Integer;

    FIsCSV: boolean;
    FLastAction: TQImportAction;

    FStream: TStream;
    FComma: AnsiChar;
    FQuote: AnsiChar;

    FOnBeforeImport: TNotifyEvent;
    FOnAfterImport: TNotifyEvent;
    FOnImportRecord: TNotifyEvent;
    FOnImportError: TNotifyEvent;
    FOnImportErrorAdv: TNotifyEvent;
    FOnNeedCommit: TNotifyEvent;
    FOnImportCancel: TImportCancelEvent;
    FOnBeforePost: TImportBeforePostEvent;
    FOnAfterPost: TImportAfterPostEvent;
//    FOnGetSQLIdentifier: TImportSQLIdentifierEvent;
    FOnUserDefinedImport: TUserDefinedImportEvent;
    FOnImportRowComplete: TUserDefinedImportEvent;
    FOnDestinationLocate: TDestinationLocateEvent;

    FAbout: string;
    FVersion: string;
    FMappedColumns: TStrings;
    FAllowDuplicates: Boolean;
    procedure SetDataSet(const Value: TDataSet);
{$IFNDEF NOGUI}
    procedure SetDBGrid(const Value: TDBGrid);
    procedure SetListView(const Value: TListView);
    procedure SetStringGrid(const Value: TStringGrid);
{$ENDIF}
    procedure SetKeyColumns(const Value: TStrings);

    procedure SetFileName(const Value: string);
    procedure SetMap(const Value: TStrings);
    function GetErrorRecs: integer;
    procedure SetFormats(const Value: TQImportFormats);
    procedure SetFieldFormats(const Value: TQImportFieldFormats);
  private
{$IFNDEF NOGUI}
    FCurrListItem: TListItem;
    FCurrStrGrRow: integer;
{$ENDIF}
    procedure InitializeImportRow;
  protected
    FTotalRecCount: integer;
    FImportRow: TQImportRow;
    FImportGenerators: TQImportGenerators;

    property IsCSV: boolean read FIsCSV;

    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;

    procedure DoImport;

    procedure BeforeImport; virtual;