ASCII tab deliminated and comma separated to Paradox 7
Cliff Wilderman
Need a utility to receive ASCII tab delimited and comma separated files
into Paradox 7 tables. Looking at Data Junction GUI but is that overkill?
Any others out there that are better, simpler, does it all by itself when
you say go?
Appreciate some opinions.
Cliff
Steve Fischkoff (TeamB)
There are some third party components that you can incorporate into
your projects to do this. Good places to look for them are
www.torry.ru or sunsite.icm.edu.pl/delphi. Now, it is also possible to
use the BatchMove component and the ASCII file driver. The latter is a
little tricky but it may be worth doing if you are reluctant to depend
on a third party component.
Steve F (Team B)
Alain Quesnel
solution that won't integrate into your code, Paradox 7 for Windows does
this very well.
--
Alain Quesnel
P.S.: remove the [brackets] from my address when replying by e-mail.
Cliff Wilderman <cli...@southcoast.net> wrote in message
news:807ren$7h...@forums.borland.com...
Tomislav Kardaš
On Mon, 8 Nov 1999 17:01:06 -0800, "Cliff Wilderman"
<cli...@southcoast.net> wrote:
>Need a utility to receive ASCII tab delimited and comma separated files
>into Paradox 7 tables. Looking at Data Junction GUI but is that overkill?
>Any others out there that are better, simpler, does it all by itself when
>you say go?
Here is my unit for dataset import/export from/to ascii files ...
use
ExportDataSet(DataSet, Name);
for exporting, and
ImportDataSet(DataSet, Name);
for importing.
tomi.
// ------------------------- ExpData.pas ---------------------------
unit ExpData;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
StdCtrls, checklst, ExtCtrls, DB, DBTables, ResFix;
type
TfmExpData = class(TfmResFix)
clbFields: TCheckListBox;
Label1: TLabel;
buOK: TButton;
buCancel: TButton;
buSelectAll: TButton;
buToggle: TButton;
SaveDialog: TSaveDialog;
rgFormat: TRadioGroup;
rgScope: TRadioGroup;
OpenDialog: TOpenDialog;
procedure buSelectAllClick(Sender: TObject);
procedure buToggleClick(Sender: TObject);
procedure buOKClick(Sender: TObject);
private
{ Private declarations }
FDataSet: TDataSet;
FName: string;
procedure CopyToAscii(FileName: string; FieldSep, RowSep: string;
QuotedValues, AllRecords: boolean);
procedure CopyToTable(TableName: string; AllRecords: boolean);
public
{ Public declarations }
end;
var
fmExpData: TfmExpData;
procedure ExportDataSet(DataSet: TDataSet; Name: string);
procedure ImportDataSet(DataSet: TDataSet; Name: string);
procedure CopyFromAscii(DataSet: TDataSet; FileName: string; FieldSep,
RowSep: string; QuotedValues: boolean);
implementation
Uses Data, UTrace;
{$R *.DFM}
const
REP_ROWSEP: string = '^M';
QUOTE: string = '"';
REP_QUOTE: string = '^''';
const
FileExt: array [0..3] of string = (
'.txt', '.csv', '.tsv', '.dbf'
);
procedure ExportDataSet(DataSet: TDataSet; Name: string);
var
i: integer;
begin
if fmExpData = nil then
fmExpData := TfmExpData.Create(nil);
fmExpData.FName := Name;
with fmExpData do
begin
if FDataSet <> DataSet then
begin
FDataSet := DataSet;
clbFields.Clear;
with FDataSet do
for i := 0 to FieldCount - 1 do
if Fields[i].Visible then
clbFields.Items.Add(Fields[i].DisplayName);
end;
ShowModal;
end;
end;
procedure TfmExpData.buSelectAllClick(Sender: TObject);
var
i: integer;
begin
with clbFields do
for i := 0 to Items.Count - 1 do
begin
Checked[i] := true;
end;
end;
procedure TfmExpData.buToggleClick(Sender: TObject);
var
i: integer;
begin
with clbFields do
for i := 0 to Items.Count - 1 do
begin
Checked[i] := not Checked[i];
end;
end;
procedure TfmExpData.buOKClick(Sender: TObject);
var
AnyField: boolean;
i: integer;
FileName: string;
begin
AnyField := false;
with clbFields do
for i := 0 to Items.Count - 1 do
begin
AnyField := AnyField or Checked[i];
end;
if not AnyField then
begin
clbFields.SetFocus;
raise Exception.Create('Please select some data fields for
export!');
end;
SaveDialog.FilterIndex := rgFormat.ItemIndex + 1;
SaveDialog.FileName := FName + FileExt[rgFormat.ItemIndex];
if SaveDialog.Execute then
begin
FileName := Trim(SaveDialog.FileName);
case SaveDialog.FilterIndex of
1: begin
CopyToAscii(FileName, ' ', #13#10, false,
rgScope.ItemIndex = 0);
ModalResult := mrOk;
end;
2: begin
CopyToAscii(FileName, ',', #13#10, true,
rgScope.ItemIndex = 0);
ModalResult := mrOk;
end;
3: begin
CopyToAscii(FileName, #9, #13#10, true,
rgScope.ItemIndex = 0);
ModalResult := mrOk;
end;
4: begin
CopyToTable(FileName, rgScope.ItemIndex = 0);
ModalResult := mrOk;
end;
end;
//MessageDlg('Data exported to file ' + FileName, mtInformation,
[mbOk], 0);
end;
end;
procedure TfmExpData.CopyToAscii(FileName: string; FieldSep, RowSep:
string; QuotedValues, AllRecords: boolean);
var
// RepRowSep is a replacement string when RowSep occurs in a string
data field value
RepRowSep: string;
function FieldToStr(fidx: integer): string;
var
Text: string;
begin
Text := Replace(FDataSet.Fields[fidx].AsString, RowSep,
RepRowSep);
if QuotedValues and ((FDataSet.Fields[fidx] is TStringField) or
(FDataSet.Fields[fidx] is TDateTimeField)) then
result := QUOTE + Replace(Text, QUOTE, REP_QUOTE) + QUOTE
else
result := Text;
end;
var
fh: integer;
cBuffer: string;
MyOpen: boolean;
fData, fCol: integer;
FirstField: boolean;
Text: string;
RecTag: integer;
begin
FirstField := false;
RecTag := 0;
if not FDataSet.Active then
begin
MyOpen := true;
FDataSet.Open;
end
else
begin
MyOpen := false;
if AllRecords then
FDataSet.First;
end;
FDataSet.DisableControls;
try
fh := FileCreate(FileName);
if fh < 0 then
raise Exception.Create('Can''t create file ' + FileName);
try
if QuotedValues then
RepRowSep := REP_ROWSEP
else
begin
// If field values are not quoted than we have to determine
max width
// for all the columns. We will store this information in
tag property
// of datafield or if only one record is included then we
need only one
// width tag (RecTag) for the first fieldname column
RecTag := Length('FieldName');
fCol := -1;
for fData := 0 to FDataSet.FieldCount - 1 do
if FDataSet.Fields[fData].Visible then
begin
Inc(fCol);
if clbFields.Checked[fCol] then
with FDataSet.Fields[fData] do
begin
if AllRecords then
tag := Length(DisplayName)
else if Length(DisplayName) > RecTag then
RecTag := Length(DisplayName);
end;
end;
if AllRecords then
begin
RepRowSep := ' ';
while not FDataSet.Eof do
begin
fCol := -1;
for fData := 0 to FDataSet.FieldCount - 1 do
if FDataSet.Fields[fData].Visible then
begin
Inc(fCol);
if clbFields.Checked[fCol] then
with FDataSet.Fields[fData] do
if tag < Length(AsString) then
tag := Length(AsString);
end;
FDataSet.Next;
end;
FDataSet.First;
end
else
RepRowSep := Format('%s%-*s%s', [RowSep, RecTag, '',
FieldSep]);
end;
if AllRecords then
begin
FirstField := true;
cBuffer := '';
end
else if QuotedValues then
cBuffer := 'FieldName' + FieldSep + 'FieldValue' + RowSep
else
cBuffer := Format('%-*s%s%s', [RecTag, 'FieldName', FieldSep,
'FieldValue']) + RowSep;
fCol := -1;
for fData := 0 to FDataSet.FieldCount - 1 do
if FDataSet.Fields[fData].Visible then
begin
Inc(fCol);
if clbFields.Checked[fCol] then
begin
if QuotedValues then
begin
Text := FDataSet.Fields[fData].DisplayName;
end
else
begin
if AllRecords then
Text := Format('%-*s',
[FDataSet.Fields[fData].Tag, FDataSet.Fields[fData].DisplayName])
else
Text := Format('%-*s', [RecTag,
FDataSet.Fields[fData].DisplayName]);
end;
if AllRecords then
begin
if FirstField then
begin
FirstField := false;
cBuffer := cBuffer + Text;
end
else
begin
cBuffer := cBuffer + FieldSep + Text;
end;
end
else
cBuffer := cBuffer + Text + FieldSep +
FieldToStr(fData) + RowSep;
end;
end;
if AllRecords then
cBuffer := cBuffer + RowSep;
FileWrite(fh, cBuffer[1], Length(cBuffer));
if AllRecords then
begin
while not FDataSet.Eof do
begin
cBuffer := '';
FirstField := true;
fCol := -1;
for fData := 0 to FDataSet.FieldCount - 1 do
if FDataSet.Fields[fData].Visible then
begin
Inc(fCol);
if clbFields.Checked[fCol] then
begin
if QuotedValues then
Text := FieldToStr(fData)
else
Text := Format('%-*s',
[FDataSet.Fields[fData].Tag, FieldToStr(fData)]);
if FirstField then
begin
FirstField := false;
cBuffer := cBuffer + Text;
end
else
cBuffer := cBuffer + FieldSep + Text;
end;
end;
cBuffer := cBuffer + RowSep;
FileWrite(fh, cBuffer[1], Length(cBuffer));
FDataSet.Next;
end;
end;
finally
FileClose(fh);
end;
finally
FDataSet.EnableControls;
if MyOpen and FDataSet.Active then FDataSet.Close;
end;
end;
procedure TfmExpData.CopyToTable(TableName: string; AllRecords:
boolean);
var
Table: TTable;
MyOpen: boolean;
FNameLen, FValueLen: integer;
fData, fCol, fTab: integer;
begin
if not FDataSet.Active then
begin
MyOpen := true;
FDataSet.Open;
end
else
begin
MyOpen := false;
if AllRecords then
FDataSet.First;
end;
Table := TTable.Create(Self);
try
Table.DatabaseName := ExtractFilePath(TableName);
Table.TableName := ExtractFileName(TableName);
Table.TableType := ttDBase;
Table.FieldDefs.Clear;
if AllRecords then
begin
fCol := -1;
for fData := 0 to FDataSet.FieldCount - 1 do
if FDataSet.Fields[fData].Visible then
begin
Inc(fCol);
if clbFields.Checked[fCol] then
Table.FieldDefs.Add(FDataSet.Fields[fData].FieldName,
FDataSet.Fields[fData].DataType,
FDataSet.Fields[fData].Size,
false);
end;
end
else
begin
// We have to determine fields len
FNameLen := 0;
FValueLen := 0;
fCol := -1;
for fData := 0 to FDataSet.FieldCount - 1 do
if FDataSet.Fields[fData].Visible then
begin
Inc(fCol);
if clbFields.Checked[fCol] then
with FDataSet.Fields[fData] do
begin
if Length(DisplayName) > FNameLen then
FNameLen := Length(DisplayName);
if Length(AsString) > FValueLen then
FValueLen := Length(AsString);
end;
end;
Table.FieldDefs.Add('FieldName', ftString, FNameLen, false);
Table.FieldDefs.Add('FieldValue', ftString, FValueLen, false);
end;
Table.CreateTable;
Table.Open;
if AllRecords then
begin
while not FDataSet.Eof do
begin
Table.Append;
fTab := 0;
fCol := -1;
for fData := 0 to FDataSet.FieldCount - 1 do
if FDataSet.Fields[fData].Visible then
begin
Inc(fCol);
if clbFields.Checked[fCol] then
begin
if not FDataSet.Fields[fData].IsNull then
Table.Fields[fTab].Value :=
FDataSet.Fields[fData].Value;
Inc(fTab);
end;
end;
Table.Post;
FDataSet.Next;
end;
end
else
begin
fCol := -1;
for fData := 0 to FDataSet.FieldCount - 1 do
if FDataSet.Fields[fData].Visible then
begin
Inc(fCol);
if clbFields.Checked[fCol] then
begin
Table.Append;
Table.Fields[0].Value :=
FDataSet.Fields[fData].DisplayName;
Table.Fields[1].Value :=
FDataSet.Fields[fData].AsString;
Table.Post;
end;
end;
end;
finally
if MyOpen and FDataSet.Active then FDataSet.Close;
if Assigned(Table) then
begin
if Table.Active then Table.Close;
Table.Free;
end;
end;
end;
procedure ImportDataSet(DataSet: TDataSet; Name: string);
var
FileName: string;
begin
if fmExpData = nil then
fmExpData := TfmExpData.Create(nil);
fmExpData.OpenDialog.FileName := Name +
FileExt[fmExpData.OpenDialog.FilterIndex];
if fmExpData.OpenDialog.Execute then
begin
FileName := Trim(fmExpData.OpenDialog.FileName);
case fmExpData.OpenDialog.FilterIndex of
1: begin
CopyFromAscii(DataSet, FileName, ',', #13#10, true);
end;
2: begin
CopyFromAscii(DataSet, FileName, #9, #13#10, true);
end;
end;
end;
end;
procedure CopyFromAscii(DataSet: TDataSet; FileName: string; FieldSep,
RowSep: string; QuotedValues: boolean);
const
FILE_BUFFER = 4096;
var
MyOpen: boolean;
fh: integer;
FileEof, FileEol, FileBol: boolean;
cBuffer: string;
nBufSize, nBufLen, nBufPos, nRead: integer;
nRowSepPos: integer;
cField: string;
function NextField: boolean;
var
nFieldSepPos: integer;
cSearchSep: string;
begin
result := false;
if (nRead <> 0) and (nBufSize - nBufLen + nBufPos-1 > FILE_BUFFER)
then
begin
if nBufLen >= nBufPos then
begin
Move(cBuffer[nBufPos], cBuffer[1], nBufLen-nBufPos+1);
nRowSepPos := nRowSepPos-(nBufPos-1);
nBufLen := nBufLen-(nBufPos-1);
nBufPos := 1;
end
else
begin
nBufLen := 0;
nBufPos := 1;
nRowSepPos := 0;
end;
nRead := FileRead(fh, cBuffer[nBufLen+1], FILE_BUFFER);
nBufLen := nBufLen + nRead;
end;
// If no more bytes in the buffer than quit.
if nBufPos > nBufLen then
begin
FileEol := true;
FileEof := true;
Exit;
end;
FileBol := false;
FileEol := false;
if nRowSepPos < nBufPos then
begin
// Finding new newline position
nRowSepPos := nBufPos;
while (nRowSepPos <= nBufLen) and (RowSep <> Copy(cBuffer,
nRowSepPos, Length(RowSep))) do
Inc(nRowSepPos);
FileBol := true;
end;
if nBufPos = nRowSepPos then
begin
// At the end of line
FileEol := true;
Inc(nBufPos, Length(RowSep));
Exit;
end;
if QuotedValues and (cBuffer[nBufPos] = '"') then
begin
cSearchSep := '"' + FieldSep;
Inc(nBufPos);
end
else
begin
cSearchSep := FieldSep;
end;
nFieldSepPos := nBufPos;
while (nFieldSepPos < nRowSepPos) and (cSearchSep <> Copy(cBuffer,
nFieldSepPos, Length(cSearchSep))) do
Inc(nFieldSepPos);
if QuotedValues and (nFieldSepPos = nRowSepPos) and
(cBuffer[nFieldSepPos-1] = '"') then
cField := Copy(cBuffer, nBufPos, nFieldSepPos-nBufPos-1)
else
cField := Copy(cBuffer, nBufPos, nFieldSepPos-nBufPos);
if nFieldSepPos < nRowSepPos then
nBufPos := nFieldSepPos + Length(cSearchSep)
else
nBufPos := nRowSepPos;
cField := Replace(cField, REP_ROWSEP, RowSep);
cField := Replace(cField, REP_QUOTE, QUOTE);
result := true;
end;
var
ColumnList: TList;
Field: TField;
fData: integer;
begin
if not DataSet.Active then
begin
MyOpen := true;
DataSet.Open;
end
else
begin
MyOpen := false;
end;
DataSet.DisableControls;
try
fh := FileOpen(FileName, fmOpenRead or fmShareDenyWrite);
if fh < 0 then
raise Exception.Create('Can''t open file ' + FileName);
try
// Initialization
nBufSize := FILE_BUFFER*3 div 2;
nBufLen := 0;
nBufPos := 1;
nRowSepPos := 0;
nRead := -1;
SetLength(cBuffer, nBufSize);
FileEof := false;
FileEol := false;
FileBol := false;
ColumnList := TList.Create;
try
// Colecting the columns info
repeat
if NextField then
begin
Field := nil;
for fData := 0 to DataSet.FieldCount - 1 do
if DataSet.Fields[fData].Visible and
(DataSet.Fields[fData].FieldKind = fkData) and
(UpperCase(DataSet.Fields[fData].DisplayName) =
UpperCase(cField)) then
begin
Field := DataSet.Fields[fData];
DebugInfo('Field: ' + cField);
end;
ColumnList.Add(Field);
end;
until FileEol;
// Colecting the data
repeat
fData := -1;
repeat
if NextField then
begin
Inc(fData);
if FileBol then
DataSet.Append;
if ColumnList[fData] <> nil then
TField(ColumnList[fData]).AsString := cField;
end;
until FileEol;
if DataSet.State in dsEditModes then
DataSet.Post;
until FileEof;
finally
ColumnList.Free;
end;
(*
repeat
repeat
if NextField then
begin
if FileBol then
DebugInfo('<Begin line>');
DebugInfo('Read: ' + cField);
end;
until FileEol;
until FileEof;
*)
finally
FileClose(fh);
end;
finally
DataSet.EnableControls;
if MyOpen and DataSet.Active then DataSet.Close;
end;
end;
end.
// ------------------------- ExpData.dfm ---------------------------
object fmExpData: TfmExpData
Left = 347
Top = 185
Width = 408
Height = 289
Caption = 'Export data'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 8
Top = 8
Width = 140
Height = 13
Caption = '&Data fields you want exported'
FocusControl = clbFields
end
object clbFields: TCheckListBox
Left = 8
Top = 24
Width = 385
Height = 137
Columns = 4
ItemHeight = 13
TabOrder = 0
end
object buOK: TButton
Left = 114
Top = 233
Width = 75
Height = 25
Caption = 'OK'
Default = True
TabOrder = 5
OnClick = buOKClick
end
object buCancel: TButton
Left = 222
Top = 233
Width = 75
Height = 25
Cancel = True
Caption = 'Cancel'
ModalResult = 2
TabOrder = 6
end
object buSelectAll: TButton
Left = 8
Top = 168
Width = 57
Height = 25
Caption = '&All fields'
TabOrder = 1
OnClick = buSelectAllClick
end
object buToggle: TButton
Left = 8
Top = 196
Width = 57
Height = 25
Caption = '&Toggle'
TabOrder = 2
OnClick = buToggleClick
end
object rgFormat: TRadioGroup
Left = 176
Top = 168
Width = 217
Height = 57
Caption = '&Format'
Columns = 2
ItemIndex = 0
Items.Strings = (
'Text'
'Comma sep.val.'
'Tab sep.val.'
'DBASE')
TabOrder = 4
end
object rgScope: TRadioGroup
Left = 68
Top = 168
Width = 105
Height = 57
Caption = '&Scope'
ItemIndex = 0
Items.Strings = (
'All records'
'Current record')
TabOrder = 3
end
object SaveDialog: TSaveDialog
Filter =
'Text (*.txt)|*.TXT|Comma separated values (*.csv)|*.CSV|Tab
sepa' +
'rated values (*.tsv)|*.TSV|DBASE (*.dbf)|*.DBF'
Options = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist]
Left = 368
Top = 196
end
object OpenDialog: TOpenDialog
Filter =
'Comma separated values (*.csv)|*.CSV|Tab separated values
(*.tsv' +
')|*.TSV'
Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist]
Left = 368
Top = 232
end
end
Bernd Petermeier
...really very interesting tool, but where to find Unit ResFix???
Newbie
Tomislav Kardaš
On Wed, 10 Nov 1999 15:58:18 +0100, "Bernd Petermeier"
<bpete...@gilberg.net> wrote:
>...really very interesting tool, but where to find Unit ResFix???
Sorry, you can just replace ResFix with Form, or if you prefere here
is my resfix (base form that handles small/large font problem for me).
unit ResFix;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs;
type
TfmResFix = class(TForm)
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
FResFixed: boolean;
public
{ Public declarations }
end;
var
fmResFix: TfmResFix;
implementation
const
DesignRes = 96;
{$R *.DFM}
procedure TfmResFix.FormCreate(Sender: TObject);
begin
FResFixed := false;
end;
procedure TfmResFix.FormShow(Sender: TObject);
begin
if not FResFixed then
begin
PixelsPerInch := Screen.PixelsPerInch;
if (PixelsPerInch <> DesignRes) then
begin
Width := LongInt(Width*PixelsPerInch) div DesignRes;
Height := LongInt(Height*PixelsPerInch) div DesignRes;
end;
FResFixed := true;
end;
end;
end.
Bernd Petermeier
thanks indeed for your fast reply.
Bernd
Tomislav Kardaš schrieb in Nachricht
<382991d3...@forums.inprise.com>...
>Hi Bernd!
>
>On Wed, 10 Nov 1999 15:58:18 +0100, "Bernd Petermeier"
><bpete...@gilberg.net> wrote:
>
>>...really very interesting tool, but where to find Unit ResFix???
>
>Sorry, you can just replace ResFix with Form, or if you prefere here
>is my resfix (base form that handles small/large font problem for
me).
>
>unit ResFix;
>
>interface
>
>uses
> Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
>Dialogs;
>
>type
> TfmResFix = class(TForm)
> procedure FormShow(Sender: TObject);
> procedure FormCreate(Sender: TObject);
> private
> { Private declarations }
> FResFixed: boolean;
> public
> { Public declarations }
> end;
>
>var