tpsystools_4.04/source/StExport.pas

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StExport.pas 4.04                           *}
{*********************************************************}
{* SysTools: DB Exporter Classes                         *}
{*********************************************************}

{$include StDefine.inc}

unit StExport;

interface

uses
  Windows, SysUtils, Classes, DB, DbConsts,
  StBase, StStrms, StTxtDat;

const
  DefaultDateFmt : AnsiString = 'mm/dd/yyyy';
  DefaultTimeFmt : AnsiString = 'hh:mm:ss';
  DefaultDateTimeFmt : AnsiString = 'mm/dd/yyyy hh:mm:ss';

type
  TStExportProgressEvent = procedure (Sender : TObject; Index : Integer;
    var Abort : Boolean) of object;

  TStDBtoCSVExport = class
  private
    FDataSet: TDataSet;
    FFieldDelimiter: AnsiChar;
    FIncludeHeader: Boolean;
    FLineTermChar : AnsiChar;
    FLineTerminator : TStLineTerminator;
    FQuoteAlways: Boolean;
    FQuoteDelimiter: AnsiChar;
    FQuoteIfSpaces: Boolean;

    FDateFmt, FTimeFmt, FDateTimeFmt : AnsiString;

    FOnExportProgress : TStExportProgressEvent;
    FOnQuoteField : TStOnQuoteFieldEvent;
  protected {private}
    function BuildCSVHeader: AnsiString;
    function BuildCSVRec : AnsiString;

    procedure SetDataSet(const Value: TDataSet);
    procedure SetFieldDelimiter(const Value: AnsiChar);
    procedure SetIncludeHeader(const Value: Boolean);
    procedure SetQuoteAlways(const Value: Boolean);
    procedure SetQuoteDelimiter(const Value: AnsiChar);
    procedure SetQuoteIfSpaces(const Value: Boolean);
  public
    constructor Create;

    { Access and Update Methods }
    procedure DoQuote(var Value: String); virtual;

    { Persistence and streaming methods }
    procedure ExportToStream(AStream : TStream);
    procedure ExportToFile(AFile : TFileName);

    { properties }
    property DataSet : TDataSet read FDataSet write SetDataSet;
    property FieldDelimiter : AnsiChar
      read FFieldDelimiter write SetFieldDelimiter default StDefaultDelim;
    property IncludeHeader : Boolean
      read FIncludeHeader write SetIncludeHeader default False;
    property LineTermChar : AnsiChar
      read FLineTermChar write FLineTermChar default #0;
    property LineTerminator : TStLineTerminator
      read FLineTerminator write FLineTerminator default ltCRLF;
    property QuoteAlways : Boolean
      read FQuoteAlways write SetQuoteAlways default False;
    property QuoteDelimiter : AnsiChar
      read FQuoteDelimiter write SetQuoteDelimiter default StDefaultQuote;
    property QuoteIfSpaces : Boolean
      read FQuoteIfSpaces write SetQuoteIfSpaces default False;

    property DateFmt : AnsiString
      read FDateFmt write FDateFmt;
    property TimeFmt : AnsiString
      read FTimeFmt write FTimeFmt;
    property DateTimeFmt : AnsiString
      read FDateTimeFmt write FDateTimeFmt;
    { events }
    property OnQuoteField : TStOnQuoteFieldEvent
      read FOnQuoteField write FOnQuoteField;
    property OnExportProgress : TStExportProgressEvent
      read FOnExportProgress write FOnExportProgress;
  end;


  TStDbSchemaGenerator = class
  private
    FDataSet : TDataSet;
    FSchema : TStTextDataSchema;
  protected {private}
    function GetFieldDelimiter: Char;
    function GetQuoteDelimiter: Char;
    function GetSchemaName: AnsiString;
    procedure SetDataSet(const Value: TDataSet);
    procedure SetFieldDelimiter(const Value: Char);
    procedure SetQuoteDelimiter(const Value: Char);
    procedure SetSchemaName(const Value: AnsiString);
  public
    constructor Create;
    destructor Destroy; override;

    { Persistence and streaming methods }
    procedure ExportToStream(AStream : TStream);
    procedure ExportToFile(AFile : TFileName);

    { properties }
    property DataSet : TDataSet
      read FDataSet write SetDataSet;
    property FieldDelimiter : Char
      read GetFieldDelimiter write SetFieldDelimiter default StDefaultDelim;
    property QuoteDelimiter : Char
      read GetQuoteDelimiter write SetQuoteDelimiter default StDefaultQuote;
    property SchemaName : AnsiString
      read GetSchemaName write SetSchemaName;
  end;

implementation
{
  TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
    ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
    ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
    ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,
    ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob,
    ftVariant, ftInterface, ftIDispatch, ftGuid);
}
const
{ see DB unit for full set of field types }
  DBValidFields = [ftString, ftSmallInt, ftInteger, ftAutoInc, ftWord, ftBoolean,
                   ftFloat,  ftCurrency, ftBCD, ftDate, ftTime, ftDateTime];
  DBFloatFields = [ftFloat, ftCurrency, ftBCD];

{ TStDBtoCSVExport }

constructor TStDBtoCSVExport.Create;
begin
  inherited Create;
  FFieldDelimiter := StDefaultDelim;
  FQuoteDelimiter := StDefaultQuote;
  FLineTermChar := #0;
  FLineTerminator := ltCRLF;
  FQuoteAlways := False;
  FQuoteIfSpaces := False;

  FDateFmt := DefaultDateFmt;
  FTimeFmt := DefaultTimeFmt;
  FDateTimeFmt := DefaultDateTimeFmt;
end;

function TStDBtoCSVExport.BuildCSVHeader: AnsiString;
{ generate CSV header from Data Set field data }
var
  i : Integer;
  Name : AnsiString;
  TheField : TField;
begin
  Result := '';
  for i := 0 to Pred(FDataSet.FieldCount) do begin
    TheField := FDataSet.Fields[i];

    { is field is among supported types? }
    if (TheField.FieldKind = fkData) and
      (TheField.DataType in DBValidFields) then begin
      { get name of current field }
      Name := TheField.FieldName;

      if i = 0 then { no field delimiter before first field }
        Result := Result + Name
      else
        Result := Result + FFieldDelimiter + Name;
    end;
  end;
end;

function TStDBtoCSVExport.BuildCSVRec: AnsiString;
{ generate record of CSV data from Data Set field data }
var
  i : Integer;
  FieldStr : String;
  TheField : TField;
begin
  Result := '';
  for i := 0 to Pred(FDataSet.FieldCount) do begin
    TheField := FDataSet.Fields[i];

    { is field is among supported types? }
    if (TheField.FieldKind = fkData) and
      (TheField.DataType in DBValidFields) then
    begin
      { get value of current field as a string }
      case TheField.DataType of
        ftDate : FieldStr := FormatDateTime(FDateFmt, TheField.AsDateTime);
        ftTime : FieldStr := FormatDateTime(FTimeFmt, TheField.AsDateTime);
        ftDateTime : FieldStr := FormatDateTime(FDateTimeFmt, TheField.AsDateTime);
        else
          FieldStr := TheField.AsString;
      end;


      { quote if needed }
      DoQuote(FieldStr);

      if i = 0 then { no field delimiter before first field }
        Result := Result + FieldStr
      else
        Result := Result + FFieldDelimiter + FieldStr;
    end;
  end;
end;

procedure TStDBtoCSVExport.DoQuote(var Value : String);
{ quote field string if needed or desired }
var
  QuoteIt : Boolean;
begin
  { fire event if available }
  if Assigned(FOnQuoteField) then begin
    FOnQuoteField(self, Value);
  end
  else begin { use default quoting policy }
    QuoteIt := False;
    if FQuoteAlways then
      QuoteIt := True
    else
    if ((Pos(' ', Value) > 0) and FQuoteIfSpaces)
       or (Pos(FFieldDelimiter, Value) > 0)
       or (Pos(FQuoteDelimiter, Value) > 0)
    then
      QuoteIt := True;

    if QuoteIt then
      Value := FQuoteDelimiter + Value + FQuoteDelimiter;
  end;
end;

procedure TStDBtoCSVExport.ExportToFile(AFile: TFileName);
var
  FS : TFileStream;
begin
  FS := TFileStream.Create(AFile, fmCreate);
  try
    ExportToStream(FS);
  finally
    FS.Free;
  end;
end;

procedure TStDBtoCSVExport.ExportToStream(AStream: TStream);
var
  TS : TStAnsiTextStream;
  Abort : Boolean;
  Count : LongInt;
begin
  { table must be open and active }
  if not FDataSet.Active then
    {$IFDEF VERSION4}
    DatabaseError(SDataSetClosed, FDataSet);
    {$ELSE}
    DatabaseError(SDataSetClosed);
    {$ENDIF VERSION4}

  TS := TStAnsiTextStream.Create(AStream);
  TS.LineTerminator := FLineTerminator;
  TS.LineTermChar   := FLineTermChar;
  try
    { generate header line if desired }
    if FIncludeHeader then
      TS.WriteLine(BuildCSVHeader);

    { iterate table }
    FDataSet.First;
    Count := 0;
    Abort := False;
    while not FDataSet.Eof and not Abort do begin
      { write CSV formatted data for current record }
      TS.WriteLine(BuildCSVRec);
      Inc(Count);

      if Assigned(FOnExportProgress) then
        FOnExportProgress(self, Count, Abort);

      { next record }
      FDataSet.Next;
    end;
  finally
    TS.Free;
  end;
end;

procedure TStDBtoCSVExport.SetDataSet(const Value: TDataSet);
begin
  FDataSet := Value;
end;

procedure TStDBtoCSVExport.SetFieldDelimiter(const Value: AnsiChar);
begin
  FFieldDelimiter := Value;
end;

procedure TStDBtoCSVExport.SetIncludeHeader(const Value: Boolean);
begin
  FIncludeHeader := Value;
end;

procedure TStDBtoCSVExport.SetQuoteAlways(const Value: Boolean);
begin
  FQuoteAlways := Value;
end;

procedure TStDBtoCSVExport.SetQuoteIfSpaces(const Value: Boolean);
begin
  FQuoteIfSpaces := Value;
end;

procedure TStDBtoCSVExport.SetQuoteDelimiter(const Value: AnsiChar);
begin
  FQuoteDelimiter := Value;
end;

{
TStSchemaFieldType = (sftUnknown, sftChar, sftFloat, sftNumber,
 sftBool, sftLongInt, sftDate, sftTime, sftTimeStamp);
}

function ConvertFieldType(DBFieldType : TFieldType) : TStSchemaFieldType;
{ convert table field type to schema field type }
begin
  case DBFieldType of
    ftString   : Result := sftChar;

    ftSmallInt : Result := sftNumber;
    ftInteger  : Result := sftLongInt;
    ftAutoInc  : Result := sftLongInt;
    ftWord     : Result := sftNumber;

    ftBoolean  : Result := sftBool;

    ftFloat    : Result := sftFloat;
    ftCurrency : Result := sftFloat;
    ftBCD      : Result := sftFloat;

    ftDate     : Result := sftDate;
    ftTime     : Result := sftTime;
    ftDateTime : Result := sftTimeStamp;

    else
      Result := sftUnknown;
  end;
end;

function GetDecimals(const DataStr : AnsiString): Integer;
{ determine decimal places for float formatted string }
begin
  Result := Length(DataStr) - Pos({$IFDEF DELPHIXE2}FormatSettings.{$ENDIF}DecimalSeparator, DataStr);
  try
    StrToFloat(DataStr);
  except
    Result := 0;
  end;
end;


{ TStDbSchemaGenerator }

constructor TStDbSchemaGenerator.Create;
begin
  inherited Create;

  FSchema := TStTextDataSchema.Create;
  { set defaults for compatible schema }
  FSchema.LayoutType := ltVarying;
  FSchema.FieldDelimiter := StDefaultDelim;
  FSchema.QuoteDelimiter := StDefaultQuote;
  FSchema.CommentDelimiter := StDefaultComment;
end;

destructor TStDbSchemaGenerator.Destroy;
begin
  FSchema.Free;
  inherited Destroy;
end;

procedure TStDbSchemaGenerator.ExportToFile(AFile: TFileName);
var
  FS : TFileStream;
begin
  FS := TFileStream.Create(AFile, fmCreate);
  try
    ExportToStream(FS);
  finally
    FS.Free;
  end;
end;

procedure TStDbSchemaGenerator.ExportToStream(AStream: TStream);
var
  i, Width, Decimals : Integer;
  TheField : TField;
begin
  { table must be open and active }

  if not FDataSet.Active then
    {$IFDEF VERSION4}
    DatabaseError(SDataSetClosed, FDataSet);
    {$ELSE}
    DatabaseError(SDataSetClosed);
    {$ENDIF VERSION4}

  { build field definitions }
  for i := 0 to Pred(FDataSet.FieldCount) do begin
    TheField := FDataSet.Fields[i];

    { is field is among supported types? }
    if (TheField.FieldKind = fkData) and
       (TheField.DataType in DBValidFields) then
    begin
      Width := TheField.DisplayWidth;

      { if it's a floating point type field, need decimals }
      if (FDataSet.Fields[i].DataType in DBFloatFields) then
        Decimals := GetDecimals(TheField.AsString)
      else
        Decimals := 0;

      { add field definition to Schema }
      FSchema.AddField(TheField.FieldName,
        ConvertFieldType(TheField.DataType), Width, Decimals);

    end;
  end;

  { save the schema }
  FSchema.SaveToStream(AStream);
end;

function TStDbSchemaGenerator.GetFieldDelimiter: Char;
begin
  Result := FSchema.FieldDelimiter;
end;

function TStDbSchemaGenerator.GetQuoteDelimiter: Char;
begin
  Result := FSchema.QuoteDelimiter;
end;

function TStDbSchemaGenerator.GetSchemaName: AnsiString;
begin
  Result := FSchema.SchemaName;
end;

procedure TStDbSchemaGenerator.SetDataSet(const Value: TDataSet);
begin
  FDataSet := Value;
end;

procedure TStDbSchemaGenerator.SetFieldDelimiter(const Value: Char);
begin
  FSchema.FieldDelimiter := Value;
end;

procedure TStDbSchemaGenerator.SetQuoteDelimiter(const Value: Char);
begin
  FSchema.QuoteDelimiter := Value;
end;

procedure TStDbSchemaGenerator.SetSchemaName(const Value: AnsiString);
begin
  FSchema.SchemaName:= Value;
end;

end.
1	torben	2671	(* *** BEGIN LICENSE BLOCK ***
2			* Version: MPL 1.1
3			*
4			* The contents of this file are subject to the Mozilla Public License Version
5			* 1.1 (the "License"); you may not use this file except in compliance with
6			* the License. You may obtain a copy of the License at
7			* http://www.mozilla.org/MPL/
8			*
9			* Software distributed under the License is distributed on an "AS IS" basis,
10			* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
11			* for the specific language governing rights and limitations under the
12			* License.
13			*
14			* The Original Code is TurboPower SysTools
15			*
16			* The Initial Developer of the Original Code is
17			* TurboPower Software
18			*
19			* Portions created by the Initial Developer are Copyright (C) 1996-2002
20			* the Initial Developer. All Rights Reserved.
21			*
22			* Contributor(s):
23			*
24			* *** END LICENSE BLOCK *** *)
25
26			{*********************************************************}
27			{* SysTools: StExport.pas 4.04 *}
28			{*********************************************************}
29			{* SysTools: DB Exporter Classes *}
30			{*********************************************************}
31
32			{$include StDefine.inc}
33
34			unit StExport;
35
36			interface
37
38			uses
39			Windows, SysUtils, Classes, DB, DbConsts,
40			StBase, StStrms, StTxtDat;
41
42			const
43			DefaultDateFmt : AnsiString = 'mm/dd/yyyy';
44			DefaultTimeFmt : AnsiString = 'hh:mm:ss';
45			DefaultDateTimeFmt : AnsiString = 'mm/dd/yyyy hh:mm:ss';
46
47			type
48			TStExportProgressEvent = procedure (Sender : TObject; Index : Integer;
49			var Abort : Boolean) of object;
50
51			TStDBtoCSVExport = class
52			private
53			FDataSet: TDataSet;
54			FFieldDelimiter: AnsiChar;
55			FIncludeHeader: Boolean;
56			FLineTermChar : AnsiChar;
57			FLineTerminator : TStLineTerminator;
58			FQuoteAlways: Boolean;
59			FQuoteDelimiter: AnsiChar;
60			FQuoteIfSpaces: Boolean;
61
62			FDateFmt, FTimeFmt, FDateTimeFmt : AnsiString;
63
64			FOnExportProgress : TStExportProgressEvent;
65			FOnQuoteField : TStOnQuoteFieldEvent;
66			protected {private}
67			function BuildCSVHeader: AnsiString;
68			function BuildCSVRec : AnsiString;
69
70			procedure SetDataSet(const Value: TDataSet);
71			procedure SetFieldDelimiter(const Value: AnsiChar);
72			procedure SetIncludeHeader(const Value: Boolean);
73			procedure SetQuoteAlways(const Value: Boolean);
74			procedure SetQuoteDelimiter(const Value: AnsiChar);
75			procedure SetQuoteIfSpaces(const Value: Boolean);
76			public
77			constructor Create;
78
79			{ Access and Update Methods }
80			procedure DoQuote(var Value: String); virtual;
81
82			{ Persistence and streaming methods }
83			procedure ExportToStream(AStream : TStream);
84			procedure ExportToFile(AFile : TFileName);
85
86			{ properties }
87			property DataSet : TDataSet read FDataSet write SetDataSet;
88			property FieldDelimiter : AnsiChar
89			read FFieldDelimiter write SetFieldDelimiter default StDefaultDelim;
90			property IncludeHeader : Boolean
91			read FIncludeHeader write SetIncludeHeader default False;
92			property LineTermChar : AnsiChar
93			read FLineTermChar write FLineTermChar default #0;
94			property LineTerminator : TStLineTerminator
95			read FLineTerminator write FLineTerminator default ltCRLF;
96			property QuoteAlways : Boolean
97			read FQuoteAlways write SetQuoteAlways default False;
98			property QuoteDelimiter : AnsiChar
99			read FQuoteDelimiter write SetQuoteDelimiter default StDefaultQuote;
100			property QuoteIfSpaces : Boolean
101			read FQuoteIfSpaces write SetQuoteIfSpaces default False;
102
103			property DateFmt : AnsiString
104			read FDateFmt write FDateFmt;
105			property TimeFmt : AnsiString
106			read FTimeFmt write FTimeFmt;
107			property DateTimeFmt : AnsiString
108			read FDateTimeFmt write FDateTimeFmt;
109			{ events }
110			property OnQuoteField : TStOnQuoteFieldEvent
111			read FOnQuoteField write FOnQuoteField;
112			property OnExportProgress : TStExportProgressEvent
113			read FOnExportProgress write FOnExportProgress;
114			end;
115
116
117			TStDbSchemaGenerator = class
118			private
119			FDataSet : TDataSet;
120			FSchema : TStTextDataSchema;
121			protected {private}
122			function GetFieldDelimiter: Char;
123			function GetQuoteDelimiter: Char;
124			function GetSchemaName: AnsiString;
125			procedure SetDataSet(const Value: TDataSet);
126			procedure SetFieldDelimiter(const Value: Char);
127			procedure SetQuoteDelimiter(const Value: Char);
128			procedure SetSchemaName(const Value: AnsiString);
129			public
130			constructor Create;
131			destructor Destroy; override;
132
133			{ Persistence and streaming methods }
134			procedure ExportToStream(AStream : TStream);
135			procedure ExportToFile(AFile : TFileName);
136
137			{ properties }
138			property DataSet : TDataSet
139			read FDataSet write SetDataSet;
140			property FieldDelimiter : Char
141			read GetFieldDelimiter write SetFieldDelimiter default StDefaultDelim;
142			property QuoteDelimiter : Char
143			read GetQuoteDelimiter write SetQuoteDelimiter default StDefaultQuote;
144			property SchemaName : AnsiString
145			read GetSchemaName write SetSchemaName;
146			end;
147
148			implementation
149			{
150			TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
151			ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,
152			ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,
153			ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,
154			ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob,
155			ftVariant, ftInterface, ftIDispatch, ftGuid);
156			}
157			const
158			{ see DB unit for full set of field types }
159			DBValidFields = [ftString, ftSmallInt, ftInteger, ftAutoInc, ftWord, ftBoolean,
160			ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime];
161			DBFloatFields = [ftFloat, ftCurrency, ftBCD];
162
163			{ TStDBtoCSVExport }
164
165			constructor TStDBtoCSVExport.Create;
166			begin
167			inherited Create;
168			FFieldDelimiter := StDefaultDelim;
169			FQuoteDelimiter := StDefaultQuote;
170			FLineTermChar := #0;
171			FLineTerminator := ltCRLF;
172			FQuoteAlways := False;
173			FQuoteIfSpaces := False;
174
175			FDateFmt := DefaultDateFmt;
176			FTimeFmt := DefaultTimeFmt;
177			FDateTimeFmt := DefaultDateTimeFmt;
178			end;
179
180			function TStDBtoCSVExport.BuildCSVHeader: AnsiString;
181			{ generate CSV header from Data Set field data }
182			var
183			i : Integer;
184			Name : AnsiString;
185			TheField : TField;
186			begin
187			Result := '';
188			for i := 0 to Pred(FDataSet.FieldCount) do begin
189			TheField := FDataSet.Fields[i];
190
191			{ is field is among supported types? }
192			if (TheField.FieldKind = fkData) and
193			(TheField.DataType in DBValidFields) then begin
194			{ get name of current field }
195			Name := TheField.FieldName;
196
197			if i = 0 then { no field delimiter before first field }
198			Result := Result + Name
199			else
200			Result := Result + FFieldDelimiter + Name;
201			end;
202			end;
203			end;
204
205			function TStDBtoCSVExport.BuildCSVRec: AnsiString;
206			{ generate record of CSV data from Data Set field data }
207			var
208			i : Integer;
209			FieldStr : String;
210			TheField : TField;
211			begin
212			Result := '';
213			for i := 0 to Pred(FDataSet.FieldCount) do begin
214			TheField := FDataSet.Fields[i];
215
216			{ is field is among supported types? }
217			if (TheField.FieldKind = fkData) and
218			(TheField.DataType in DBValidFields) then
219			begin
220			{ get value of current field as a string }
221			case TheField.DataType of
222			ftDate : FieldStr := FormatDateTime(FDateFmt, TheField.AsDateTime);
223			ftTime : FieldStr := FormatDateTime(FTimeFmt, TheField.AsDateTime);
224			ftDateTime : FieldStr := FormatDateTime(FDateTimeFmt, TheField.AsDateTime);
225			else
226			FieldStr := TheField.AsString;
227			end;
228
229
230			{ quote if needed }
231			DoQuote(FieldStr);
232
233			if i = 0 then { no field delimiter before first field }
234			Result := Result + FieldStr
235			else
236			Result := Result + FFieldDelimiter + FieldStr;
237			end;
238			end;
239			end;
240
241			procedure TStDBtoCSVExport.DoQuote(var Value : String);
242			{ quote field string if needed or desired }
243			var
244			QuoteIt : Boolean;
245			begin
246			{ fire event if available }
247			if Assigned(FOnQuoteField) then begin
248			FOnQuoteField(self, Value);
249			end
250			else begin { use default quoting policy }
251			QuoteIt := False;
252			if FQuoteAlways then
253			QuoteIt := True
254			else
255			if ((Pos(' ', Value) > 0) and FQuoteIfSpaces)
256			or (Pos(FFieldDelimiter, Value) > 0)
257			or (Pos(FQuoteDelimiter, Value) > 0)
258			then
259			QuoteIt := True;
260
261			if QuoteIt then
262			Value := FQuoteDelimiter + Value + FQuoteDelimiter;
263			end;
264			end;
265
266			procedure TStDBtoCSVExport.ExportToFile(AFile: TFileName);
267			var
268			FS : TFileStream;
269			begin
270			FS := TFileStream.Create(AFile, fmCreate);
271			try
272			ExportToStream(FS);
273			finally
274			FS.Free;
275			end;
276			end;
277
278			procedure TStDBtoCSVExport.ExportToStream(AStream: TStream);
279			var
280			TS : TStAnsiTextStream;
281			Abort : Boolean;
282			Count : LongInt;
283			begin
284			{ table must be open and active }
285			if not FDataSet.Active then
286			{$IFDEF VERSION4}
287			DatabaseError(SDataSetClosed, FDataSet);
288			{$ELSE}
289			DatabaseError(SDataSetClosed);
290			{$ENDIF VERSION4}
291
292			TS := TStAnsiTextStream.Create(AStream);
293			TS.LineTerminator := FLineTerminator;
294			TS.LineTermChar := FLineTermChar;
295			try
296			{ generate header line if desired }
297			if FIncludeHeader then
298			TS.WriteLine(BuildCSVHeader);
299
300			{ iterate table }
301			FDataSet.First;
302			Count := 0;
303			Abort := False;
304			while not FDataSet.Eof and not Abort do begin
305			{ write CSV formatted data for current record }
306			TS.WriteLine(BuildCSVRec);
307			Inc(Count);
308
309			if Assigned(FOnExportProgress) then
310			FOnExportProgress(self, Count, Abort);
311
312			{ next record }
313			FDataSet.Next;
314			end;
315			finally
316			TS.Free;
317			end;
318			end;
319
320			procedure TStDBtoCSVExport.SetDataSet(const Value: TDataSet);
321			begin
322			FDataSet := Value;
323			end;
324
325			procedure TStDBtoCSVExport.SetFieldDelimiter(const Value: AnsiChar);
326			begin
327			FFieldDelimiter := Value;
328			end;
329
330			procedure TStDBtoCSVExport.SetIncludeHeader(const Value: Boolean);
331			begin
332			FIncludeHeader := Value;
333			end;
334
335			procedure TStDBtoCSVExport.SetQuoteAlways(const Value: Boolean);
336			begin
337			FQuoteAlways := Value;
338			end;
339
340			procedure TStDBtoCSVExport.SetQuoteIfSpaces(const Value: Boolean);
341			begin
342			FQuoteIfSpaces := Value;
343			end;
344
345			procedure TStDBtoCSVExport.SetQuoteDelimiter(const Value: AnsiChar);
346			begin
347			FQuoteDelimiter := Value;
348			end;
349
350			{
351			TStSchemaFieldType = (sftUnknown, sftChar, sftFloat, sftNumber,
352			sftBool, sftLongInt, sftDate, sftTime, sftTimeStamp);
353			}
354
355			function ConvertFieldType(DBFieldType : TFieldType) : TStSchemaFieldType;
356			{ convert table field type to schema field type }
357			begin
358			case DBFieldType of
359			ftString : Result := sftChar;
360
361			ftSmallInt : Result := sftNumber;
362			ftInteger : Result := sftLongInt;
363			ftAutoInc : Result := sftLongInt;
364			ftWord : Result := sftNumber;
365
366			ftBoolean : Result := sftBool;
367
368			ftFloat : Result := sftFloat;
369			ftCurrency : Result := sftFloat;
370			ftBCD : Result := sftFloat;
371
372			ftDate : Result := sftDate;
373			ftTime : Result := sftTime;
374			ftDateTime : Result := sftTimeStamp;
375
376			else
377			Result := sftUnknown;
378			end;
379			end;
380
381			function GetDecimals(const DataStr : AnsiString): Integer;
382			{ determine decimal places for float formatted string }
383			begin
384			Result := Length(DataStr) - Pos({$IFDEF DELPHIXE2}FormatSettings.{$ENDIF}DecimalSeparator, DataStr);
385			try
386			StrToFloat(DataStr);
387			except
388			Result := 0;
389			end;
390			end;
391
392
393			{ TStDbSchemaGenerator }
394
395			constructor TStDbSchemaGenerator.Create;
396			begin
397			inherited Create;
398
399			FSchema := TStTextDataSchema.Create;
400			{ set defaults for compatible schema }
401			FSchema.LayoutType := ltVarying;
402			FSchema.FieldDelimiter := StDefaultDelim;
403			FSchema.QuoteDelimiter := StDefaultQuote;
404			FSchema.CommentDelimiter := StDefaultComment;
405			end;
406
407			destructor TStDbSchemaGenerator.Destroy;
408			begin
409			FSchema.Free;
410			inherited Destroy;
411			end;
412
413			procedure TStDbSchemaGenerator.ExportToFile(AFile: TFileName);
414			var
415			FS : TFileStream;
416			begin
417			FS := TFileStream.Create(AFile, fmCreate);
418			try
419			ExportToStream(FS);
420			finally
421			FS.Free;
422			end;
423			end;
424
425			procedure TStDbSchemaGenerator.ExportToStream(AStream: TStream);
426			var
427			i, Width, Decimals : Integer;
428			TheField : TField;
429			begin
430			{ table must be open and active }
431
432			if not FDataSet.Active then
433			{$IFDEF VERSION4}
434			DatabaseError(SDataSetClosed, FDataSet);
435			{$ELSE}
436			DatabaseError(SDataSetClosed);
437			{$ENDIF VERSION4}
438
439			{ build field definitions }
440			for i := 0 to Pred(FDataSet.FieldCount) do begin
441			TheField := FDataSet.Fields[i];
442
443			{ is field is among supported types? }
444			if (TheField.FieldKind = fkData) and
445			(TheField.DataType in DBValidFields) then
446			begin
447			Width := TheField.DisplayWidth;
448
449			{ if it's a floating point type field, need decimals }
450			if (FDataSet.Fields[i].DataType in DBFloatFields) then
451			Decimals := GetDecimals(TheField.AsString)
452			else
453			Decimals := 0;
454
455			{ add field definition to Schema }
456			FSchema.AddField(TheField.FieldName,
457			ConvertFieldType(TheField.DataType), Width, Decimals);
458
459			end;
460			end;
461
462			{ save the schema }
463			FSchema.SaveToStream(AStream);
464			end;
465
466			function TStDbSchemaGenerator.GetFieldDelimiter: Char;
467			begin
468			Result := FSchema.FieldDelimiter;
469			end;
470
471			function TStDbSchemaGenerator.GetQuoteDelimiter: Char;
472			begin
473			Result := FSchema.QuoteDelimiter;
474			end;
475
476			function TStDbSchemaGenerator.GetSchemaName: AnsiString;
477			begin
478			Result := FSchema.SchemaName;
479			end;
480
481			procedure TStDbSchemaGenerator.SetDataSet(const Value: TDataSet);
482			begin
483			FDataSet := Value;
484			end;
485
486			procedure TStDbSchemaGenerator.SetFieldDelimiter(const Value: Char);
487			begin
488			FSchema.FieldDelimiter := Value;
489			end;
490
491			procedure TStDbSchemaGenerator.SetQuoteDelimiter(const Value: Char);
492			begin
493			FSchema.QuoteDelimiter := Value;
494			end;
495
496			procedure TStDbSchemaGenerator.SetSchemaName(const Value: AnsiString);
497			begin
498			FSchema.SchemaName:= Value;
499			end;
500
501			end.