qimport3.pas

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

unit QImport3;

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

{$I VerCtrl.inc}

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

interface

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

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

  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: {$IFDEF QI_UNICODE}WideString{$ELSE}string{$ENDIF};
    FReplaceWith: {$IFDEF QI_UNICODE}WideString{$ELSE}string{$ENDIF};
    FIgnoreCase: Boolean;
  protected
    function  GetDisplayName: string; override;
  public
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
  published
    property TextToFind: {$IFDEF QI_UNICODE}WideString{$ELSE}string{$ENDIF}
      read FTextToFind write FTextToFind;
    property ReplaceWith: {$IFDEF QI_UNICODE}WideString{$ELSE}string{$ENDIF}
      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: {$IFDEF QI_UNICODE}WideString{$ELSE}string{$ENDIF};
      AIgnoreCase: Boolean): Boolean;
  end;

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

    FConstantValue: {$IFDEF QI_UNICODE}WideString{$ELSE}string{$ENDIF};
    FNullValue: {$IFDEF QI_UNICODE}WideString{$ELSE}string{$ENDIF};
    FDefaultValue: {$IFDEF QI_UNICODE}WideString{$ELSE}string{$ENDIF};
    FLeftQuote: {$IFDEF QI_UNICODE}WideString{$ELSE}string{$ENDIF};
    FRightQuote: {$IFDEF QI_UNICODE}WideString{$ELSE}string{$ENDIF};

    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: {$IFDEF QI_UNICODE}WideString{$ELSE}string{$ENDIF}
      read FConstantValue write FConstantValue stored IsConstant;
    property NullValue: {$IFDEF QI_UNICODE}WideString{$ELSE}string{$ENDIF}
      read FNullValue write FNullValue stored IsNull;
    property DefaultValue: {$IFDEF QI_UNICODE}WideString{$ELSE}string{$ENDIF}
      read FDefaultValue write FDefaultValue stored IsDefault;
    property LeftQuote: {$IFDEF QI_UNICODE}WideString{$ELSE}string{$ENDIF}
      read FLeftQuote write FLeftQuote stored IsLeftQuote;
    property RightQuote: {$IFDEF QI_UNICODE}WideString{$ELSE}string{$ENDIF}
      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: {$IFDEF QI_UNICODE}WideString{$ELSE}string{$ENDIF};
    FName: string;
    FIsBinary: Boolean;
    FColumnIndex: Integer;
  public
    constructor Create;
    property Name: string read FName write FName;
    property Value: {$IFDEF QI_UNICODE}WideString{$ELSE}string{$ENDIF} 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: {$IFDEF QI_UNICODE}WideString{$ELSE}string{$ENDIF};
      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;
//  TImportSQLIdentifierEvent = procedure (Sender: TObject;
//    var Identifier: 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: string) of object;
  TWideStringToCharsetEvent = procedure(Sender: TObject;
    const SourceStr: WideString; var EncodedStr: string) of object;

  TQImport3 = class(TComponent)
  private
    FLastError: String;
    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: Char;
    FQuote: Char;

    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;
    procedure StartImport; virtual; abstract;
    function CheckCondition: boolean; virtual; abstract;
    function Skip: boolean; virtual; abstract;
    procedure FillImportRow; virtual; abstract;
    function ImportData: TQImportResult; virtual; abstract;
    procedure DataManipulation;
    procedure ChangeCondition; virtual; abstract;
    procedure FinishImport; virtual; abstract;
    procedure AfterImport; virtual;

    procedure DoAfterSetFileName; virtual;
    function CheckProperties: Boolean; virtual;
    procedure DoUserDataFormat(Col: TQImportCol);