qexport4sql.pas

Advanced.Export.Component.v4.01.rar,delphi 第三方控件

unit QExport4SQL;

{$I VerCtrl.inc}

interface

uses QExport4, Classes, QExport4Types;

type
  TQExportScriptType = (qstAnsi, qstDB2, qstIB, qstMS, qstMy, qstOra, qstPg);

  TQExport4SQL = class(TQExport4FormatTextSQL)
  private
    FCommitAfterScript: boolean;
    FCreateTable: boolean;
    FStatementTerm: char;
    FCommitRecCount: integer;
    FCommitStatement: QEString;
    FTableName: QEString;
    FColumnString: QEString;
    FCustomScriptType: TQExportScriptType;
    FOpenTran: Boolean;
    function GetNullValue: QEString;
    procedure SetNullValue(const Value: QEString);
    function GetFormatValues: Boolean;
    procedure SetFormatValues(const Value: Boolean);

    function FormatIdent(const Ident: QEString): QEString;
    function GetDefaultVersion: Variant;
    function ColumnToIdentString(Column: TQExportColumn): QEString;
    function GetScriptTerminator: string;
    function GetCommitStatement: QEString;
    function GetStartTranStatementIfNeed: QEString;
    
  protected
    procedure BeginExport; override;
    function GetColData(ColValue: QEString;
      Column: TQExportColumn): QEString; override;
    function GetDataRow: QEString; override;
    procedure WriteDataRow; override;
    procedure EndExport; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property TableName: QEString read FTableName write FTableName;
    property CommitRecCount: integer read FCommitRecCount
      write FCommitRecCount default 0;
    property CommitAfterScript: boolean read FCommitAfterScript
      write FCommitAfterScript default false;
    property CommitStatement: QEString read GetCommitStatement write FCommitStatement;
    property CreateTable: boolean read FCreateTable
      write FCreateTable default false;
    property StatementTerm: char read FStatementTerm
      write FStatementTerm default ';';
    property NullValue: QEString read GetNullValue write SetNullValue;
    property FormatValues: Boolean read GetFormatValues
      write SetFormatValues default False;
    property CustomScriptType: TQExportScriptType read FCustomScriptType
      write FCustomScriptType default qstAnsi;
  end;

//function QuoteIdent(const Name: QEString; LeftQuote, RightQuote: QEChar): QEString; overload;
//function QuoteIdent(const Name: QEString; Quote: QEChar): QEString; overload;

implementation

uses
  SysUtils, DBConsts, QExport4Common {$IFDEF VCL9}, Windows{$ENDIF}, DB
  {$IFDEF VCL6}, StrUtils{$ENDIF};

const
  LF = #13#10;
  _NSDlm = '.';

function QuoteIdent(const Name: QEString; LeftQuote, RightQuote: QEChar): QEString; overload;

  function GetQuoted(const Text: QEString; const CheckQuote: Boolean): QEString;
  begin
    Result := LeftQuote + Text + RightQuote;
    if CheckQuote and (Text <> '') then
      if (Text[1] = LeftQuote) and (Text[Length(Text)] = RightQuote) then
        Result := Text;
  end;
  
var
  I, J: Integer;
begin
  Result := '';
  if (Name = '') or (Name[1] = LeftQuote) then
  begin
    Result := Name; //alex c
    Exit;
  end;

  I := 1;
  repeat
    J := PosEx('.', Name, I);
    if J = 0 then
      J := Length(Name) + 1;
    if I < J then
      if Result = '' then
        Result := GetQuoted(Copy(Name, I, J - I), True)
      else
        Result := Result + '.' + GetQuoted(Copy(Name, I, J - I), True);
    I := J + 1;
  until
    I > Length(Name);
end;

function QuoteIdent(const Name: QEString; Quote: QEChar): QEString; overload;
begin
  Result := QuoteIdent(Name, Quote, Quote);
end;

function QEQuotedStr(const S: QEString; Quote: QEChar): QEString;
var
  I: Integer;
begin
  Result := S;
  for I := Length(Result) downto 1 do
    if Result[I] = '''' then Insert('''', Result, I);
  Result := '''' + Result + '''';
end;

function Get_Name(const FullName: QEString; const NSDlm: QEString = '.'): QEString;
var
  I, J: Integer;
begin
  //J := Pos('(', FullName);
  J := -1;
  I := Pos(NSDlm, FullName);
  if ((J <= 0) or (I < J)) and (I > 0) and (I + Length(NSDlm) <= Length(FullName)) then
    Result := Copy(FullName, I + Length(NSDlm), Length(FullName))
  else
    Result := FullName;
end;

function Get_NameSpace(const FullName: QEString; const NSDlm: QEString = '.'): QEString;
var
  I, J: Integer;
begin
  J := Pos('(', FullName);
  I := Pos(NSDlm, FullName);
  if ((J <= 0) or (I < J)) and (I > 0) and (I + Length(NSDlm) <= Length(FullName)) then
    Result := Copy(FullName, 1, I - 1)
  else
    Result := '';
end;

function FormatMyIdent(const Value: QEString; Version: Variant): QEString;
var
  Len: Integer;
begin
  Len := Length(Value);
  if (Value = '') or (Version < 32306) or ((Len > 1) and
    (Value[1] = '`') and (Value[Len] = '`')) then
    Result := Value
  else begin
    SetLength(Result, Len+2);
    Result := '`' + Value + '`';
  end;
end;

function FormatPgIdent(const FullName: QEString; DelCatalogNameSpace: Boolean =
    False): QEString;
var
  NS, Nm: QEString;
begin
  NS := Get_NameSpace(FullName);
  Nm := Get_Name(FullName);
  if DelCatalogNameSpace and (AnsiCompareText(NS, 'pg_catalog') = 0) then
    NS := '';
  {if (Nm <> '') and (Nm[1] in ['a'..'z', 'A'..'Z', '_', '0'..'9']) then
    Nm := '"' + Nm + '"';}
  if (Nm <> '') and (Nm[1] <> '"') then
    Nm := '"' + Nm + '"';
  if NS <> '' then
    if NS[1] <> '"' then
      Result := Format('"%s"' + _NSDlm + '%s', [NS, Nm])
    else
      Result := NS + _NSDlm + Nm
  else
    Result := Nm;
end;

function QExportFieldTypeToPg(FieldType: TFieldType; Size: Integer): QEString;
begin
  case FieldType of
    ftSmallint: Result := 'SMALLINT';
    ftInteger, ftWord, ftAutoInc, ftReference: Result := 'INTEGER';
    ftLargeint: Result := 'BIGINT';
    ftBoolean: Result := 'BOOLEAN';
    ftFloat: Result := 'DOUBLE PRECISION';
    //ftCurrency, ftBCD, ftFMTBcd: Result := 'MONEY'; // depricated and has low scale
    ftCurrency, ftBCD{$IFDEF VCL6}, ftFMTBcd{$ENDIF}: Result := 'NUMERIC(20,4)';
    ftDate: Result := 'DATE';
    ftTime: Result := 'TIME';
    ftDateTime{$IFDEF VCL6}, ftTimeStamp{$ENDIF}: Result := 'TIMESTAMP';
    ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftBytes, ftVarBytes,
    ftBlob, ftArray, ftOraBlob, ftDataSet:
      Result := 'BYTEA';
    ftWideString, ftMemo, ftFmtMemo, ftGraphic, ftADT, ftOraClob, ftVariant,
    ftInterface, ftIDispatch, ftGuid:
      Result := 'TEXT';
  else
    if (Size > 0) and (Size < 255) then
      Result := Format('VARCHAR(%d)', [Size])
    else
      Result := 'TEXT';
  end;
  Assert(Result <> '');
end;

function QExportFieldTypeToMy(FieldType: TFieldType; Size: Integer): QEString;
begin
  case FieldType of
    ftInteger, ftWord, ftAutoInc:
      Result := 'INTEGER';
    ftSmallint:
      Result := 'SMALLINT';
    ftLargeint:
      Result := 'BIGINT';
    ftFloat:
      Result := 'DOUBLE';
    ftBoolean:
      Result := 'BOOLEAN';
    ftCurrency, ftBCD{$IFDEF VCL6}, ftFMTBcd{$ENDIF}:
      Result := 'FLOAT(15,2)';
    ftDate:
      Result := 'DATE';
    ftTime:
      Result := 'TIME';
    ftDateTime{$IFDEF VCL6}, ftTimeStamp{$ENDIF}:
      Result := 'DATETIME';
    ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle, ftOraBlob, ftOraClob, ftVariant:
      Result := 'LONGBLOB';
    else
    if (Size > 0) and (Size < 2048) then
        Result := Format('VARCHAR(%d)', [Size])
      else
        Result := 'TEXT';
  end;
end;

function QExportFieldTypeToMS(FieldType: TFieldType; Size: Integer): QEString;
begin
  case FieldType of
    ftBoolean:
      Result := 'CHAR(1)';
    ftInteger, ftWord, ftAutoInc:
      Result := 'INT';
    ftSmallint:
      Result := 'SMALLINT';
    ftLargeInt:
      Result := 'BIGINT';
    ftFloat:
      Result := 'FLOAT';
    ftCurrency, ftBCD{$IFDEF VCL6}, ftFMTBcd{$ENDIF}:
      Result := 'NUMERIC(15,2)';
    ftDate, ftTime{$IFDEF VCL6}, ftDateTime{$ENDIF}:
      Result := 'DATETIME';
    ftOraClob, ftMemo, ftFmtMemo:
      Result := 'TEXT';
    ftOraBlob, ftBlob, ftGraphic:
      Result := 'IMAGE';
    ftGuid:
      Result := Format('NCHAR(%d)', [Size]);
    ftWideString:
      begin
        if Size <= 8000 then
          Result := Format('NVARCHAR(%d)', [Size])
        else
          Result := 'NTEXT';
      end;
    ftBytes:
      Result := Format('BINARY(%d)', [Size]);
    ftVarBytes:
      Result := Format('VARBINARY(%d)', [Size]);
    {$IFDEF VCL6}ftTimeStamp:
      Result := 'TIMESTAMP';{$ENDIF}
    ftVariant:
      Result := 'SQL_VARIANT';
    else
    if (Size > 0) and (Size < 255) then
        Result := Format('VARCHAR(%d)', [Size])
      else
        Result := 'TEXT';
  end;
end;

function QExportFieldTypeToIB(FieldType: TFieldType; Size: Integer; SQLDialect: Integer): QEString;
begin
  case FieldType of
    ftBoolean:
      Result := 'BOOLEAN';
    ftLargeInt, ftInteger,
    ftWord, ftAutoInc:
      Result := 'INTEGER';
    ftSmallint:
      Result := 'SMALLINT';
    ftFloat:
      Result := 'DOUBLE PRECISION';
    ftCurrency, ftBCD{$IFDEF VCL6}, ftFMTBcd{$ENDIF}:
      Result := 'NUMERIC (15,2)';
    ftDate:
      Result := 'DATE';
    ftTime:
      if SQLDialect = 3 then
        Result := 'TIME'
      else
        Result := 'DATE';
    ftDateTime:
      if SQLDialect = 3 then
        Result := 'TIMESTAMP'
      else
        Result := 'DATE';
    ftBlob, ftMemo, ftGraphic, ftFmtMemo, ftParadoxOle, ftDBaseOle,
    ftOraBlob, ftOraClob, ftBytes, ftVarBytes, ftVariant:
      Result := 'BLOB';
  else
    if (Size > 0) and (Size < 255) then
      Result := Format('VARCHAR(%d)', [Size])
    else
      Result := 'BLOB';
  end;
end;

function QExportFieldTypeToOra(FieldType: TFieldType; Size: Integer): QEString;
begin
  case FieldType of
    ftWideString: Result := 'NVARCHAR2(' + IntToStr(Size) + ')';
    ftSmallint, ftInteger, ftWord, ftAutoInc, ftLargeint, ftFloat, ftCurrency,
    ftBCD{$IFDEF VCL6}, ftFMTBcd{$ENDIF}: Result := 'NUMBER';
    ftBoolean: Result := 'CHAR(1)';
    ftDate: Result := 'DATE';
    ftTime, ftDateTime{$IFDEF VCL6}, ftTimeStamp{$ENDIF}: Result := 'TIMESTAMP';
    ftParadoxOle, ftArray, ftOraBlob, ftOraClob, ftDBaseOle, ftGraphic,
    ftBytes, ftVarBytes, ftBlob, ftTypedBinary, ftFmtMemo: Result := 'BLOB';
    ftMemo, ftVariant: Result := 'CLOB';
  else
    if (Size > 0) and (Size < 255) then
      Result := Format('VARCHAR(%d)', [Size])
    else
      Result := 'BLOB';
  end;
end;

function QExportFieldTypeToDB2(FieldType: TFieldType; Size: Integer): QEString;
begin
  case FieldType of
    ftSmallint: Result := 'SMALLINT';
    ftInteger, ftWord, ftAutoInc: Result := 'INTEGER';
    ftBoolean: Result := 'BOOLEAN';
    ftFloat: Result := 'FLOAT'; {DOUBLE}
    ftCurrency, ftBCD{$IFDEF VCL6}, ftFMTBcd{$ENDIF}: Result := 'NUMERIC(24,4)';    // cr3884
    ftDate: Result := 'DATE';
    ftTime: Result := 'TIME';
    ftDateTime{$IFDEF VCL6}, ftTimeStamp{$ENDIF}: Result := 'TIMESTAMP';
    ftParadoxOle, ftArray, ftOraBlob, ftOraClob, ftDBaseOle, ftGraphic,
    ftBytes, ftVarBytes, ftBlob, ftTypedBinary, ftFmtMemo: Result := 'BLOB';
    ftMemo, ftVariant: Result := 'CLOB';
    ftLargeint: Result := 'BIGINT';