qimport2.pas

EMS Advanced.Import.Component.Suite.v2.43

    function CheckProperties: boolean; virtual;
    procedure DoUserDataFormat(Col: TQImportCol);
    function CanContinue: boolean;
    function StringToField(Field: TField; const Str: string; IsBinary: 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: char);
    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;
    property TotalRecCount: integer read FTotalRecCount;
    property FileName: string read FFileName write SetFileName;
    property CurrentLineNumber: Integer read FCurrentLineNumber;
  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;
  end;

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

{$IFDEF WIN32}
function QImportLocale: TQImportLocale;
function QImportLoadStr(ID: Integer): string;
{$ENDIF}

implementation

uses QImport2Common
     {$IFDEF WIN32}, QImport2StrIDs, Windows, FileCtrl, ShellAPI
       {$IFDEF TRIAL}, fuQImport2About{$ENDIF}
       {$IFDEF VCL6}, Variants{$ENDIF}
     {$ENDIF}
     {$IFDEF LINUX}, QImport2Consts, Variants{$ENDIF};

const
  LF = {$IFDEF WIN32}#13#10{$ENDIF}{$IFDEF LINUX}#10{$ENDIF};

{$IFDEF WIN32}
var
  Locale: TQImportLocale = nil;
{$ENDIF}

{$IFDEF TRIAL}
{$IFDEF WIN32}
function IsIDERuning: Boolean;
begin
  Result := (FindWindow('TAppBuilder', nil) <> 0) or
            (FindWindow('TPropertyInspector', nil) <> 0) or
            (FindWindow('TAlignPalette', nil) <> 0);
end;
{$ENDIF}
{$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;
    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: AnsiString; const Search, Replace: AnsiString; 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: AnsiString; Search, Replace: AnsiString; Flags: TReplaceFlags);
var
  ResultStr: string;
  SourcePtr: PChar;
  SourceMatchPtr: PChar;
  SearchMatchPtr: PChar;
  ResultPtr: PChar;
  SearchLength,
  ReplaceLength,
  ResultLength: Integer;
  C: Char;
begin
  Search := UpperCase(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: AnsiString; const Search, Replace: AnsiString;
  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 WIN32}
function QImportLocale: TQImportLocale;
begin
  if Locale = nil then
    Locale := TQImportLocale.Create;
  Result := Locale;
end;

function QImportLoadStr(ID: Integer): string;
begin
  Result := QImportLocale.LoadStr(ID);
end;
{$ENDIF}

{ TQImportFormats }

constructor TQImportFormats.Create;
begin
  inherited;
  FDecimalSeparator := SysUtils.DecimalSeparator;
  FThousandSeparator := SysUtils.ThousandSeparator;
  FShortDateFormat := SysUtils.ShortDateFormat;
  FLongDateFormat := SysUtils.LongDateFormat;
  FDateSeparator := SysUtils.DateSeparator;
  FShortTimeFormat := SysUtils.ShortTimeFormat;
  FLongTimeFormat := SysUtils.LongTimeFormat;
  FTimeSeparator := SysUtils.TimeSeparator;
  FBooleanTrue := TStringList.Create;
  FBooleanTrue.Add({$IFDEF WIN32}QImportLoadStr(QID_BooleanTrue){$ENDIF}
                   {$IFDEF LINUX}QID_BooleanTrue{$ENDIF});
  FBooleanFalse := TStringList.Create;
  FBooleanFalse.Add({$IFDEF WIN32}QImportLoadStr(QID_BooleanFalse){$ENDIF}
                    {$IFDEF LINUX}QID_BooleanFalse{$ENDIF});
  FNullValues := TStringList.Create;
  FNullValues.Add({$IFDEF WIN32}QImportLoadStr(QID_NullValue){$ENDIF}
                  {$IFDEF LINUX}QID_NullValue{$ENDIF});
end;

destructor TQImportFormats.Destroy;
begin
  FBooleanTrue.Free;