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	(* *** 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.