paradox-daten als csv speichern

[eddy]

Hallo bastos,

getestet und funktionsfähig:

Code:

procedure TFBrowser.ANSII1Click(Sender: TObject);
var
  abbr : boolean;
  headtxt, tx, s : string;
  i, j : integer;
  v : variant;
  ftyp : TFieldType;
begin
  if not Tab1.Active then exit;
  headtxt := FBrowser.Caption;
  s := ExtractFileName(Tab1.TableName);
  s := Copy(s,1,Pos('.',s)) + 'TXT';
  AssignFile(f, BrowDataPath + s);
  FBrowser.Caption := FBrowser.Caption + '     ' + Upper(BrowDataPath) + Lower(s);
  {$I-}
  Rewrite(f);
  if (IOResult) = 0 then begin
    InitGau(BotGau, Tab1);
    Tab1.DisableControls;
    tx := '';
    for i:= 0 to Tab1.FieldCount - 1 do begin
      if i > 0 then s := Tab1.FieldDefs.Items[i].Name;
      tx := tx + Upper(s);
      if i < Tab1.FieldCount - 1 then tx := tx + ';';
    end;
    WriteLn(f,tx);
    abbr := IOResult <> 0;
    Tab1.First;
    while (not abbr) and (not Tab1.Eof) do begin
      tx := '';
      for i:= 0 to Tab1.FieldCount - 1 do begin
        s := '';
        v := Tab1.Fields[i].AsVariant;
//        if v = Null then begin
//          ftyp  := Tab1.FieldDefs.Items[i].DataType;
//        end;
        ftyp  := Tab1.FieldDefs.Items[i].DataType;
        try
        case ftyp of
          ftString    :   if v = Null then s := '' else s:=Tab1.Fields[i].AsString;     { Zeichen- oder Stringfeld';}
          ftAutoInc   :   if v = Null then s := '' else str(v:20:0,s);                  { Autoinkrement-32-Bit -Integer-Feld als Zählerfeld}
          ftBytes     : if v = Null then s := '' else str(v:5:0,s);                   { Feste Anzahl von Bytes (binäre Speicherung)}
          ftSmallint,                                   { 16-Bit-Integer-Feld}
          ftInteger,                                    { 32-Bit-Integer-Feld}
          ftWord      :   if v = Null then s := '' else str(v:20:0,s);                  { Vorzeichenloses 16-Bit-Integer-Feld}
          ftBoolean   :
            if v = Null
              then s := 'Falsch'                             { Logisches Feld}
            else
            if v = true then s := 'Wahr' else s := 'Falsch';
          ftFloat,                                      { Numerisches Gleitkommafeld}
          ftCurrency  :                                 { Währungsfeld}
            begin
              if v = Null then v := 0;
              str(v:20:4,s);
              if Pos('.',s) > 0 then s := Copy(s,1,Pos('.',s)-1) + ',' + Copy(s,Pos('.',s)+1,length(s));
            end;

          ftDate      :   if v = Null then s := '' else s := DateToStr(v);     { Datumsfeld}
          ftTime      :   if v = Null then s := '' else s := TimeToStr(v);        { Zeitfeld}
          ftDateTime  :   if v = Null then s := '' else s := DateTimeToStr(v);    { Feld für Datum und Zeit}

          ftBCD       : s:='#BCD#';         { Binärcodiertes Dezimalfeld}
          ftVarBytes  :   s:='#VarBytes#';    { Variable Anzahl von Bytes (binäre Speicherung)}
          ftBlob      : s:='#Blob#';        { BLOB-Field}
          ftMemo      : if v = Null then s:='#Memo#' else s := v;        { Memofeld für Text}
          ftGraphic   :   s:='#Graphic#';     { Bitmap-Feld}
          ftFmtMemo   :   s:='#FMemo#';       { Formatiertes Memofeld für Text}
          ftParadoxOle:   s:='#PdoxOle#';     { Paradox-OLE-Feld}
          ftDBaseOle:   s:='#dBaseOle#';    { dBASE-OLE-Feld}
          ftTypedBinary:s:='#Binary#';      { Typisiertes Binärfeld}
        else
          s:='#???#';                       { Unbekannt oder unbestimmt}
        end;  {end of case}
        except
          on E: Exception do s := '';
        end;
{        if Copy(s,1,1) <> '#' then begin}
          s := trim(s);
          j := Pos(';',s);
          while j > 0 do begin
            if j < length(s)
              then s := copy(s,1,j-1) + ',' + copy(s,j+1,length(s))
              else s := copy(s,1,j-1);
            j := Pos(';',s);
          end;

          tx := tx + s;
          if i < Tab1.FieldCount - 1 then tx := tx + ';';
{        end;}
      end;  {of for i := 0 to FieldCount - 1}
      WriteLn(f,tx);
      abbr := IOResult <> 0;
      RefreshGau(BotGau);  {, _rc_gau, _zel_gau, _rcg_gau);}
      Tab1.Next;
    end;  {end of while}
    CloseGau(BotGau);
    Tab1.First;
    Tab1.EnableControls;
  end
  else begin
    {Fehler beim Erstellen der Export-Datei}
  end;

  CloseFile(f);
  {$I+}
  FBrowser.Caption := headtxt;
end;

Hab' ich schon vor einiger Zeit geschrieben, steht vielleicht ein bischen mehr drin als nötig, aber als Beispiel sollte es funktionieren.

mfg
eddy