mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 10:39:40 +01:00
* Testcase for DBF export
git-svn-id: trunk@18986 -
This commit is contained in:
michael
parent
aa4ab64ea5
commit
3cc6ac9e3b
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -1978,6 +1978,9 @@ packages/fcl-db/tests/README.txt svneol=native#text/plain
|
|||||||
packages/fcl-db/tests/XMLXSDExportTest.lpi svneol=native#text/plain
|
packages/fcl-db/tests/XMLXSDExportTest.lpi svneol=native#text/plain
|
||||||
packages/fcl-db/tests/XMLXSDExportTest.lpr svneol=native#text/plain
|
packages/fcl-db/tests/XMLXSDExportTest.lpr svneol=native#text/plain
|
||||||
packages/fcl-db/tests/database.ini.txt svneol=native#text/plain
|
packages/fcl-db/tests/database.ini.txt svneol=native#text/plain
|
||||||
|
packages/fcl-db/tests/dbfexporttest.lpi svneol=native#text/plain
|
||||||
|
packages/fcl-db/tests/dbfexporttest.lpr svneol=native#text/plain
|
||||||
|
packages/fcl-db/tests/dbfexporttestcase1.pas svneol=native#text/plain
|
||||||
packages/fcl-db/tests/dbftoolsunit.pas svneol=native#text/plain
|
packages/fcl-db/tests/dbftoolsunit.pas svneol=native#text/plain
|
||||||
packages/fcl-db/tests/dbtestframework.pas svneol=native#text/plain
|
packages/fcl-db/tests/dbtestframework.pas svneol=native#text/plain
|
||||||
packages/fcl-db/tests/memdstoolsunit.pas svneol=native#text/plain
|
packages/fcl-db/tests/memdstoolsunit.pas svneol=native#text/plain
|
||||||
|
|||||||
113
packages/fcl-db/tests/dbfexporttest.lpi
Normal file
113
packages/fcl-db/tests/dbfexporttest.lpi
Normal file
@ -0,0 +1,113 @@
|
|||||||
|
<?xml version="1.0"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="9"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<General>
|
||||||
|
<Flags>
|
||||||
|
<SaveOnlyProjectUnits Value="True"/>
|
||||||
|
</Flags>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<Title Value="dbfexporttest"/>
|
||||||
|
<ResourceType Value="res"/>
|
||||||
|
</General>
|
||||||
|
<i18n>
|
||||||
|
<EnableI18N LFM="False"/>
|
||||||
|
</i18n>
|
||||||
|
<VersionInfo>
|
||||||
|
<StringTable ProductVersion=""/>
|
||||||
|
</VersionInfo>
|
||||||
|
<BuildModes Count="2">
|
||||||
|
<Item1 Name="Default" Default="True"/>
|
||||||
|
<Item2 Name="Debug">
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="10"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<CodeGeneration>
|
||||||
|
<Checks>
|
||||||
|
<IOChecks Value="True"/>
|
||||||
|
<RangeChecks Value="True"/>
|
||||||
|
<OverflowChecks Value="True"/>
|
||||||
|
<StackChecks Value="True"/>
|
||||||
|
</Checks>
|
||||||
|
</CodeGeneration>
|
||||||
|
<Linking>
|
||||||
|
<Debugging>
|
||||||
|
<GenerateDebugInfo Value="True"/>
|
||||||
|
<GenerateDwarf Value="True"/>
|
||||||
|
<UseHeaptrc Value="True"/>
|
||||||
|
</Debugging>
|
||||||
|
</Linking>
|
||||||
|
<Other>
|
||||||
|
<CompilerMessages>
|
||||||
|
<UseMsgFile Value="True"/>
|
||||||
|
</CompilerMessages>
|
||||||
|
<CompilerPath Value="$(CompPath)"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
</Item2>
|
||||||
|
</BuildModes>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||||
|
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<local>
|
||||||
|
<FormatVersion Value="1"/>
|
||||||
|
<CommandLineParams Value="-a --format=plain"/>
|
||||||
|
<LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
|
||||||
|
</local>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="2">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="FPCUnitConsoleRunner"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<PackageName Value="FCL"/>
|
||||||
|
</Item2>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="2">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="dbfexporttest.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="dbfexporttest"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="dbfexporttestcase1.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="dbfexporttestcase1"/>
|
||||||
|
</Unit1>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="10"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<Other>
|
||||||
|
<CompilerMessages>
|
||||||
|
<UseMsgFile Value="True"/>
|
||||||
|
</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>
|
||||||
28
packages/fcl-db/tests/dbfexporttest.lpr
Normal file
28
packages/fcl-db/tests/dbfexporttest.lpr
Normal file
@ -0,0 +1,28 @@
|
|||||||
|
program dbfexporttest;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes,
|
||||||
|
consoletestrunner,
|
||||||
|
dbfexporttestcase1;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TLazTestRunner }
|
||||||
|
|
||||||
|
TMyTestRunner = class(TTestRunner)
|
||||||
|
protected
|
||||||
|
// override the protected methods of TTestRunner to customize its behavior
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Application: TMyTestRunner;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application := TMyTestRunner.Create(nil);
|
||||||
|
Application.Initialize;
|
||||||
|
Application.Run;
|
||||||
|
Application.Free;
|
||||||
|
end.
|
||||||
|
|
||||||
600
packages/fcl-db/tests/dbfexporttestcase1.pas
Normal file
600
packages/fcl-db/tests/dbfexporttestcase1.pas
Normal file
@ -0,0 +1,600 @@
|
|||||||
|
unit dbfexporttestcase1;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, Fpcunit, Testutils, Testregistry, DB, fpdbfexport,
|
||||||
|
BufDataset, dateutils;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TTestDBFExport1 }
|
||||||
|
|
||||||
|
TTestDBFExport1 = class(Ttestcase)
|
||||||
|
const
|
||||||
|
KeepFilesAfterTest = false;
|
||||||
|
//Change if you want to keep export files for further testing
|
||||||
|
private
|
||||||
|
procedure FillTestData;
|
||||||
|
protected
|
||||||
|
FTestDataset: TBufDataset;
|
||||||
|
FExportTempDir: string; //where we store exported files in these tests
|
||||||
|
procedure FillRecord(const RowNumber: integer; const Teststring: string;
|
||||||
|
const TestGUID: string; const TestInteger: integer;
|
||||||
|
const TestExtended: extended; const TestDatetime: Tdatetime;
|
||||||
|
const TestBoolean: boolean);
|
||||||
|
procedure Setup; override;
|
||||||
|
procedure Teardown; override;
|
||||||
|
published
|
||||||
|
procedure TestDBExportRuns;
|
||||||
|
end;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
function FileSize(FileName: string): integer;
|
||||||
|
// LCL has similar function, but we don't want to depend on that.
|
||||||
|
var
|
||||||
|
SearchResult: TSearchRec;
|
||||||
|
begin
|
||||||
|
Result := 0;
|
||||||
|
if FindFirst(FileName, faAnyFile, SearchResult) = 0 then
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
Result := SearchResult.Size;
|
||||||
|
finally
|
||||||
|
FindClose(SearchResult);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestDBFExport1.TestDBExportRuns;
|
||||||
|
|
||||||
|
var
|
||||||
|
Export: TFPDBFExport;
|
||||||
|
ExportSettings: TDBFExportFormatSettings;
|
||||||
|
NumberExported: integer;
|
||||||
|
begin
|
||||||
|
Export := TFPDBFExport.Create(nil);
|
||||||
|
ExportSettings:=TDBFExportFormatSettings.Create(true);
|
||||||
|
try
|
||||||
|
//Don't override decimal separator
|
||||||
|
ExportSettings.TableFormat:=tfDBaseVII; //dbase IV seems to have a 10 character field name limit
|
||||||
|
Export.FormatSettings:=ExportSettings;
|
||||||
|
Export.Dataset := FTestDataset;
|
||||||
|
Export.FileName := FExportTempDir + 'dbfexporttest.dbf';
|
||||||
|
NumberExported := Export.Execute;
|
||||||
|
FTestDataset.Close;
|
||||||
|
AssertEquals('Number of records exported', NumberExported, FTestDataset.RecordCount);
|
||||||
|
AssertTrue('Output file created', FileExists(Export.FileName));
|
||||||
|
AssertTrue('Output file has contents', (FileSize(Export.FileName) > 0));
|
||||||
|
finally
|
||||||
|
if (KeepFilesAfterTest = False) then
|
||||||
|
begin
|
||||||
|
DeleteFile(Export.FileName);
|
||||||
|
end;
|
||||||
|
ExportSettings.Free;
|
||||||
|
Export.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TTestDBFExport1.FillTestData;
|
||||||
|
var
|
||||||
|
RowNumber: integer; //Keep track of how many rows we inserted
|
||||||
|
TestBoolean: boolean;
|
||||||
|
TestDateTime: TDateTime;
|
||||||
|
TestExtended: extended;
|
||||||
|
//yes, a lot of precision; we can convert to single/double if required
|
||||||
|
TestInteger: integer;
|
||||||
|
TestGuid: string;
|
||||||
|
TestString: string;
|
||||||
|
begin
|
||||||
|
FTestDataset.Close;
|
||||||
|
RowNumber := 0;
|
||||||
|
//for memds:
|
||||||
|
//FTestDataset.Clear(False); //memds: clear out any data
|
||||||
|
//FTestDataset.Fields.Clear; //bufds: clear out any data, but also FIELDDEFS: don't use
|
||||||
|
FTestDataset.Open;
|
||||||
|
|
||||||
|
// Fill some test data
|
||||||
|
// First row: positive numerical values, late dates/times, strings with special chars (tab, linefeed, ; > <)
|
||||||
|
FTestDataset.Append;
|
||||||
|
TestBoolean := True;
|
||||||
|
TestDateTime := EncodeDate(9999, 12, 31) + EncodeTime(23, 59, 59, 999);
|
||||||
|
TestExtended := 42.424242424242424242424242424242;
|
||||||
|
TestInteger := Round(TestExtended);
|
||||||
|
TestGuid := '{21EC2020-3AEA-1069-A2DD-08002B30309D}';
|
||||||
|
TestString := 'Douglas Adams less than: < greater than > tab:' +
|
||||||
|
#9 + 'crlf:' + #13 + #10 +
|
||||||
|
'國缺界广欠廣界界东缺. Haddock drinks rosé (ros, e accent aigu), водка (wodka cyrillic) and ούζο (ouzo Greek) but prefers Loch Lomond whiskey.';
|
||||||
|
RowNumber := RowNumber + 1;
|
||||||
|
FillRecord(RowNumber, Teststring, TestGUID, Testinteger, Testextended,
|
||||||
|
Testdatetime, Testboolean);
|
||||||
|
FTestDataset.Post;
|
||||||
|
|
||||||
|
// Second row: negative numerical values, early dates/times, strings with maximum field width and Greek, east asian (multibyte) characters
|
||||||
|
FTestDataset.Append;
|
||||||
|
TestBoolean := False;
|
||||||
|
TestDateTime := EncodeDate(1, 1, 1) + EncodeTime(0, 0, 0, 1);
|
||||||
|
TestExtended := -42.424242424242424242424242424242;
|
||||||
|
TestInteger := Round(TestExtended);
|
||||||
|
TestGuid := '{FFFFFFFF-FFFF-FFFF-FFFF-FFFFFFFFFFFF}';
|
||||||
|
TestString := 'ARMA virumque cano, Troiae qui primus ab oris' +
|
||||||
|
#13 + #10 + 'Italiam, fato profugus, Laviniaque venit' + #13 +
|
||||||
|
#10 + 'litora, multum ille et terris iactatus et alto' + #13 +
|
||||||
|
#10 + 'vi superum saevae memorem Iunonis ob iram;' + #13 + #10 +
|
||||||
|
'multa quoque et bello passus, dum conderet urbem,' + #13 + #10 +
|
||||||
|
'inferretque deos Latio, genus unde Latinum,' + #13 + #10 +
|
||||||
|
'Albanique patres, atque altae moenia Romae.' + #13 + #10 + #13 +
|
||||||
|
#10 + 'Musa, mihi causas memora, quo numine laeso,' + #13 + #10 +
|
||||||
|
'quidve dolens, regina deum tot volvere casus' + #13 + #10 +
|
||||||
|
'insignem pietate virum, tot adire labores' + #13 + #10 +
|
||||||
|
'impulerit. Tantaene animis caelestibus irae?' + #13 + #10 +
|
||||||
|
#13 + #10 + 'Urbs antiqua fuit, Tyrii tenuere coloni,' + #13 +
|
||||||
|
#10 + 'Karthago, Italiam contra Tiberinaque longe' + #13 + #10 +
|
||||||
|
'ostia, dives opum studiisque asperrima belli;' + #13 + #10 +
|
||||||
|
'quam Iuno fertur terris magis omnibus unam' + #13 + #10 +
|
||||||
|
'posthabita coluisse Samo; hic illius arma,' + #13 + #10 +
|
||||||
|
'hic currus fuit; hoc regnum dea gentibus esse,' + #13 + #10 +
|
||||||
|
'si qua fata sinant, iam tum tenditque fovetque.' + #13 + #10 +
|
||||||
|
'Progeniem sed enim Troiano a sanguine duci' + #13 + #10 +
|
||||||
|
'audierat, Tyrias olim quae verteret arces;' + #13 + #10 +
|
||||||
|
'hinc populum late regem belloque superbum' + #13 + #10 +
|
||||||
|
'venturum excidio Libyae: sic volvere Parcas.' + #13 + #10 +
|
||||||
|
'Id metuens, veterisque memor Saturnia belli,' + #13 + #10 +
|
||||||
|
'prima quod ad Troiam pro caris gesserat Argis---' + #13 + #10 +
|
||||||
|
'necdum etiam causae irarum saevique dolores' + #13 + #10 +
|
||||||
|
'exciderant animo: manet alta mente repostum' + #13 + #10 +
|
||||||
|
'iudicium Paridis spretaeque iniuria formae,' + #13 + #10 +
|
||||||
|
'et genus invisum, et rapti Ganymedis honores.' + #13 + #10 +
|
||||||
|
'His accensa super, iactatos aequore toto' + #13 + #10 +
|
||||||
|
'Troas, reliquias Danaum atque immitis Achilli,' + #13 + #10 +
|
||||||
|
'arcebat longe Latio, multosque per annos' + #13 + #10 +
|
||||||
|
'errabant, acti fatis, maria omnia circum.' + #13 + #10 +
|
||||||
|
'Tantae molis erat Romanam condere gentem!';
|
||||||
|
RowNumber := RowNumber + 1;
|
||||||
|
FillRecord(RowNumber, Teststring, TestGUID, Testinteger, Testextended,
|
||||||
|
Testdatetime, Testboolean);
|
||||||
|
FTestDataset.Post;
|
||||||
|
|
||||||
|
// Third row: empty/zero numerical values, dates/times, strings
|
||||||
|
FTestDataset.Append;
|
||||||
|
TestBoolean := False;
|
||||||
|
TestDateTime := EncodeDate(1, 1, 1) + EncodeTime(0, 0, 0, 0);
|
||||||
|
TestExtended := 0;
|
||||||
|
TestInteger := Round(TestExtended);
|
||||||
|
TestGuid := '{3F2504E0-4F89-11D3-9A0C-0305E82C3301}';
|
||||||
|
TestString := '';
|
||||||
|
RowNumber := RowNumber + 1;
|
||||||
|
FillRecord(RowNumber, Teststring, TestGUID, Testinteger, Testextended,
|
||||||
|
Testdatetime, Testboolean);
|
||||||
|
FTestDataset.Post;
|
||||||
|
|
||||||
|
// Fourth row: plausible data
|
||||||
|
FTestDataset.Append;
|
||||||
|
TestBoolean := True;
|
||||||
|
TestDateTime := EncodeDate(2005, 9, 10) + EncodeTime(13, 52, 18, 0);
|
||||||
|
TestExtended := 42;
|
||||||
|
TestInteger := Round(TestExtended);
|
||||||
|
TestString := 'The answer to life, the universe, and everything';
|
||||||
|
RowNumber := RowNumber + 1;
|
||||||
|
FillRecord(RowNumber, Teststring, TestGUID, Testinteger, Testextended,
|
||||||
|
Testdatetime, Testboolean);
|
||||||
|
FTestDataset.Post;
|
||||||
|
|
||||||
|
// Make sure recordcount is correct:
|
||||||
|
FTestDataset.Last;
|
||||||
|
FTestDataset.First;
|
||||||
|
AssertEquals('Number of records in test dataset', RowNumber, FTestDataset.RecordCount);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestDBFExport1.Setup;
|
||||||
|
const
|
||||||
|
NumberOfDecimals = 2;
|
||||||
|
NumberOfBytes = 10;
|
||||||
|
var
|
||||||
|
FieldDef: TFieldDef;
|
||||||
|
begin
|
||||||
|
FExportTempDir := GetTempDir(False);
|
||||||
|
FTestDataset := TBufDataset.Create(nil);
|
||||||
|
{Tweaked for dbf export}
|
||||||
|
{We should cover all data types defined in FPC:
|
||||||
|
|
||||||
|
FPC maps "external" types such as ftOracleBlob to
|
||||||
|
internal types, but that can be overridden, which is done
|
||||||
|
by e.g. IBX and mseide.
|
||||||
|
So it makes sense to keep as many datatypes in the exporter code as possible: it documents the mappings and allows other people to use these types without the exporter breaking.
|
||||||
|
}
|
||||||
|
{Sorted by datatype; commented out what doesn't work at the moment in bufdataset
|
||||||
|
See http://docwiki.embarcadero.com/VCL/en/DB.TField.Size for overview of field sizes in the competition product ;)
|
||||||
|
Apparently ftGuid also needs size...
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftADT';
|
||||||
|
FieldDef.DataType := ftADT;
|
||||||
|
FieldDef.Size := 4096;//large but hopefully not too large for memory.
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftArray';
|
||||||
|
FieldDef.DataType := ftArray;
|
||||||
|
FieldDef.Size := 10;//the number of elements in the array
|
||||||
|
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftAutoInc';
|
||||||
|
FieldDef.DataType := ftAutoInc;
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
//Not supported by DBF:
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftBCD';
|
||||||
|
FieldDef.DataType := ftBCD;
|
||||||
|
FieldDef.Size := NumberOfDecimals;
|
||||||
|
//Size is the number of digits after the decimal place
|
||||||
|
}
|
||||||
|
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
//Note dbf 3 has a 10 character field length limit
|
||||||
|
FieldDef.Name := 'ftBlob_4096';
|
||||||
|
FieldDef.DataType := ftBlob;
|
||||||
|
FieldDef.Size := 4096;//large but hopefully not too large for memory.
|
||||||
|
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftBoolean';
|
||||||
|
FieldDef.DataType := ftBoolean;
|
||||||
|
|
||||||
|
{
|
||||||
|
//Not supported by DBF:
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftBytes';
|
||||||
|
FieldDef.DataType := ftBytes;
|
||||||
|
FieldDef.Size := NumberOfBytes;
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftCurrency';
|
||||||
|
FieldDef.DataType := ftCurrency;
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftCursor';
|
||||||
|
FieldDef.DataType := ftCursor;
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftDataSet';
|
||||||
|
FieldDef.DataType := ftDataSet;
|
||||||
|
}
|
||||||
|
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftDate';
|
||||||
|
FieldDef.DataType := ftDate;
|
||||||
|
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftDateTime';
|
||||||
|
FieldDef.DataType := ftDateTime;
|
||||||
|
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftDBaseOle';
|
||||||
|
FieldDef.DataType := ftDBaseOle;
|
||||||
|
FieldDef.Size := 4096;//large but hopefully not too large for memory.
|
||||||
|
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftFixedChar_2';
|
||||||
|
FieldDef.DataType := ftFixedChar;
|
||||||
|
FieldDef.Size := NumberOfDecimals;
|
||||||
|
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftFixedWideChar_2';
|
||||||
|
FieldDef.DataType := ftFixedWideChar;
|
||||||
|
FieldDef.Size := NumberOfBytes;
|
||||||
|
}
|
||||||
|
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftFloat';
|
||||||
|
FieldDef.DataType := ftFloat;
|
||||||
|
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftFMTBcd';
|
||||||
|
FieldDef.DataType := ftFMTBcd;
|
||||||
|
FieldDef.Size := NumberOfDecimals; //the number of digits after the decimal place.
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftFmtMemo';
|
||||||
|
FieldDef.DataType := ftFmtMemo;
|
||||||
|
FieldDef.Size := 4096;//large but hopefully not too large for memory.
|
||||||
|
}
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftGraphic';
|
||||||
|
FieldDef.DataType := ftGraphic;
|
||||||
|
FieldDef.Size := 4096;//large but hopefully not too large for memory.
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftGuid';
|
||||||
|
FieldDef.DataType := ftGuid;
|
||||||
|
FieldDef.Size := 38;
|
||||||
|
//Apparently right answer is not 42; had to look up 38 in source code.
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftIDispatch';
|
||||||
|
FieldDef.DataType := ftIDispatch;
|
||||||
|
}
|
||||||
|
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftInteger';
|
||||||
|
FieldDef.DataType := ftInteger;
|
||||||
|
|
||||||
|
{
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftInterface';
|
||||||
|
FieldDef.DataType := ftInterface;
|
||||||
|
}
|
||||||
|
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftLargeint';
|
||||||
|
FieldDef.DataType := ftLargeint;
|
||||||
|
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftMemo';
|
||||||
|
FieldDef.DataType := ftMemo;
|
||||||
|
FieldDef.Size := 4096;//large but hopefully not too large for memory.
|
||||||
|
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftOraBlob';
|
||||||
|
FieldDef.DataType := ftOraBlob;
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftOraClob';
|
||||||
|
FieldDef.DataType := ftOraClob;
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftParadoxOle';
|
||||||
|
FieldDef.DataType := ftParadoxOle;
|
||||||
|
FieldDef.Size := 4096;//large but hopefully not too large for memory.
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftReference';
|
||||||
|
FieldDef.DataType := ftReference;
|
||||||
|
}
|
||||||
|
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftSmallInt';
|
||||||
|
FieldDef.DataType := ftInteger;
|
||||||
|
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftString_1';
|
||||||
|
FieldDef.DataType := ftString;
|
||||||
|
FieldDef.Size := 1;
|
||||||
|
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftString_256'; //1 character more than many db string types support
|
||||||
|
FieldDef.DataType := ftString;
|
||||||
|
FieldDef.Size := 256;
|
||||||
|
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftTime';
|
||||||
|
FieldDef.DataType := ftTime;
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftTimeStamp';
|
||||||
|
FieldDef.DataType := ftTimeStamp;
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftTypedBinary';
|
||||||
|
FieldDef.DataType := ftTypedBinary;
|
||||||
|
FieldDef.Size := 4096;//large but hopefully not too large for memory.
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
//Not supported by dbf: FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftVariant';
|
||||||
|
FieldDef.DataType := ftVariant;
|
||||||
|
FieldDef.Size := NumberOfBytes;
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftVarBytes';
|
||||||
|
FieldDef.DataType := ftVarBytes;
|
||||||
|
FieldDef.Size := NumberOfBytes;
|
||||||
|
}
|
||||||
|
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftWideMemo';
|
||||||
|
FieldDef.DataType := ftWideMemo;
|
||||||
|
}
|
||||||
|
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftWideString256';
|
||||||
|
FieldDef.DataType := ftWideString;
|
||||||
|
FieldDef.Size := 256;
|
||||||
|
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'ftWord';
|
||||||
|
FieldDef.DataType := ftWord;
|
||||||
|
|
||||||
|
//Finally, a long field name that should trigger
|
||||||
|
//field renaming code in dbf export
|
||||||
|
//(dbase VII supports up to 32 characters, others up to 10)
|
||||||
|
FieldDef := FTestDataset.FieldDefs.AddFieldDef;
|
||||||
|
FieldDef.Name := 'AVeryLongFieldDataTypeDoesNotMatter';
|
||||||
|
FieldDef.DataType := ftString;
|
||||||
|
FieldDef.Size := 256;
|
||||||
|
|
||||||
|
//Createtable is needed if you use a memds
|
||||||
|
//FTestDataset.CreateTable;
|
||||||
|
//CreateDataset is needed if you use a bufdataset
|
||||||
|
FTestDataset.CreateDataSet;
|
||||||
|
|
||||||
|
// Fill dataset with test data
|
||||||
|
FillTestData;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestDBFExport1.FillRecord(const RowNumber: integer;
|
||||||
|
const TestString: string; const TestGUID: string; const TestInteger: integer;
|
||||||
|
const TestExtended: extended; const TestDatetime: Tdatetime;
|
||||||
|
const TestBoolean: boolean);
|
||||||
|
var
|
||||||
|
FieldCounter: integer;
|
||||||
|
begin
|
||||||
|
writeln('*** Starting to fill row ' + IntToStr(RowNumber));
|
||||||
|
{As our bufdataset doesn't support these datatypes, don't use them:
|
||||||
|
ftAutoInc -> exists but doesn't seem to return any data.
|
||||||
|
ftCursor
|
||||||
|
ftDataSet
|
||||||
|
ftInterface
|
||||||
|
ftReference
|
||||||
|
ftTimeStamp}
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FTestDataset.FieldByName('ftBCD').AsFloat := Testextended;
|
||||||
|
}
|
||||||
|
FTestDataset.FieldByName('ftBlob_4096').AsString := Teststring;
|
||||||
|
FTestDataset.FieldByName('ftBoolean').AsBoolean := Testboolean;
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FTestDataset.FieldByName('ftBytes').AsString := Teststring;
|
||||||
|
}
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FTestDataset.FieldByName('ftCurrency').Ascurrency := Testextended;
|
||||||
|
}
|
||||||
|
FTestDataset.FieldByName('ftDate').AsDateTime := Testdatetime;
|
||||||
|
FTestDataset.FieldByName('ftDateTime').AsDateTime := Testdatetime;
|
||||||
|
FTestDataset.FieldByName('ftDBaseOle').AsString := Teststring;
|
||||||
|
FTestDataset.FieldByName('ftFixedChar_2').AsString := Teststring;
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FTestDataset.FieldByName('ftFixedWideChar_2').AsString := Teststring;
|
||||||
|
}
|
||||||
|
FTestDataset.FieldByName('ftFloat').AsFloat := Testextended;
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FTestDataset.FieldByName('ftFMTBcd').AsFloat := Testextended;
|
||||||
|
}
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FTestDataset.FieldByName('ftFmtMemo').AsString := Teststring;
|
||||||
|
}
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FTestDataset.FieldByName('ftGraphic').AsString := Teststring;
|
||||||
|
}
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FTestDataset.FieldByName('ftGuid').AsString := TestGUID;
|
||||||
|
}
|
||||||
|
FTestDataset.FieldByName('ftInteger').AsInteger := Testinteger;
|
||||||
|
FTestDataset.FieldByName('ftLargeint').AsInteger := Testinteger;
|
||||||
|
FTestDataset.FieldByName('ftMemo').AsString := Teststring;
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FTestDataset.FieldByName('ftOraBlob').AsString := Teststring;
|
||||||
|
}
|
||||||
|
{
|
||||||
|
FTestDataset.FieldByName('ftOraClob').AsString := Teststring;
|
||||||
|
}
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FTestDataset.FieldByName('ftParadoxOle').AsString := Teststring;
|
||||||
|
}
|
||||||
|
FTestDataset.FieldByName('ftSmallInt').AsInteger := Testinteger;
|
||||||
|
FTestDataset.FieldByName('ftString_1').AsString := Teststring;
|
||||||
|
FTestDataset.FieldByName('ftString_256').AsString := Teststring;
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FTestDataset.FieldByName('ftTime').AsDateTime := Testdatetime;
|
||||||
|
}
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FTestDataset.FieldByName('ftTypedBinary').AsString := Teststring;
|
||||||
|
}
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FTestDataSet.FieldByName('ftVarBytes').AsString := TestString;
|
||||||
|
}
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FTestDataSet.FieldByName('ftVariant').AsString := TestString;
|
||||||
|
}
|
||||||
|
{
|
||||||
|
//Not supported by dbf:
|
||||||
|
FTestDataset.FieldByName('ftWideMemo').AsString := Teststring;
|
||||||
|
}
|
||||||
|
FTestDataset.FieldByName('ftWideString256').AsString := Teststring;
|
||||||
|
FTestDataset.FieldByName('ftWord').AsInteger := Abs(Testinteger);
|
||||||
|
FTestDataset.FieldByName('AVeryLongFieldDataTypeDoesNotMatter').AsString := Teststring;
|
||||||
|
{
|
||||||
|
for Fieldcounter := 0 to FTestDataset.Fields.Count - 1 do
|
||||||
|
begin
|
||||||
|
try
|
||||||
|
writeln('Field: ' + FTestDataset.Fields[FieldCounter].FieldName +
|
||||||
|
' has value ' + FTestDataset.Fields[FieldCounter].AsString);
|
||||||
|
{writeln('Field: ' + FTestDataset.Fields[FieldCounter].FieldName +
|
||||||
|
' has displaytext ' + FTestDataset.Fields[FieldCounter].DisplayText);}
|
||||||
|
except
|
||||||
|
on E: Exception do
|
||||||
|
begin
|
||||||
|
writeln('Field: ' + FTestDataset.Fields[FieldCounter].FieldName +
|
||||||
|
': error retrieving value: ');
|
||||||
|
writeln(E.ClassName, '; detailed error message: ', E.message);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
}
|
||||||
|
writeln('*** Finished filling row ' + IntToStr(RowNumber));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestDBFExport1.Teardown;
|
||||||
|
begin
|
||||||
|
FTestDataset.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
Registertest(TTestDBFExport1);
|
||||||
|
end.
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user