Autor Téma: Pack DBaseFile  (Přečteno 624 krát)

Offline PetrB0

  • Plnoletý
  • ***
  • Příspěvků: 140
  • Karma: 1
    • Verze Delphi: Delphi XE2, Delphi 10.2 Tokyo, Delphi 10.41
Pack DBaseFile
« kdy: 13-02-2022, 03:19:28 »
Ahoj,
mám poměrně starou aplikaci, která používá ještě DBase soubory. Vím, že to je trochu starší přístup, ale potřeboval bych ty soubory programově pročistit (skutečně smazat zrušené položky).
kdysi dávno jsem používal tuto rutinu (někde opsáno)
Kód: [Vybrat]
// Pack a Paradox or dBASE table
// The table must be opened execlusively before calling this function...
procedure PackTable(Table: TTable);
var
  Props: CURProps;
  hDb: hDBIDb;
  TableDesc: CRTblDesc;

begin
  // Make sure the table is open exclusively so we can get the db handle...
  if Table.Active = False then
    raise EDatabaseError.Create('Tabulka musí být otevřená');
  if Table.Exclusive = False then
    raise EDatabaseError.Create('Tabulka musí být používána exklusivně');

  // Get the table properties to determine table type...
  Check(DbiGetCursorProps(Table.Handle, Props));

  // If the table is a Paradox table, you must call DbiDoRestructure...
  if Props.szTableType = szPARADOX then
  begin
    // Blank out the structure...
    FillChar(TableDesc, sizeof(TableDesc), 0);
    //  Get the database handle from the table's cursor handle...
    Check(DbiGetObjFromObj(hDBIObj(Table.Handle), objDATABASE, hDBIObj(hDb)));
    // Put the table name in the table descriptor...
    StrPCopy(TableDesc.szTblName, Table.TableName);
    // Put the table type in the table descriptor...
    StrPCopy(TableDesc.szTblType, Props.szTableType);
    // Set the Pack option in the table descriptor to TRUE...
    TableDesc.bPack := True;
    // Close the table so the restructure can complete...
    Table.Close;
    // Call DbiDoRestructure...
    Check(DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, FALSE));
  end
  else
    // If the table is a dBASE table, simply call DbiPackTable...
    if Props.szTableType = szDBASE then
     Try
       Check(DbiPackTable(Table.DBHandle, Table.Handle, nil, szDBASE, TRUE))
     Except
      On E:Exception Do
       Writeln(Format('Pri komprimaci tabulky "%s"(database "%s") doslo k chybe "%s"',[Table.TableName,Table.DatabaseName,E.Message]))
     End
    else
      // Pack only works on PAradox or dBASE; nothing else...
      raise EDatabaseError.Create('Tabulka musí být Paradox nebo dBASE ');
//  Table.Open;
end;

Problém je v tom, že je to poměrně nespolehlivá rutina. Jednou tabulku pročistí, podruhé hází exception v části "       Check(DbiPackTable(Table.DBHandle, Table.Handle, nil, szDBASE, TRUE))", kterou ani přes ten blok TryExcept neodchytím.

Nemáte něco lepšího, co by 100% fungovalo? Používám Delphi XE2. Když je nejhůře, tak zprovozním Borland Database Desktop, ale ten se moc nemá rád s Win10, takže je to trochu komplikované.

Díky

Offline Jan Fiala

  • Hrdina
  • ****
  • Příspěvků: 385
  • Karma: 4
    • Verze Delphi: 10.4.1
    • PSPad editor
Re:Pack DBaseFile
« Odpověď #1 kdy: 13-02-2022, 12:10:07 »
Napiš si servisní program, který zkopíruje záznamy do jiné fyzické tabulky, až doběhne, původní smaž a tuhle přejmenuj na původní. To pakování probíhá v podstatě stejně.

Offline vandrovnik

  • Padawan
  • ******
  • Příspěvků: 1512
  • Karma: 52
    • Verze Delphi: 11.3
Re:Pack DBaseFile
« Odpověď #2 kdy: 13-02-2022, 13:13:54 »
Když není zbytí, používám tDbf, mám dojem, že umí PackTable.
https://sourceforge.net/projects/tdbf/

Mám tady verzi 7.0.1 s nějakými změnami (oprava podpory NULL, jestli si dobře vzpomínám), ale přidám si tam vždy balíčky pro novější Delphi, takže to funguje i pod Delphi 11, když tak mohu poslat.

Offline PetrB0

  • Plnoletý
  • ***
  • Příspěvků: 140
  • Karma: 1
    • Verze Delphi: Delphi XE2, Delphi 10.2 Tokyo, Delphi 10.41
Re:Pack DBaseFile
« Odpověď #3 kdy: 13-02-2022, 13:15:42 »
Ahoj,
asi tou cestou půjdu. Protože ta rutina funguje jenom u první tabulky (pakuji jich více) u dalších prostě kolabuje a běží někam úplně do háje.
Ale říkal jsem si, že má někdo třeba ještě nějaké jiné řešení.
Každopádně díky za tip. Přijde mi jako nejspolehlivější.

Pb

P.S. Vandrovník, možná na to ještě kouknu. Díky.

Offline PetrB0

  • Plnoletý
  • ***
  • Příspěvků: 140
  • Karma: 1
    • Verze Delphi: Delphi XE2, Delphi 10.2 Tokyo, Delphi 10.41
Re:Pack DBaseFile
« Odpověď #4 kdy: 14-02-2022, 00:35:08 »
Tak jsem částečně úspěšný. Vytvořím novou tabulku, nakopíruju čistá data, ovšem kolabuji na tvorbě indexů.
Používám klasické TTable.AddIndex, ale obecně mohu vytvořit jenom indexy, které nejsou unique, primary nebo descending. Když chci vytvořit primární index, tak mi to hodí EAccessViolation.
Chtěl jsem to naplňovat takto, ale to mi kolabuje
Kód: [Vybrat]
  for __I := 0 to pTabulka.IndexDefs.Count-1 do
   begin
    __Def:=pTabulka.IndexDefs[__I];
    __Out.AddIndex(__Def.Name,__Def.Fields,__Def.Options);
   end;
Nevíte, co by mohlo být špatně? (Kromě toho, že to je fakt zastaralé)
Třeba mi jde vytvořit index __Out.AddIndex('iID','ID',[]) ale __Out.AddIndex('iKlic','KLIC',[ixUnique]) (v původní tabulce byl), tak ten mi končí na to Exception.
Dám mu ještě pár pokusů a pak zkusím ten TDBF

Offline pf1957

  • Padawan
  • ******
  • Příspěvků: 3506
  • Karma: 139
    • Verze Delphi: D2007, XE3, DX10
Re:Pack DBaseFile
« Odpověď #5 kdy: 14-02-2022, 09:09:29 »
ale obecně mohu vytvořit jenom indexy, které nejsou unique, primary nebo descending. Když chci vytvořit primární index, tak mi to hodí EAccessViolation.
Nikdy jsem s tim nic nedelal, ale zkusil bych ty klice vytvorit u prazdne tabulky, co se stane. Kdyz bys vytvoril vsechny, tak to max. zpomalis, ale padat na exception by to nemelo. A jinak bych hledal asi jinou cestu.

Offline Jan Fiala

  • Hrdina
  • ****
  • Příspěvků: 385
  • Karma: 4
    • Verze Delphi: 10.4.1
    • PSPad editor
Re:Pack DBaseFile
« Odpověď #6 kdy: 14-02-2022, 09:34:06 »
Tak jsem částečně úspěšný. Vytvořím novou tabulku, nakopíruju čistá data, ovšem kolabuji na tvorbě indexů.
Používám klasické TTable.AddIndex, ale obecně mohu vytvořit jenom indexy, které nejsou unique, primary nebo descending. Když chci vytvořit primární index, tak mi to hodí EAccessViolation.

jakym zpusobem vytvaris tabulku? Copy table umi vytvorit jen strukturu nebo i vcetne indexu.
Taky by se dala bytvaret tak, ze tu puvodni proste zkopirujes do jineho souboru, provedes EmptyTable a pak tam nakopirujes zaznamy.

Offline PetrB0

  • Plnoletý
  • ***
  • Příspěvků: 140
  • Karma: 1
    • Verze Delphi: Delphi XE2, Delphi 10.2 Tokyo, Delphi 10.41
Re:Pack DBaseFile
« Odpověď #7 kdy: 14-02-2022, 11:53:13 »
Tabulku tvořím tak, že vezmu hlavičku původního souboru, vynuluju tam počet záznamů a "mdx flag", překopíruju na novou lokaci. Potom to otevřu jako klasickou tabulku (TTable) a z té původní tam překopíruji požadované záznamy. Vytvoří to soubor 100% totožný s tím, který získám z Database Desktopu. V tom desktopu ty indexy ručně vytvořím, ale programově mi to jde jenom u některých. Někde na netu jsem našel zmínku o tom, že je nejprve třeba vytvořit primární index, ale to jsem zkoušel a také to nefunguje. Mám obavu, že toto je slepá cesta.
Všiml jsem si, že ta původní tabulka má property TableLevel=4, kdežto ta mnou vytvořená je TableLevel=0, ale to nevím odkud bere, protože v hlavičce souboru je to nastavené stejně.
Padá to přímo v knihovně IDDBAS32.dll při vyvolání Check(DbiAddIndex(DBHandle, nil, NativeTableName, GetTableTypeName,IndexDesc, nil));

Ještě tedy zkusím vytvořit tabulku jako TTable

Offline PetrB0

  • Plnoletý
  • ***
  • Příspěvků: 140
  • Karma: 1
    • Verze Delphi: Delphi XE2, Delphi 10.2 Tokyo, Delphi 10.41
Re:Pack DBaseFile
« Odpověď #8 kdy: 14-02-2022, 12:19:51 »
Tak jsem použil vandrovníkovu cestu a funguje to naprosto v pohodě.
Díky

P.S: tedy má nějaký problém s rušením indexu, ale to zase tak nutně nepotřebuji.
« Poslední změna: 14-02-2022, 12:32:09 od PetrB0 »