qexport4sql.pas

delphi中把数据输出为html excel等形式的控件

  end;
end;

{ TQExport4SQL }

constructor TQExport4SQL.Create(AOwner: TComponent);
begin
  inherited;
  FCommitRecCount := 0;
  FCommitAfterScript := False;
  FCommitStatement := S_Commit;
  FCreateTable := False;
  FIdentityInsert := False;
  FStatementTerm := ';';
  Formats.NullString := S_NULL_STRING;
  Formats.ThousandSeparator := #0;
  Formats.DecimalSeparator := '.';
  FCustomScriptType := qstAnsi;
  FOpenTran := False;
end;

procedure TQExport4SQL.BeginExport;
var
  i: Integer;
  str: QEString;
begin
  inherited;
  {$IFDEF QE_UNICODE}
  GetWriter.WriteSignature;
  {$ENDIF}
  for i := 0 to Header.Count - 1 do
    GetWriter.WriteLn(Header[i]);

  if (FCustomScriptType in [qstPg, qstMS]) and FCommitAfterScript then
  begin
    GetWriter.WriteLn(GetStartTranStatementIfNeed);
    GetWriter.EmptyLine;
  end;

  if FCreateTable then
    if Assigned(FOnGetTableDefinition) then
    begin
      FOnGetTableDefinition(Self, str);
      GetWriter.WriteLn(str);
      GetWriter.EmptyLine;
    end else
    if FTableName <> EmptyStr then
    begin
      GetWriter.WriteLn(Format(S_CreateTable + '(', [FormatIdent(FTableName)]));
      str := EmptyStr;
      for i := 0 to Columns.Count - 1 do
      begin
        str := str + Format('  %s  %s', [FormatIdent(Columns[i].Name), ColumnToIdentString(Columns[i])]);
        str := str + ',' + CRLF;
      end;
      Delete(str, Length(str) - 2, 3);
      str := str + ');' + CRLF;
      GetWriter.WriteLn(str);
      if FCustomScriptType = qstIB then
        GetWriter.WriteLn(GetCommitStatement);
    end;

  if FIdentityInsert and (FTableName <> EmptyStr) and (FCustomScriptType = qstMS) then
  begin
    GetWriter.WriteLn(Format(S_IdentityInsertOn + GetScriptTerminator,
      [FormatIdent(FTableName)]));
    GetWriter.EmptyLine;
  end;
      
  //**************
  FColumnString := EmptyStr;
  for i := 0 to Columns.Count - 1 do
    FColumnString := FColumnString + FormatIdent(Columns[i].Name) + ',';

  if FColumnString[Length(FColumnString)] = ',' then
    Delete(FColumnString, Length(FColumnString), 1);
end;

procedure TQExport4SQL.EndExport;
var
  i: Integer;
begin
  if FIdentityInsert and (FTableName <> EmptyStr) and (FCustomScriptType = qstMS) then
  begin
    GetWriter.WriteLn(Format(S_IdentityInsertOff + GetScriptTerminator,
      [FormatIdent(FTableName)]));
    GetWriter.EmptyLine;
  end;
    
  if FCommitAfterScript and (CommitStatement <> EmptyStr) then
    GetWriter.WriteLn(CommitStatement);
    
  if FOpenTran then
    GetWriter.WriteLn(CommitStatement);

  for i := 0 to Footer.Count - 1 do
    GetWriter.WriteLn(Footer[i]);
  inherited;
end;

function TQExport4SQL.GetColData(ColValue: QEString;
  Column: TQExportColumn): QEString;
var
  Index, p: Integer;
const
  _null = 'null';
begin
  Index := Column.Index;
  if Columns.GetColumnIsNull(Index) then
  begin
    case FCustomScriptType of
      qstDB2, qstIB,
      qstMS, qstMy,
      qstOra, qstPg:
        Result := _null;
    else
      Result := Formats.NullString;
    end;
  end else
  begin
    Result := inherited GetColData(ColValue, Column);
    case Column.ColType of
      ectString, ectUnknown:
        if FCustomScriptType = qstDB2 then
        begin
          if Column.IsBlob or Column.IsMemo or
            (Column.FieldType in [ftParadoxOle, ftArray, ftOraBlob, ftOraClob, ftWideString,
            ftDBaseOle, ftGraphic, ftBytes, ftVarBytes, ftBlob, ftTypedBinary, ftFmtMemo]) then
              Result := 'CAST(' + QEQuotedStr(Result, '''') + ' AS BLOB)'
          else
            Result := QEQuotedStr(Result, '''');
        end else
        if FCustomScriptType = qstORA then
        begin
          if Column.IsBlob or Column.IsMemo or
            (Column.FieldType in [ftParadoxOle, ftArray, ftOraBlob, ftOraClob,
            ftDBaseOle, ftGraphic, ftBytes, ftVarBytes, ftBlob, ftTypedBinary, ftFmtMemo]) or
            ((Column.FieldType = ftWideString) and (Column.Length > 2000)) then
              Result := 'RAWTOHEX(' + QEQuotedStr(Result, '''') + ')'
          else
            Result := QEQuotedStr(Result, '''');
        end else
          Result := QEQuotedStr(Result, '''');

      ectDate,
      ectTime,
      ectDateTime:
      begin
        case FCustomScriptType of
          qstMy, qstMS, qstDB2:
            Result := QEQuotedStr(FormatDateTime('yyyy-mm-dd hh:mm:ss', Columns.GetColumnData(Index)), '''');
          qstORA:
            Result := 'TO_DATE(' + QEQuotedStr(FormatDateTime('dd.mm.yyyy hh:mm:ss', Columns.GetColumnData(Index)), '''') +
              ',' + QEQuotedStr('dd.mm.yyyy hh24:mi:ss', '''') + ')';
          qstPg:
            Result := QEQuotedStr(FormatDateTime('yyyy.mm.dd hh:mm:ss', Columns.GetColumnData(Index)), '''');
        else
          Result := QEQuotedStr(Result, '''');
        end;
      end;
      ectBoolean:
        if (AnsiCompareText(STextTrue, Trim(inherited GetColData(ColValue, Column))) = 0) or
           (AnsiCompareText(Formats.BooleanTrue, Trim(inherited GetColData(ColValue, Column))) = 0)
          then Result := Formats.BooleanTrue
          else Result := Formats.BooleanFalse;

      ectFloat,
      ectCurrency,
      ectInteger,
      ectBigint: begin
        p := Pos(Formats.ThousandSeparator, Result);
        while p > 0 do
        begin
          Delete(Result, p, 1);
          p := Pos(Formats.ThousandSeparator, Result);
        end;
//        if SysUtils.DecimalSeparator <> '.' then
        if Formats.DecimalSeparator <> '.' then
        begin
          p := Pos(Formats.DecimalSeparator, Result);
          while p > 0 do
          begin
            Delete(Result, p, 1);
            Insert('.', Result, p);
            p := Pos(Formats.DecimalSeparator, Result);
          end;
        end;  
      end;
    end;
  end;
  Result := Result + ',';
end;

function TQExport4SQL.GetDataRow: QEString;
begin
  Result := Format(S_Insert + CRLF + '  (%s)' + CRLF + S_Values,
    [FormatIdent(FTableName), FColumnString]);
  Result := Result + '(' + inherited GetDataRow;
  Delete(Result, Length(Result), 1);
  if FCustomScriptType = qstAnsi then
    Result := Result + ')' + FStatementTerm
  else
    Result := Result + ')' + GetScriptTerminator;
end;

procedure TQExport4SQL.WriteDataRow;
begin
  GetWriter.WriteLn(GetDataRow);
  GetWriter.EmptyLine;
  if (FCommitRecCount > 0) and (RecordCounter mod FCommitRecCount = 0) and
     (CommitStatement <> EmptyStr)  then
  begin
    GetWriter.WriteLn(CommitStatement);
    GetWriter.EmptyLine;
  end;

  if (FCustomScriptType in [qstPg, qstMS]) and FCommitAfterScript and (not FOpenTran) then
  begin
    GetWriter.WriteLn(GetStartTranStatementIfNeed);
    GetWriter.EmptyLine;
  end;
end;

function TQExport4SQL.GetNullValue: QEString;
begin
  Result := Formats.NullString;
end;

procedure TQExport4SQL.SetNullValue(const Value: QEString);
begin
  if Formats.NullString <> Value then
    Formats.NullString := Value;
end;

function TQExport4SQL.GetFormatValues: Boolean;
begin
  Result := Formats.KeepOriginalFormat;
end;

procedure TQExport4SQL.SetFormatValues(const Value: Boolean);
begin
  Formats.KeepOriginalFormat := Value;
end;

function TQExport4SQL.FormatIdent(const Ident: QEString): QEString;
var
  LeftQuote, RightQuote: QEChar;
begin
  LeftQuote := '"';
  RightQuote := '"';
  case FCustomScriptType of
    qstDB2, qstOra, qstIB:
      Result := QuoteIdent(Ident, LeftQuote, RightQuote);
    qstMS:
    begin
      LeftQuote := '[';
      RightQuote := ']';
      Result := QuoteIdent(Ident, LeftQuote, RightQuote);
    end;
    qstMy:
      Result := FormatMyIdent(Ident, GetDefaultVersion);
    qstPg:
      Result := FormatPgIdent(Ident);
  else
    Result := QuoteIdent(Ident, LeftQuote, RightQuote);
  end
end;

function TQExport4SQL.GetDefaultVersion: Variant;
begin
  case FCustomScriptType of
    qstDB2: Result := 8020000;
    qstIB: Result := 2.0;
    qstMS: Result := 9;
    qstMy: Result := 50018;
    qstOra: Result := 9;
    qstPg: Result := 80100;
  else
    Result := 0;
  end;
end;

function TQExport4SQL.ColumnToIdentString(Column: TQExportColumn): QEString;

  function GetFieldType: TFieldType;
  begin
    if Self.ExportSource in [esCustom, esListView, esStringGrid] then
    begin
      case Column.ColType of
        ectString:
        begin
          if Column.IsBlob then
            Result := ftBlob
          else
          if Column.IsMemo then
            Result := ftMemo
          else
            Result := ftString;
        end;
        ectInteger:
          Result := ftInteger;
        {$IFNDEF VCL3}
        ectBigint:
          Result := ftLargeInt;{$ENDIF}
        ectBoolean:
          Result :=  ftBoolean;
        ectFloat:
          Result := ftFloat;
        ectCurrency:
          Result := ftCurrency;
        ectDate:
          Result := ftDate;
        ectTime:
          Result := ftTime;
        ectDateTime:
          Result := ftDateTime;
      else
        Result := ftUnknown;
      end;
    end else //if esDataSet or esDBGrid
      Result := Column.FieldType;
  end;

begin
  case FCustomScriptType of
    qstDB2:
      Result := QExportFieldTypeToDB2(GetFieldType, Column.Length);
    qstIB:
      Result := QExportFieldTypeToIB(GetFieldType, Column.Length, 3);
    qstMS:
      Result := QExportFieldTypeToMS(GetFieldType, Column.Length);
    qstMy:
      Result := QExportFieldTypeToMy(GetFieldType, Column.Length);
    qstOra:
      Result := QExportFieldTypeToOra(GetFieldType, Column.Length);
    qstPg:
      Result := QExportFieldTypeToPg(GetFieldType, Column.Length);
  else
    Result := '';
  end;
end;

function TQExport4SQL.GetScriptTerminator: string;
begin
  if FCustomScriptType = qstMS then
    Result := LF + 'GO'
  else
    Result := ';';
end;

function TQExport4SQL.GetCommitStatement: QEString;
begin
  if FCustomScriptType in [qstIB, qstOra] then
    Result := 'COMMIT WORK'
  else
  if FCustomScriptType <> qstAnsi then
    Result := 'COMMIT'
  else
    Result := FCommitStatement;

  if Result[Length(Result)] <> GetScriptTerminator then
    Result := Result + GetScriptTerminator;

  FOpenTran := False;
end;

function TQExport4SQL.GetStartTranStatementIfNeed: QEString;
begin
  if FCustomScriptType = qstMS then
    Result := 'BEGIN TRANSACTION'
  else if FCustomScriptType = qstPg then
    Result := 'BEGIN'
  else
    Result := '';
  if Result <> '' then
     Result := Result + GetScriptTerminator;

  FOpenTran := True;
end;

end.