liones, если пишете о
программном сжатии, нехило бы указывать среду. непонятно, на каком языке приводить код?
для dbf можно использовать функцию dbiPackTable. а вот для Парадокса этот финт не пройдёт, нам придётся делать программную реструктуризацию таблицы, для чего заполнить соответствующую структуру и выставить ей флажок "Pack Table", аналогично тому, как это происходит в самом Database Desktop.
procedure PackTable(TblName : String);
var
tbl : TTable;
cProps : CURProps;
hDb : hDBIDb;
TblDesc : CRTblDesc;
begin
tbl := TTable.Create(nil);
with tbl do begin
Active := False;
DatabaseName := ExtractFilePath(TblName);
TableName := ExtractFileName(TblName);
Exclusive := True;
Open;
end;
SetCurrentDir(ExtractFilePath(TblName));
// открываем таблицу с эксклюзивными правами, иначе Restructure не проканает.
if not tbl.Active then
raise EDatabaseError.Create('Table must be opened to pack');
if not tbl.Exclusive then
raise EDatabaseError.Create('Table must be opened exclusively to pack');
// Get the table properties to determine table type...
Check(DbiGetCursorProps(tbl.Handle, cProps));
// для парадоксовских таблиц юзаем dbiDoRestructure
if (cProps.szTableType = szPARADOX) then
begin
// чистим структуру
FillChar(TblDesc, sizeof(TblDesc), 0);
// получаем дескриптор БД
Check(DbiGetObjFromObj(hDBIObj(tbl.Handle), objDATABASE, hDBIObj(hDb)));
// задаём имя таблицы
StrPCopy(TblDesc.szTblName, tbl.TableName);
// задаём тип таблицы
StrPCopy(TblDesc.szTblType, cProps.szTableType);
// выставляем флажок для упаковки
TblDesc.bPack := True;
// закрываем открытую таблицу, иначе dbiDoRestructure обломается
tbl.Close;
// пакуем
Check(DbiDoRestructure(hDb, 1, @TblDesc, nil, nil, nil, False));
end
else
// для DBase тупо дёргаем dbiPackTable
if (cProps.szTableType = szDBASE) then
Check(DbiPackTable(tbl.DBHandle, tbl.Handle, nil, szDBASE, True))
else
// ругаемся на таблицы всех прочих типов
raise EDatabaseError.Create('You can only pack Paradox or dBase tables!');
with tbl do begin
if Active then
Close;
Free;
end;
end;