[fpc-pascal] Tdbf Memo Field Issue, 2.6.2 vs 2.6.4

[David Copeland]

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 at lists.freepascal.org
> http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal