qimport3.pas

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

    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);
    function CanContinue: boolean;

    function StringToField(Field: TField;
      const Str: qiString;
      AIsBinary: Boolean): string;

    procedure DoLoadConfiguration(IniFile: TIniFile); virtual;
    procedure DoSaveConfiguration(IniFile: TIniFile); virtual;

    property SkipFirstRows: integer read FSkipFirstRows write FSkipFirstRows;
    property SkipFirstCols: integer read FSkipFirstCols write FSkipFirstCols;
  protected
    procedure DestinationInsert;
    procedure DestinationEdit;
    procedure DestinationDelete;
    procedure DestinationSetValues;
    procedure DestinationPost;
    procedure DestinationCancel;
    function  DestinationFindColumn(const ColName: string): integer;
    procedure DestinationDisableControls;
    procedure DestinationEnableControls;
    procedure CheckDestination;
    function DestinationFindByKey: boolean;
    function DestinationFindByFields: Boolean;
    function DestinationColCount: integer;
    function DestinationColName(Index: integer): string;

    procedure DoBeginImport; dynamic;
    function DoBeforePost: Boolean; dynamic;
    procedure DoAfterPost; dynamic;
    procedure DoImportRecord; dynamic;
    procedure DoImportError(Error: Exception); dynamic;
    procedure WriteErrorLog(const ErrorMsg: string);
    procedure DoNeedCommit; dynamic;
    procedure DoEndImport; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: boolean;
    procedure ImportToCSV(Stream: TStream; Comma, Quote: AnsiChar);
    procedure Cancel;
    procedure LoadConfiguration(const FileName: string);
    procedure SaveConfiguration(const FileName: string);
    property Errors: TStrings read FErrors;
    property ImportedRecs: integer read FImportedRecs;
    property ErrorRecs: integer read GetErrorRecs;
    property Canceled: boolean read FCanceled;
    property LastAction: TQImportAction read FLastAction write FLastAction;
    property TotalRecCount: integer read FTotalRecCount;
    property FileName: string read FFileName write SetFileName;
    property CurrentLineNumber: Integer read FCurrentLineNumber
      write FCurrentLineNumber;
    property LastError: AnsiString read FLastError write FLastError;
  published
    property About: string read FAbout write FAbout;
    property Version: string read FVersion write FVersion;

    property DataSet: TDataSet read FDataSet write SetDataSet;
{$IFNDEF NOGUI}
    property DBGrid: TDBGrid read FDBGrid write SetDBGrid;
    property ListView: TListView read FListView write SetListView;
    property StringGrid: TStringGrid read FStringGrid write SetStringGrid;
    property GridCaptionRow: integer read FGridCaptionRow
      write FGridCaptionRow default -1;
    property GridStartRow: integer read FGridStartRow
      write FGridStartRow default -1;
{$ENDIF}

    property ImportDestination: TQImportDestination read FImportDestination
      write FImportDestination default qidDataSet;
    property ImportMode: TQImportMode read FImportMode
      write FImportMode default qimInsertAll;

    property Map: TStrings read FMap write SetMap;
    property Formats: TQImportFormats read FFormats write SetFormats;
    property FieldFormats: TQImportFieldFormats read FFieldFormats
      write SetFieldFormats;
    property ErrorLog: boolean read FErrorLog write FErrorLog default false;
    property ErrorLogFileName: string read FErrorLogFileName
      write FErrorLogFileName;
    property RewriteErrorLogFile: boolean read FRewriteErrorLogFile
      write FRewriteErrorLogFile default true;
    property ShowErrorLog: boolean read FShowErrorLog
      write FShowErrorLog default false;
//    property SQLLog: boolean read FSQLLog write FSQLLog default false;
//    property SQLLogFileName: string read FSQLLogFileName
//      write FSQLLogFileName;
//    property SQLLogFileRewrite: boolean read FSQLLogFileRewrite
//      write FSQLLogFileRewrite default true;
    property ImportRecCount: integer read FImportRecCount
      write FImportRecCount default 0;
    property CommitRecCount: integer read FCommitRecCount
      write FCommitRecCount default 100;
    property CommitAfterDone: boolean read FCommitAfterDone
      write FCommitAfterDone default true;
    property AddType: TQImportAddType read FAddType
      write FAddType default qatAppend;
    property KeyColumns: TStrings read FKeyColumns write SetKeyColumns;
    property AllowDuplicates: Boolean read FAllowDuplicates
      write FAllowDuplicates default True;

    property OnBeforeImport: TNotifyEvent read FOnBeforeImport
      write FOnBeforeImport;
    property OnAfterImport: TNotifyEvent read FOnAfterImport
      write FOnAfterImport;
    property OnImportRecord: TNotifyEvent read FOnImportRecord
      write FOnImportRecord;
    property OnImportError: TNotifyEvent read FOnImportError
      write FOnImportError;
    property OnImportErrorAdv: TNotifyEvent read FOnImportErrorAdv
      write FOnImportErrorAdv;
    property OnNeedCommit: TNotifyEvent read FOnNeedCommit
      write FOnNeedCommit;
    property OnImportCancel: TImportCancelEvent read FOnImportCancel
      write FOnImportCancel;
    property OnBeforePost: TImportBeforePostEvent read FOnBeforePost
      write FOnBeforePost;
    property OnAfterPost: TImportAfterPostEvent read FOnAfterPost
      write FOnafterPost;
    property OnUserDefinedImport: TUserDefinedImportEvent
      read FOnUserDefinedImport write FOnUserDefinedImport;
    property OnImportRowComplete: TUserDefinedImportEvent
      read FOnImportRowComplete write FOnImportRowComplete;
//    property OnGetSQLIdentifier: TImportSQLIdentifierEvent
//      read FOnGetSQLIdentifier write FOnGetSQLIdentifier;
    property OnDestinationLocate: TDestinationLocateEvent read
      FOnDestinationLocate write FOnDestinationLocate;
  private
    FCustomImportMode: Boolean;
    FCustomImportError: Boolean;
    FTempFileCharset: AnsiString;
    FOnSetCharsetType: TSetCharsetTypeEvent;
    FOnWideStringToCharset: TWideStringToCharsetEvent;
  public
    property CustomImportMode: Boolean read FCustomImportMode
      write FCustomImportMode;
    property ImportRow: TQImportRow read FImportRow;
    property TempFileCharset: AnsiString read FTempFileCharset write
      FTempFileCharset;
    property OnSetCharsetType: TSetCharsetTypeEvent
      read FOnSetCharsetType write FOnSetCharsetType;
    property OnWideStringToCharset: TWideStringToCharsetEvent
      read FOnWideStringToCharset write FOnWideStringToCharset;
  end;

function GetImportFieldType(Field: TField): TQImportFieldType;
procedure StrReplace(var S: string; const Search, Replace: string;
  Flags: TReplaceFlags);

function QImportLocale: TQImportLocale;
function QImportLoadStr(ID: Integer): string;

implementation

uses
  QImport3Common, QImport3StrIDs, EmsWideStrUtils, Windows, FileCtrl, ShellAPI
  {$IFDEF ADVANCED_DATA_IMPORT_TRIAL_VERSION}, fuQImport3About{$ENDIF}
  {$IFDEF VCL6}, Variants{$ENDIF};

const
  LF = #13#10;
  sStreamMustBeAssigned = 'Stream must be assigned!';
var
  Locale: TQImportLocale = nil;

{$IFDEF ADVANCED_DATA_IMPORT_TRIAL_VERSION}
function IsIDERuning: Boolean;
begin
  Result := (FindWindow('TAppBuilder', nil) <> 0) or
            (FindWindow('TPropertyInspector', nil) <> 0) or
            (FindWindow('TAlignPalette', nil) <> 0);
end;
{$ENDIF}

function GetImportFieldType(Field: TField): TQImportFieldType;
begin
  case Field.DataType of
    ftBlob,
    ftMemo,
    //igorp
    ftOraClob,
    ftOraBlob,
    //\igorp
    {$IFNDEF VCL3}
    ftWideString,
    {$ENDIF}
    ftString,
    ftGUID: Result := iftString;
    // ayz
    ftVarBytes,
    ftBytes: Result := iftBytes;
    //\ayz
    ftSmallint,
    ftInteger,
    {ab}ftAutoInc,{/ab}
{$IFNDEF VCL3}
    ftLargeInt,
{$ENDIF}
    ftWord: Result := iftInteger;
    ftBoolean: Result := iftBoolean;
    ftFloat,
    ftBCD
{$IFDEF VCL6}
    , ftFMTBcd
{$ENDIF}
    : Result := iftDouble;
    ftCurrency: Result := iftCurrency;
    ftDate,
    ftTime,
    ftDateTime
{$IFDEF VCL6}
    , ftTimeStamp
{$ENDIF}
    : Result := iftDateTime;
  else
    Result := iftUnknown;
  end;
end;

procedure StrReplaceCS(var S: string; const Search, Replace: string; Flags: TReplaceFlags);
var
  ResultStr: string;
  SourcePtr: PChar;
  SourceMatchPtr: PChar;
  SearchMatchPtr: PChar;
  ResultPtr: PChar;
  SearchLength,
  ReplaceLength,
  ResultLength: Integer;
  C: Char;
begin
  SearchLength := Length(Search);
  ReplaceLength := Length(Replace);

  if Length(Search) >= ReplaceLength then
    ResultLength := Length(S)
  else
    ResultLength := ((Length(S) div Length(Search)) + 1) * Length(Replace);
  SetLength(ResultStr, ResultLength);
  ResultPtr := PChar(ResultStr);
  SourcePtr := PChar(S);
  C := Search[1];

  while True do
  begin
    while (SourcePtr^ <> C) and (SourcePtr^ <> #0) do
    begin
      ResultPtr^ := SourcePtr^;
      Inc(ResultPtr);
      Inc(SourcePtr);
    end;

    if SourcePtr^ = #0 then
      Break
    else
    begin

      SourceMatchPtr := SourcePtr + 1;
      SearchMatchPtr := PChar(Search) + 1;
      while (SourceMatchPtr^ = SearchMatchPtr^) and (SearchMatchPtr^ <> #0) do
      begin
        Inc(SourceMatchPtr);
        Inc(SearchMatchPtr);
      end;

      if SearchMatchPtr^ = #0 then
      begin
        Move((@Replace[1])^, ResultPtr^, ReplaceLength);
        Inc(SourcePtr, SearchLength);
        Inc(ResultPtr, ReplaceLength);

        if not (rfReplaceAll in Flags) then
        begin
          while SourcePtr^ <> #0 do
          begin
            ResultPtr^ := SourcePtr^;
            Inc(ResultPtr);
            Inc(SourcePtr);
          end;
          Break;
        end;
      end
      else
      begin
        ResultPtr^ := SourcePtr^;
        Inc(ResultPtr);
        Inc(SourcePtr);
      end;
    end;
  end;

  ResultPtr^ := #0;
  S := ResultStr;
  SetLength(S, StrLen(PChar(S)));
end;

procedure StrReplaceCI(var S: string; Search, Replace: string; Flags: TReplaceFlags);
var
  ResultStr: string;
  SourcePtr: PChar;
  SourceMatchPtr: PChar;
  SearchMatchPtr: PChar;
  ResultPtr: PChar;
  SearchLength,
  ReplaceLength,
  ResultLength: Integer;
  C: Char;
begin
  Search := AnsiUpperCase(Search);
  SearchLength := Length(Search);
  ReplaceLength := Length(Replace);

  if Length(Search) >= ReplaceLength then
    ResultLength := Length(S)
  else
    ResultLength := ((Length(S) div Length(Search)) + 1) * Length(Replace);
  SetLength(ResultStr, ResultLength);

  ResultPtr := PChar(ResultStr);
  SourcePtr := PChar(S);
  C := Search[1];

  while True do
  begin
    while (UpCase(SourcePtr^) <> C) and (SourcePtr^ <> #0) do
    begin
      ResultPtr^ := SourcePtr^;
      Inc(ResultPtr);
      Inc(SourcePtr);
    end;

    if SourcePtr^ = #0 then
      Break
    else
    begin
      SourceMatchPtr := SourcePtr + 1;
      SearchMatchPtr := PChar(Search) + 1;
      while (UpCase(SourceMatchPtr^) = SearchMatchPtr^) and (SearchMatchPtr^ <> #0) do
      begin
        Inc(SourceMatchPtr);
        Inc(SearchMatchPtr);
      end;

      if SearchMatchPtr^ = #0 then
      begin
        Move((@Replace[1])^, ResultPtr^, ReplaceLength);
        Inc(SourcePtr, SearchLength);
        Inc(ResultPtr, ReplaceLength);

        if not (rfReplaceAll in Flags) then
        begin
          while SourcePtr^ <> #0 do
          begin
            ResultPtr^ := SourcePtr^;
            Inc(ResultPtr);
            Inc(SourcePtr);
          end;
          Break;
        end;
      end
      else
      begin
        ResultPtr^ := SourcePtr^;
        Inc(ResultPtr);
        Inc(SourcePtr);
      end;
    end;
  end;
  
  ResultPtr^ := #0;
  S := ResultStr;
  SetLength(S, StrLen(PChar(S)));
end;

procedure StrReplace(var S: string; const Search, Replace: string;
  Flags: TReplaceFlags);
begin
  if (S <> '') and (Search <> '') then
  begin
    if rfIgnoreCase in Flags then
      StrReplaceCI(S, Search, Replace, Flags)
    else
      StrReplaceCS(S, Search, Replace, Flags);
  end;
end;

{$IFDEF QI_UNICODE}
procedure WideStrReplaceCI(var S: WideString; Search, Replace: WideString; Flags: TReplaceFlags);
var
  ResultStr: WideString;
  SourcePtr: PWideChar;
  SourceMatchPtr: PWideChar;
  SearchMatchPtr: PWideChar;
  ResultPtr: PWideChar;
  SearchLength,
  ReplaceLength,
  ResultLength: Integer;
  C: WideChar;
  LowerCaseFlag: Boolean;
begin
  Search := QIUpperCase(Search);
  SearchLength := Length(Search);
  ReplaceLength := Length(Replace);

  if Length(Search) >= ReplaceLength then
    ResultLength := Length(S)
  else
    ResultLength := ((Length(S) div Length(Search)) + 1) * Length(Replace);
  SetLength(ResultStr, ResultLength);