paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 22:29:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fcl-db: dbftool:

Browse Source 
- detect upper, lower and mixed case .dbf files on *nix
- create demo db in current directory instead of application directory

git-svn-id: trunk@29063 -
This commit is contained in:
reiniero 2014-11-12 09:14:59 +00:00
parent 8c61990078
commit 26913387cf
1 changed files with 26 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
packages/fcl-db/examples/dbftool.lpr
View File

@ -2,7 +2,7 @@ program dbftool;
{ {
Reads and exports DBF files. Reads and exports DBF files.
Can create a set of 2 demo DBF files to test with. Can create a set of 2 demo DBF files in current directory to test with.
Demonstrates creating DBF tables, filling it with data, Demonstrates creating DBF tables, filling it with data,
and exporting datasets. and exporting datasets.
@ -53,16 +53,22 @@ type
// Creates 2 demonstration DBFs in Directory // Creates 2 demonstration DBFs in Directory
// with dbase compatibility level TableLevel // with dbase compatibility level TableLevel
procedure CreateDemoDBFs(Directory: string; TableLevel: integer); procedure CreateDemoDBFs(Directory: string; TableLevel: integer);
// Data structure and data adapted from Firebird employee sample database // Data structure and data adapted from Firebird employee sample database that
// Useful to integrate with SQLDB tutorials on Lazarus wiki // are also used in the SQLDB tutorials on Lazarus wiki/demo directory.
var var
CurDir: string; //current directory
NewDBF: TDBF; NewDBF: TDBF;
i: integer; i: integer;
begin begin
// Get current working directory (need not be application directory):
GetDir(0,CurDir);
NewDBF := TDBF.Create(nil); NewDBF := TDBF.Create(nil);
try try
if Directory = '' then if Directory = '' then
NewDBF.FilePath := '' { application directory} begin
NewDBF.FilePathFull := ExpandFileName(CurDir);
end
else else
NewDBF.FilePathFull := ExpandFileName(Directory) {full absolute path}; NewDBF.FilePathFull := ExpandFileName(Directory) {full absolute path};
if TableLevel <= 0 then if TableLevel <= 0 then
@ -71,7 +77,7 @@ type
NewDBF.TableLevel := TableLevel; NewDBF.TableLevel := TableLevel;
NewDBF.TableName := 'customer.dbf'; NewDBF.TableName := 'customer.dbf';
writeln('Creating ', NewDBF.TableName, ' with table level ', NewDBF.TableLevel); writeln('Creating ', NewDBF.TableName, ' with table level ', NewDBF.TableLevel);
if TableLevel >= 30 {Visual FoxPro} then if TableLevel >= 30 {Visual FoxPro} then
begin begin
NewDBF.FieldDefs.Add('CUST_NO', ftAutoInc); NewDBF.FieldDefs.Add('CUST_NO', ftAutoInc);
@ -131,7 +137,7 @@ type
NewDBF := TDBF.Create(nil); NewDBF := TDBF.Create(nil);
try try
if Directory = '' then if Directory = '' then
NewDBF.FilePath := '' {application directory} NewDBF.FilePathFull := ExpandFileName(CurDir)
else else
NewDBF.FilePathFull := ExpandFileName(Directory) {full absolute path}; NewDBF.FilePathFull := ExpandFileName(Directory) {full absolute path};
if TableLevel <= 0 then if TableLevel <= 0 then
@ -228,7 +234,7 @@ type
r: TSearchRec; r: TSearchRec;
begin begin
results.Clear; results.Clear;
if FindFirst('*.dbf', faAnyFile - faDirectory - if FindFirst('*', faAnyFile - faDirectory -
{$WARNINGS OFF} {$WARNINGS OFF}
faVolumeID - faSymLink faVolumeID - faSymLink
{$WARNINGS ON} {$WARNINGS ON}
@ -236,7 +242,11 @@ type
begin begin
repeat repeat
begin begin
results.add(expandfilename(r.Name)); // Cater for both case-sensitive and case-insensitive filesystems
// ignore any directories
if ((r.Attr and faDirectory) <> faDirectory) and
(LowerCase(ExtractFileExt(r.Name))='.dbf') then
results.add(expandfilename(r.Name));
end; end;
until (FindNext(r) <> 0); until (FindNext(r) <> 0);
findclose(r); findclose(r);
@ -550,18 +560,21 @@ type
procedure TDBFTool.WriteHelp; procedure TDBFTool.WriteHelp;
begin begin
writeln('Usage: ', GetExeName, ' -h'); writeln('Read/print all dbfs in current directory');
writeln(' --createdemo create demo database'); writeln('Usage info: ', GetExeName, ' -h');
writeln(' --tablelevel=<n> optional: desired tablelevel for demo db'); writeln('');
writeln('--createdemo create demo database in current directory');
writeln('--tablelevel=<n> optional: desired tablelevel for demo db');
writeln(' 3 DBase III'); writeln(' 3 DBase III');
writeln(' 4 DBase IV (default if no tablelevel given)'); writeln(' 4 DBase IV (default if no tablelevel given)');
writeln(' 7 Visual DBase 7'); writeln(' 7 Visual DBase 7');
writeln(' 25 FoxPro 2.x'); writeln(' 25 FoxPro 2.x');
writeln(' 30 Visual FoxPro'); writeln(' 30 Visual FoxPro');
writeln(' --exportformat=<text> export dbfs to format. Format can be:'); writeln('--exportformat=<text> export dbfs to format. Format can be:');
writeln(' access Microsoft Access XML'); writeln(' access Microsoft Access XML');
writeln(' adonet ADO.Net dataset XML'); writeln(' adonet ADO.Net dataset XML');
writeln(' csvexcel Excel/Creativyst format CSV text file (with locale dependent output)'); writeln(' csvexcel Excel/Creativyst format CSV text file ');
writeln(' (with locale dependent output)');
writeln(' csvRFC4180 LibreOffice/RFC4180 format CSV text file'); writeln(' csvRFC4180 LibreOffice/RFC4180 format CSV text file');
writeln(' dataset Delphi dataset XML'); writeln(' dataset Delphi dataset XML');
writeln(' excel Microsoft Excel XML'); writeln(' excel Microsoft Excel XML');