mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-22 06:49:27 +02:00
fcl-db: example program that shows creating, using dbf as well as exporting using dbexport
git-svn-id: trunk@25106 -
This commit is contained in:
reiniero
parent
de8f4e37c0
commit
4428a1e68a
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -1975,6 +1975,8 @@ packages/fcl-base/texts/fptemplate.txt svneol=native#text/plain
|
||||
packages/fcl-db/Makefile svneol=native#text/plain
|
||||
packages/fcl-db/Makefile.fpc svneol=native#text/plain
|
||||
packages/fcl-db/Makefile.fpc.fpcmake svneol=native#text/plain
|
||||
packages/fcl-db/examples/dbftool.lpi svneol=native#text/plain
|
||||
packages/fcl-db/examples/dbftool.lpr svneol=native#text/plain
|
||||
packages/fcl-db/examples/fbadmindemo.pp svneol=native#text/plain
|
||||
packages/fcl-db/examples/fbeventstest.pp svneol=native#text/plain
|
||||
packages/fcl-db/examples/loadlibdemo.lpi svneol=native#text/plain
|
||||
|
||||
72
packages/fcl-db/examples/dbftool.lpi
Normal file
72
packages/fcl-db/examples/dbftool.lpi
Normal file
@ -0,0 +1,72 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="DBFTool"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<CommandLineParams Value="--createdemo"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<Units Count="1">
|
||||
<Unit0>
|
||||
<Filename Value="dbftool.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="dbftool"/>
|
||||
</Unit0>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="dbftool"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
574
packages/fcl-db/examples/dbftool.lpr
Normal file
574
packages/fcl-db/examples/dbftool.lpr
Normal file
@ -0,0 +1,574 @@
|
||||
program dbftool;
|
||||
|
||||
{ Reads and exports DBF files. Can create a demo DBF file to test with.
|
||||
|
||||
Demonstrates creating DBF tables, filling it with data,
|
||||
and exporting datasets.
|
||||
}
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses {$IFDEF UNIX} {$IFDEF UseCThreads}
|
||||
cthreads, {$ENDIF} {$ENDIF}
|
||||
Classes,
|
||||
SysUtils,
|
||||
CustApp,
|
||||
DB,
|
||||
dbf,
|
||||
dbf_fields,
|
||||
dbf_common,
|
||||
dateutils,
|
||||
fpdbexport,
|
||||
fpcsvexport,
|
||||
fpdbfexport,
|
||||
fpfixedexport,
|
||||
fprtfexport,
|
||||
fpsimplejsonexport,
|
||||
fpsimplexmlexport,
|
||||
fpsqlexport,
|
||||
fptexexport,
|
||||
fpxmlxsdexport;
|
||||
|
||||
|
||||
type
|
||||
|
||||
{ TDBFTool }
|
||||
|
||||
TDBFTool = class(TCustomApplication)
|
||||
private
|
||||
procedure ExportDBF(var MyDbf: TDbf);
|
||||
protected
|
||||
procedure DoRun; override;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure WriteHelp; virtual;
|
||||
end;
|
||||
|
||||
procedure CreateDemoDBFs(Directory: string; TableLevel: integer);
|
||||
// Creates 2 demonstration DBFs in Directory with dbase compatibility level
|
||||
// TableLevel
|
||||
// and specified codepage (if not CODEPAGE_NOT_SPECIFIED)
|
||||
var
|
||||
NewDBF: TDBF;
|
||||
i: integer;
|
||||
begin
|
||||
|
||||
NewDBF := TDBF.Create(nil);
|
||||
try
|
||||
if Directory = '' then
|
||||
NewDBF.FilePath := '' { application directory}
|
||||
else
|
||||
NewDBF.FilePathFull := ExpandFileName(Directory) {full absolute path};
|
||||
if TableLevel <= 0 then
|
||||
NewDBF.TableLevel := 4 {default to DBase IV}
|
||||
else
|
||||
NewDBF.TableLevel := TableLevel;
|
||||
|
||||
NewDBF.TableName := 'CUSTOMER.DBF';
|
||||
writeln('Creating ', NewDBF.TableName, ' with table level ', NewDBF.TableLevel);
|
||||
if TableLevel >= 30 then
|
||||
begin
|
||||
NewDBF.FieldDefs.Add('CUST_NO', ftAutoInc);
|
||||
end
|
||||
else
|
||||
NewDBF.FieldDefs.Add('CUST_NO', ftInteger);
|
||||
NewDBF.FieldDefs.Add('CUSTOMER', ftString, 25);
|
||||
NewDBF.FieldDefs.Add('CITY', ftString, 25);
|
||||
NewDBF.FieldDefs.Add('COUNTRY', ftString, 15);
|
||||
NewDBF.CreateTable;
|
||||
NewDBF.Open;
|
||||
|
||||
for i := 1 to 5 do //keep size manageable until we have working files
|
||||
begin
|
||||
NewDBF.Append;
|
||||
if (NewDBF.FieldDefs.Find('CUST_NO').DataType <> ftAutoInc) then
|
||||
NewDBF.FieldByName('CUST_NO').AsInteger := i;
|
||||
case i of
|
||||
1:
|
||||
begin
|
||||
NewDBF.FieldByName('CUSTOMER').AsString := 'Michael Design';
|
||||
NewDBF.FieldByName('CITY').AsString := 'San Diego';
|
||||
NewDBF.FieldByName('COUNTRY').AsString := 'USA';
|
||||
end;
|
||||
2:
|
||||
begin
|
||||
NewDBF.FieldByName('CUSTOMER').AsString := 'Michael Design';
|
||||
NewDBF.FieldByName('CITY').AsString := 'San Diego';
|
||||
NewDBF.FieldByName('COUNTRY').AsString := 'USA';
|
||||
end;
|
||||
3:
|
||||
begin
|
||||
NewDBF.FieldByName('CUSTOMER').AsString := 'VC Technologies';
|
||||
NewDBF.FieldByName('CITY').AsString := 'Dallas';
|
||||
NewDBF.FieldByName('COUNTRY').AsString := 'USA';
|
||||
end;
|
||||
4:
|
||||
begin
|
||||
NewDBF.FieldByName('CUSTOMER').AsString := 'Klämpfl, Van Canneyt';
|
||||
NewDBF.FieldByName('CITY').AsString := 'Boston';
|
||||
NewDBF.FieldByName('COUNTRY').AsString := 'USA';
|
||||
end;
|
||||
5:
|
||||
begin
|
||||
NewDBF.FieldByName('CUSTOMER').AsString := 'Felipe Bank';
|
||||
NewDBF.FieldByName('CITY').AsString := 'Manchester';
|
||||
NewDBF.FieldByName('COUNTRY').AsString := 'England';
|
||||
end;
|
||||
end;
|
||||
NewDBF.Post;
|
||||
end;
|
||||
NewDBF.Close;
|
||||
finally
|
||||
NewDBF.Free;
|
||||
end;
|
||||
|
||||
NewDBF := TDBF.Create(nil);
|
||||
try
|
||||
if Directory = '' then
|
||||
NewDBF.FilePath := '' { application directory}
|
||||
else
|
||||
NewDBF.FilePathFull := ExpandFileName(Directory) {full absolute path};
|
||||
if TableLevel <= 0 then
|
||||
NewDBF.TableLevel := 4 {default to DBase IV}
|
||||
else
|
||||
NewDBF.TableLevel := TableLevel;
|
||||
|
||||
NewDBF.TableName := 'EMPLOYEE.DBF';
|
||||
writeln('Creating ', NewDBF.TableName, ' with table level ', NewDBF.TableLevel);
|
||||
if TableLevel >= 30 then
|
||||
begin
|
||||
NewDBF.FieldDefs.Add('EMP_NO', ftAutoInc);
|
||||
end
|
||||
else
|
||||
NewDBF.FieldDefs.Add('EMP_NO', ftInteger);
|
||||
NewDBF.FieldDefs.Add('FIRST_NAME', ftString, 15);
|
||||
NewDBF.FieldDefs.Add('LAST_NAME', ftString, 20);
|
||||
NewDBF.FieldDefs.Add('PHONE_EXT', ftString, 4);
|
||||
NewDBF.FieldDefs.Add('JOB_CODE', ftString, 5);
|
||||
NewDBF.FieldDefs.Add('JOB_GRADE', ftInteger);
|
||||
NewDBF.FieldDefs.Add('JOB_COUNTR', ftString, 15); //Note 10 character limit for table/field names in most DBases
|
||||
NewDBF.FieldDefs.Add('SALARY', ftFloat);
|
||||
NewDBF.CreateTable;
|
||||
NewDBF.Open;
|
||||
|
||||
for i := 1 to 5 do //keep size manageable until we have working files
|
||||
begin
|
||||
NewDBF.Append;
|
||||
if (NewDBF.FieldDefs.Find('EMP_NO').DataType <> ftAutoInc) then
|
||||
NewDBF.FieldByName('EMP_NO').AsInteger := i;
|
||||
case i of
|
||||
1:
|
||||
begin
|
||||
NewDBF.FieldByName('FIRST_NAME').AsString := 'William';
|
||||
NewDBF.FieldByName('LAST_NAME').AsString := 'Shatner';
|
||||
NewDBF.FieldByName('PHONE_EXT').AsString := '1702';
|
||||
NewDBF.FieldByName('JOB_CODE').AsString := 'CEO';
|
||||
NewDBF.FieldByName('JOB_GRADE').AsInteger := 1;
|
||||
NewDBF.FieldByName('JOB_COUNTR').AsString := 'USA';
|
||||
NewDBF.FieldByName('SALARY').AsFloat := 48000;
|
||||
end;
|
||||
2:
|
||||
begin
|
||||
NewDBF.FieldByName('FIRST_NAME').AsString := 'Ivan';
|
||||
NewDBF.FieldByName('LAST_NAME').AsString := 'Ishenin';
|
||||
NewDBF.FieldByName('PHONE_EXT').AsString := '9802';
|
||||
NewDBF.FieldByName('JOB_CODE').AsString := 'Eng';
|
||||
NewDBF.FieldByName('JOB_GRADE').AsInteger := 2;
|
||||
NewDBF.FieldByName('JOB_COUNTR').AsString := 'Russia';
|
||||
NewDBF.FieldByName('SALARY').AsFloat := 38000;
|
||||
end;
|
||||
3:
|
||||
begin
|
||||
NewDBF.FieldByName('FIRST_NAME').AsString := 'Erin';
|
||||
NewDBF.FieldByName('LAST_NAME').AsString := 'Powell';
|
||||
NewDBF.FieldByName('PHONE_EXT').AsString := '1703';
|
||||
NewDBF.FieldByName('JOB_CODE').AsString := 'Admin';
|
||||
NewDBF.FieldByName('JOB_GRADE').AsInteger := 2;
|
||||
NewDBF.FieldByName('JOB_COUNTR').AsString := 'USA';
|
||||
NewDBF.FieldByName('SALARY').AsFloat := 45368;
|
||||
end;
|
||||
4:
|
||||
begin
|
||||
NewDBF.FieldByName('FIRST_NAME').AsString := 'Margaret';
|
||||
NewDBF.FieldByName('LAST_NAME').AsString := 'Tetchy';
|
||||
NewDBF.FieldByName('PHONE_EXT').AsString := '3804';
|
||||
NewDBF.FieldByName('JOB_CODE').AsString := 'Eng';
|
||||
NewDBF.FieldByName('JOB_GRADE').AsInteger := 3;
|
||||
NewDBF.FieldByName('JOB_COUNTR').AsString := 'England';
|
||||
NewDBF.FieldByName('SALARY').AsFloat := 28045;
|
||||
end;
|
||||
5:
|
||||
begin
|
||||
NewDBF.FieldByName('FIRST_NAME').AsString := 'Sergey';
|
||||
NewDBF.FieldByName('LAST_NAME').AsString := 'Bron';
|
||||
NewDBF.FieldByName('PHONE_EXT').AsString := '3807';
|
||||
NewDBF.FieldByName('JOB_CODE').AsString := 'Admin';
|
||||
NewDBF.FieldByName('JOB_GRADE').AsInteger := 3;
|
||||
NewDBF.FieldByName('JOB_COUNTR').AsString := 'England';
|
||||
NewDBF.FieldByName('SALARY').AsFloat := 24468;
|
||||
end;
|
||||
end;
|
||||
NewDBF.Post;
|
||||
end;
|
||||
NewDBF.Close;
|
||||
finally
|
||||
NewDBF.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure GetDBFList(Results: TStringList);
|
||||
// Gets list of all .dbf files in a directory and its subdirectories.
|
||||
var
|
||||
r: TSearchRec;
|
||||
begin
|
||||
results.Clear;
|
||||
if FindFirst('*.dbf', faAnyFile -
|
||||
{$WARNINGS OFF}
|
||||
faVolumeID - faSymLink
|
||||
{$WARNINGS ON}
|
||||
, r) = 0 then
|
||||
begin
|
||||
repeat
|
||||
if (r.Attr and faDirectory) <> faDirectory then
|
||||
begin
|
||||
results.add(expandfilename(r.Name));
|
||||
end;
|
||||
until (FindNext(r) <> 0);
|
||||
findclose(r);
|
||||
end;
|
||||
end;
|
||||
|
||||
function BinFieldToHex(BinarySource: TField): string;
|
||||
// Convert binary field contents to strings with hexadecimal representation.
|
||||
// Useful for displaying binary field contents.
|
||||
var
|
||||
HexValue: PChar;
|
||||
begin
|
||||
Result := '';
|
||||
HexValue := StrAlloc(Length(BinarySource.AsBytes));
|
||||
try
|
||||
try
|
||||
BinToHex(PChar(BinarySource.AsBytes), HexValue, Length(BinarySource.AsBytes));
|
||||
Result := 'size: ' + IntToStr(Length(BinarySource.AsBytes)) + '; hex: ' + HexValue;
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
Result := 'exception: ' + E.ClassName + '/' + E.Message;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
StrDispose(HexValue);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure PrintRecord(DBf: TDBf; RecordNumber: integer);
|
||||
// Prints contents of a record to screen
|
||||
var
|
||||
i: integer;
|
||||
begin
|
||||
writeln('Record ' + IntToStr(RecordNumber));
|
||||
for i := 0 to DBf.Fields.Count - 1 do
|
||||
begin
|
||||
if DBF.fields[i].IsNull then
|
||||
writeln('Field ', DBf.Fields[i].FieldName, ' is ***NULL***')
|
||||
else
|
||||
if DBF.Fields[i].DataType in [ftVarBytes, ftBytes] then
|
||||
writeln('Field ', DBF.Fields[i].FieldName, ' has value: binary ' + BinFieldToHex(DBF.Fields[i]))
|
||||
else
|
||||
writeln('Field ', DBf.Fields[i].FieldName, ' has value: ' + DBf.fields[i].AsString);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TDBFTool }
|
||||
|
||||
procedure TDBFTool.ExportDBF(var MyDbf: TDbf);
|
||||
// Exports recordset to another format depending on user selection
|
||||
var
|
||||
ExportFormatText: string;
|
||||
ExportSettings: TCustomExportFormatSettings;
|
||||
Exporter: TCustomFileExporter;
|
||||
begin
|
||||
ExportFormatText := UpperCase(GetOptionValue('exportformat'));
|
||||
try
|
||||
case ExportFormatText of
|
||||
'ACCESS', 'MSACCESS':
|
||||
begin
|
||||
Exporter := TXMLXSDExporter.Create(nil);
|
||||
ExportSettings := TXMLXSDFormatSettings.Create(true);
|
||||
(ExportSettings as TXMLXSDFormatSettings).CreateXSD := true;
|
||||
(ExportSettings as TXMLXSDFormatSettings).ExportFormat :=
|
||||
AccessCompatible;
|
||||
(ExportSettings as TXMLXSDFormatSettings).DecimalSeparator := '.';
|
||||
Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.xml');
|
||||
end;
|
||||
'ADO', 'ADONET', 'ADO.NET':
|
||||
begin
|
||||
Exporter := TXMLXSDExporter.Create(nil);
|
||||
ExportSettings := TXMLXSDFormatSettings.Create(true);
|
||||
(ExportSettings as TXMLXSDFormatSettings).CreateXSD := true;
|
||||
(ExportSettings as TXMLXSDFormatSettings).ExportFormat :=
|
||||
ADONETCompatible;
|
||||
(ExportSettings as TXMLXSDFormatSettings).DecimalSeparator := '.';
|
||||
Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.xml');
|
||||
end;
|
||||
'CSVEXCEL', 'EXCELCSV', 'CREATIVYST':
|
||||
begin
|
||||
Exporter := TCSVExporter.Create(nil);
|
||||
ExportSettings := TCSVFormatSettings.Create(true);
|
||||
(ExportSettings as TCSVFormatSettings).RowDelimiter:=LineEnding;
|
||||
//todo: delimiter?
|
||||
Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.csv');
|
||||
end;
|
||||
'CSV', 'CSVRFC4180', 'CSVLIBRE', 'CSVLIBREOFFICE':
|
||||
begin
|
||||
Exporter := TCSVExporter.Create(nil);
|
||||
ExportSettings := TCSVFormatSettings.Create(true);
|
||||
(ExportSettings as TCSVFormatSettings).DecimalSeparator := '.';
|
||||
(ExportSettings as TCSVFormatSettings).StringQuoteChar := '"';
|
||||
Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.csv');
|
||||
end;
|
||||
'DATASET', 'DELPHI':
|
||||
begin
|
||||
Exporter := TXMLXSDExporter.Create(nil);
|
||||
ExportSettings := TXMLXSDFormatSettings.Create(true);
|
||||
(ExportSettings as TXMLXSDFormatSettings).ExportFormat :=
|
||||
DelphiClientDataset;
|
||||
(ExportSettings as TXMLXSDFormatSettings).DecimalSeparator := '.';
|
||||
Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.xml');
|
||||
end;
|
||||
'EXCEL', 'EXCELXML':
|
||||
begin
|
||||
Exporter := TXMLXSDExporter.Create(nil);
|
||||
ExportSettings := TXMLXSDFormatSettings.Create(true);
|
||||
(ExportSettings as TXMLXSDFormatSettings).ExportFormat := ExcelCompatible;
|
||||
(ExportSettings as TXMLXSDFormatSettings).DecimalSeparator := '.';
|
||||
Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.xml');
|
||||
end;
|
||||
'JSON':
|
||||
begin
|
||||
Exporter := TSimpleJSONExporter.Create(nil);
|
||||
ExportSettings := TSimpleJSONFormatSettings.Create(true);
|
||||
Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.json');
|
||||
end;
|
||||
'SIMPLEXML', 'XML':
|
||||
begin
|
||||
Exporter := TSimpleXMLExporter.Create(nil);
|
||||
ExportSettings := TSimpleXMLFormatSettings.Create(true);
|
||||
Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.xml');
|
||||
end;
|
||||
'RTF':
|
||||
begin
|
||||
Exporter := TRTFExporter.Create(nil);
|
||||
ExportSettings := TSimpleXMLFormatSettings.Create(true);
|
||||
Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.rtf');
|
||||
end;
|
||||
'SQL':
|
||||
begin
|
||||
Exporter := TSQLExporter.Create(nil);
|
||||
ExportSettings := TSQLFormatSettings.Create(true);
|
||||
(ExportSettings as TSQLFormatSettings).QuoteChar := '"';
|
||||
(ExportSettings as TSQLFormatSettings).DecimalSeparator := '.';
|
||||
(ExportSettings as TSQLFormatSettings).TableName := ChangeFileExt(MyDBF.TableName,'');
|
||||
(ExportSettings as TSQLFormatSettings).DateFormat := 'yyyy"-"mm"-"dd'; //ISO 8601, yyyy-mm-dd
|
||||
(ExportSettings as TSQLFormatSettings).TimeFormat := 'hh":"nn":"ss'; //ISO 8601, hh:mm:ss;
|
||||
(ExportSettings as TSQLFormatSettings).DateTimeFormat :=
|
||||
(ExportSettings as TSQLFormatSettings).DateFormat + '"T"' + (ExportSettings as TSQLFormatSettings).TimeFormat; //ISO 8601
|
||||
Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.sql');
|
||||
end;
|
||||
'TEX', 'LATEX':
|
||||
begin
|
||||
Exporter := TTeXExporter.Create(nil);
|
||||
ExportSettings := TTeXExportFormatSettings.Create(true);
|
||||
Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.tex');
|
||||
end;
|
||||
'TEXT', 'FIXED', 'FIXEDTEXT':
|
||||
begin
|
||||
Exporter := TFixedLengthExporter.Create(nil);
|
||||
ExportSettings := nil;
|
||||
Exporter.FileName := MyDBF.FilePathFull + ChangeFileExt(MyDBF.TableName, '.txt');
|
||||
end
|
||||
else
|
||||
begin
|
||||
writeln('***Error: Unknown export format ' + ExportFormatText + ' specified' + '. Aborting');
|
||||
Exporter := nil;
|
||||
ExportSettings := nil;
|
||||
Terminate;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
if assigned(ExportSettings) then
|
||||
Exporter.FormatSettings := ExportSettings;
|
||||
Exporter.Dataset := MyDBF;
|
||||
MyDBF.First; // we've just read the last record - make sure export starts at beginning
|
||||
Exporter.Execute;
|
||||
writeln('Completed export to ' + Exporter.FileName);
|
||||
finally
|
||||
if assigned(Exporter) then
|
||||
Exporter.Free;
|
||||
if assigned(ExportSettings) then
|
||||
ExportSettings.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TDBFTool.DoRun;
|
||||
var
|
||||
DBFs: TStringList;
|
||||
Demo: boolean;
|
||||
ErrorMsg: string;
|
||||
FileNo: integer;
|
||||
MyDbf: TDbf;
|
||||
RecCount: integer;
|
||||
TableLevel: integer; //todo: use it
|
||||
begin
|
||||
// quick check parameters
|
||||
ErrorMsg := CheckOptions('h', 'codepage: createdemo exportformat: help tablelevel:');
|
||||
if ErrorMsg <> '' then
|
||||
begin
|
||||
ShowException(Exception.Create(ErrorMsg));
|
||||
Terminate;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
// parse parameters
|
||||
if HasOption('h', 'help') then
|
||||
begin
|
||||
WriteHelp;
|
||||
Terminate;
|
||||
Exit;
|
||||
end;
|
||||
|
||||
DBFs := TStringList.Create;
|
||||
try
|
||||
Demo := false;
|
||||
if HasOption('createdemo') then
|
||||
Demo := true;
|
||||
|
||||
TableLevel := 4; //DBF
|
||||
if HasOption('tablelevel') then
|
||||
TableLevel := StrToIntDef(GetOptionValue('tablelevel'), 4);
|
||||
|
||||
if Demo then
|
||||
begin
|
||||
try
|
||||
CreateDemoDBFs('', TableLevel);
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
writeln('*** Error creating demo databases: ' + E.Message);
|
||||
Terminate;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
// Process all dbfs if no files specified
|
||||
if DBFs.Count = 0 then
|
||||
GetDBFList(DBFs);
|
||||
|
||||
if DBFs.Count = 0 then
|
||||
writeln('Could not find any dbf files');
|
||||
|
||||
for FileNo := 0 to DBFs.Count - 1 do
|
||||
begin
|
||||
if not (fileexists(DBFs[FileNo])) then
|
||||
begin
|
||||
// for some reason, fpc trunk suddenly returns the directory as well...
|
||||
//writeln('Sorry, file ',DBFs[FileNo],' does not exist.');
|
||||
break;
|
||||
end;
|
||||
MyDbf := TDbf.Create(nil);
|
||||
try
|
||||
try
|
||||
MyDbf.FilePath := ExtractFilePath(DBFs[FileNo]);
|
||||
MyDbf.TableName := ExtractFileName(DBFs[FileNo]);
|
||||
MyDbf.ReadOnly := true;
|
||||
writeln('*** Opening: ' + DBFs[FileNo]);
|
||||
MyDbf.Open;
|
||||
writeln('Database tablelevel: ' + IntToStr(MyDbf.TableLevel));
|
||||
writeln('Database codepage: ' + IntToStr(MyDBF.CodePage));
|
||||
|
||||
RecCount := 1;
|
||||
while not (MyDbf.EOF) do
|
||||
begin
|
||||
PrintRecord(MyDBF, RecCount);
|
||||
MyDBF.Next;
|
||||
RecCount := RecCount + 1;
|
||||
writeln('');
|
||||
end;
|
||||
|
||||
if HasOption('exportformat') then
|
||||
begin
|
||||
try
|
||||
ExportDBF(MyDbf);
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
writeln('*** Problem exporting file ', FileNo, ': ', E.Message);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
MyDbf.Close;
|
||||
except
|
||||
on E: Exception do
|
||||
begin
|
||||
writeln('*** Error reading file ', FileNo, ': ', E.Message);
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
MyDbf.Free;
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
DBFs.Free;
|
||||
end;
|
||||
|
||||
// stop program loop
|
||||
Terminate;
|
||||
end;
|
||||
|
||||
constructor TDBFTool.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
StopOnException := true;
|
||||
end;
|
||||
|
||||
destructor TDBFTool.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TDBFTool.WriteHelp;
|
||||
begin
|
||||
writeln('Usage: ', ExeName, ' -h');
|
||||
writeln(' --createdemo create demo database');
|
||||
writeln(' --tablelevel=<n> optional: desired tablelevel for demo db');
|
||||
writeln(' 3 DBase III');
|
||||
writeln(' 4 DBase IV');
|
||||
writeln(' 7 Visual DBase 7');
|
||||
writeln(' 25 FoxPro 2.x');
|
||||
writeln(' 30 Visual FoxPro');
|
||||
writeln(' --exportformat=<text> export dbfs to format. Format can be:');
|
||||
writeln(' access Microsoft Access XML');
|
||||
writeln(' adonet ADO.Net dataset');
|
||||
writeln(' csvexcel Excel/Creativyst format CSV text file (with locale dependent output)');
|
||||
writeln(' csvRFC4180 LibreOffice/RFC4180 format CSV text file');
|
||||
writeln(' dataset Delphi dataset XML');
|
||||
writeln(' excel Microsoft Excel XML');
|
||||
writeln(' fixedtext Fixed length text file');
|
||||
writeln(' json JSON file');
|
||||
writeln(' rtf Rich Text Format');
|
||||
writeln(' simplexml Simple XML');
|
||||
writeln(' sql SQL insert statements');
|
||||
writeln(' tex LaTeX file');
|
||||
end;
|
||||
|
||||
var
|
||||
Application: TDBFTool;
|
||||
begin
|
||||
Application := TDBFTool.Create(nil);
|
||||
Application.Title := 'DBFTool';
|
||||
Application.Run;
|
||||
Application.Free;
|
||||
end.
|
||||
Loading…
Reference in New Issue
Block a user