powered by simpleCommunicator - 2.0.60     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Были вопросы, но небыло ответов касающихся паковки БД
2 сообщений из 2, страница 1 из 1
Были вопросы, но небыло ответов касающихся паковки БД
    #32126349
Aleksei
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Было очень много вопросов касающихся раздувания БД ( после удаления записи, запись реально не удаляется и как реально удалить эту запись так толковых ответов я и не нашел)
Один мудрец подал идею написать самому функцию которая это будет делать
идея хорошая - и вот, что получилось.

Пошел на сайт королевства Делфи, нашел описаловку DBF файлов и сляпал функцию.
Теперь хочу поелиться с Вами.


Function DBFPack(DBFFileName:String):Boolean;
var
F,F1:File;
B:array [1..32] of byte;
Table:Record
KolZapiseiAll:Integer;
KolZapiseiNoDelete:Integer;
RazmerAll:Integer;
KolichPolei:Integer;
end;
S:String;
I,I1,I2,I3:Integer;
Label 1;
begin
Result:=False;
Table.KolZapiseiAll:=0;
Table.KolZapiseiNoDelete:=0;
Table.RazmerAll:=0;
//Открываем файл
AssignFile(F,DBFFileName);
Reset(F,1);
//Чтение заголовка
For I:=1 to 32 do BlockRead(F,B ,1);
//Заносим обшие количество записей
Table.KolZapiseiAll:=B[5]+B[6]*256+B[7]*256*256+B[8]*256*256*256;
//Определяем общий размер записи по размерам полей
//Перебор полей
For I:=1 to 999999 do
begin
For I1:=1 to 32 do
begin
BlockRead(F,B[I1],1);
if B=13 Then goto 1;//описание полей закончилось
end;
//Суммируем размеры полей
Table.RazmerAll:=Table.RazmerAll+B[17];
end;//I

1://сохраняем количество полей
Table.KolichPolei:=I-1;
//Начало записей в таблице
//Подсчитываем не удаленные поля
For I:=1 to Table.KolZapiseiAll do
begin
For I1:=1 to Table.RazmerAll+1 do
begin
BlockRead(F,B,1);
if (B=32)and(I1=1) Then Table.KolZapiseiNoDelete:=Table.KolZapiseiNoDelete+1;
end;//I1
end;//I
//Закрываем файл
CloseFile(F);

//Открываем исходный файл для чтения
Reset(F,1);
//создаем файл (результирующий)
AssignFile(F1,DBFFileName+'_');
Rewrite(F1,1);
//Копируем заголовок
For I:=1 to 32 do BlockRead(F,B,1);
//Преобразуем количество записей в HEX
I:=0;I1:=0;I2:=0;I3:=0;
I3:=Table.KolZapiseiNoDelete div 256 div 256 div 256;
Table.KolZapiseiNoDelete:=Table.KolZapiseiNoDelete-I3*256*256*256;
I2:=Table.KolZapiseiNoDelete div 256 div 256;
Table.KolZapiseiNoDelete:=Table.KolZapiseiNoDelete-I2*256*256;
I1:=Table.KolZapiseiNoDelete div 256;
Table.KolZapiseiNoDelete:=Table.KolZapiseiNoDelete-I1*256;
I:=Table.KolZapiseiNoDelete-I1*256;
//Вносим изменения в количество записей
B[5]:=I;B[6]:=I1;B[7]:=I2;B[8]:=I3;
//Записываем
BlockWrite(F1,B,32);
//Копируем описание полей
For I:=1 to Table.KolichPolei do
begin
For I1:=1 to 32 do BlockRead(F,B[I1],1);
BlockWrite(F1,B,32);
end;//I
//ставим признак окончания полей
BlockRead(F,B,1);
//B:=13;
BlockWrite(F1,B,1);
//Перебираем записи
For I:=1 to Table.KolZapiseiAll do
begin
BlockRead(F,B,1);
//Если запись не удалена то ее копируем
if B=32 Then
begin
BlockWrite(F1,B,1);
For I1:=1 to Table.RazmerAll do
begin
BlockRead(F,B,1);
BlockWrite(F1,B,1);
end;//I1
end
else//Если запись удалена
begin
For I1:=1 to Table.RazmerAll do
begin
BlockRead(F,B,1);
end;//I1
end;//if
end;//I
//Ставим признак окончания DBF
B:=26;
BlockWrite(F1,B,1);
//Закрываем файлы
CloseFile(F);
CloseFile(F1);
DeleteFile(DBFFileName);
RenameFile(PChar(DBFFileName+'_'),Pchar(DbfFileName));
Result:=True;
end;

Т.к. я незнаю описаловки DB поэтому функция работает только с DBF файлами.

Если есть описаловка DB то подкиньте ссылку или описаловку. Буду очень благодарен

Есть одна проблема - После паковки таблицы все индексы придеться заменить.
...
Рейтинг: 0 / 0
Были вопросы, но небыло ответов касающихся паковки БД
    #32126367
Фотография tygra
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
( после удаления записи, запись реально не удаляется и как реально удалить эту запись так толковых ответов я и не нашел) \r
\r
Не менее двух раз публиковали эту функцию.\r
вот тут приведена
...
Рейтинг: 0 / 0
2 сообщений из 2, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Были вопросы, но небыло ответов касающихся паковки БД
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]