Oops, I have now uploaded the program source to the Bug tracker. Also
reproduced here ...
program dbftest;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, dbf, db;
{ you can add units after this }
var
dbase: Tdbf;
s: string;
dbname: string;
cwd: string;
out_filename: string = 'test.csv';
outfile: Text;
header: boolean = false;
buf: string;
sep: string;
rec_count: integer = 0;
field_count: integer;
fieldname: string;
i, x: integer;
begin
Assign(outfile,out_filename);
Rewrite(outfile);
buf := '';
dbase := TDbf.Create(nil);
GetDir(0,cwd);
dbase.FilePathFull := cwd;
dbase.TableName := 'BOX78.dbf';
dbase.ReadOnly := true;
dbase.Open;
field_count := dbase.FieldCount;
writeln('Table level is ', dbase.TableLevel, '. Number of fields is
', field_count);
sep := '';
for i := 0 to field_count - 1 do begin
writeln(dbase.Fielddefs[i].Name, ', ', dbase.FieldDefs[i].DataType);
buf := buf + sep + trim(dbase.Fielddefs[i].Name);
sep := ',';
end;
if header then writeln(outfile,buf);
while not dbase.EOF do begin
inc(rec_count);
buf := '';
sep := '';
for i := 0 to field_count - 1 do begin
fieldname := trim(dbase.Fielddefs[i].Name);
case dbase.FieldDefs[i].DataType of
ftString, ftMemo:
buf := buf + sep + '"' +
trim(dbase.FieldByName(fieldname).AsString) + '"';
ftInteger, ftSmallInt:
buf := buf + sep +
trim(dbase.FieldByName(fieldname).AsString);
end;
sep := ',';
end;
writeln(outfile,buf);
dbase.Next;
end;
writeln(inttostr(rec_count) + ' records read.');
dbase.Close;
dbase.Destroy;
Close(outfile);
end.
Dave.
On 06/13/2014 04:42 AM, Reinier Olislagers wrote:
> On 12/06/2014 20:37, David Copeland wrote:
>> Added to the Bug tracker as Issue 26332.
> Hi Dave,
>
> Although you wrote in the bug report that the attached zip contains test
> source code, it doesn't. Could you attach a simple (FPC) test program to
> the bug report that demonstrates the problem?
>
> Thanks,
> Reinier
> _______________________________________________
> fpc-pascal maillist - fpc-pascal@lists.freepascal.org
> http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
