Замучался уже. Вроде код правильный. Но не все записи удаляются те, которые должны быть удалены. Есть таблица, в которой хранятся объявления и список дат публикации. Нужно удалить те, которые не будут публиковаться. Принцип такой: есть текстовое поле с датами вида: | Цитата |
04.03.2008,05.03.2008,
|
| Цитата |
05.03.2008,06.03.2008,11.03.2008,
|
Т.е. в поле записан список дат. Ну и бывает, что поле пустое. С пустыми полями тоже удаляем. Пользователь задаёт число, допустим 14.08.2008. Что требуется? Пробежаться по всем записям таблицы и удалить...внимание... те записи, которые просрочены. Если в этом поле 04.03.2008,05.03.2008, то такую запись удаляем, ибо объявление уже публиковаться не будет после 14.08.2008. Если в этом поле 04.03.2008,05.03.2008, 15.08.2008, то такую запись НЕ удаляем, ибо объявление будет ещё публиковаться 15.08.2008. даю полный код процедуры, за помощь буду весьма признателен. | Код |
procedure TfmMain.actDelOldRecordsExecute(Sender: TObject);
Var
i2, i3, iDeleted, iCommit: integer;
slDatasDel: TStringList;//для преобразования строки в список.
bRecordDel:boolean; //удалять запись или нет
dDate:TDate;//то, что выбрал пользователь
tStart, tEnd: TTime;//для определения времени работы процедуры
begin
Screen.Cursor := crSQLWait;
actResetFilterGroupSortExecute(nil);//сбрасываем всякую сортировку, фильтрацию и группировку
tStart := Time;
bStopDelOldOblv := False;//если нажимаем Esc, то прекращаем работу процедуры
// удаляем записи, у которых в СПИСКЕ дат публикации нет будущих дат
//т.е. удаляем те объявления, которые в будущем уже не будут публиковаться.
if (not dbgReklama.DataController.DataSet.Active) then begin
MessageBox(Application.ActiveFormHandle, 'Откройте/обновите таблицу с объявлениями.', 'Внимание', MB_ICONINFORMATION or MB_OK);
exit;
end;
//даём пользователю выбрать дату
fmSelDate := TfmSelDate.Create(self);
fmSelDate.cxDateEdit1.Date := Date;
fmSelDate.Label1.caption := 'Будут удалены все объявления из базы, в которых нет дат, больше текущей включительно';
fmSelDate.Label1.Visible := true;
try
if fmSelDate.ShowModal = mrok then begin
// Screen.Cursor := crSQLWait;
dm.tReklama3.DisableControls;
dm.tReklama3.last;
dm.tReklama3.FetchAll;
slDatasDel := TStringList.create;
i3 := 0;// для ProgressBar1
iDeleted := 0;// для показа кол-ва удалённых
iCommit := 0;// для подтверждения транзакций через определённое кол-во удалённых записей
ProgressBar1.Max := dm.tReklama3.RecordCount;
ProgressBar1.Visible := true;
dm.tReklama3.AutoCommit := false;
with dm.tReklama3 do begin
while not Bof do begin
bRecordDel := True;//пока что можно удалять запись, а дальше определяем: можно или нельзя
slDatasDel.Clear;
Inc(i3);
ProgressBar1.Position := i3;
slDatasDel.text := G_ReplaceStr(FBN('datas').AsString, ',', #13);
// slDatasDel.text := StringReplace(FieldByName('datas').AsString, ',', #13, [rfReplaceAll, rfIgnoreCase]);
//идём по списку дат, если есть внутри дата, большая или равная той,
//что выбрал пользователь, то пропускаем запись и не удаляем её.
for i2 := 0 to slDatasDel.Count - 1 do begin
//показываем сколько удалено
StatusBar1.Panels[1].Text := 'Удалено: '+IntToStr(iDeleted);
Application.ProcessMessages;
if slDatasDel[i2] <> '' then begin//пустую строку в списке дат текущей записи пропускаем
try
dDate := StrToDate(slDatasDel[i2]);//преобразуем из строки в дату и попутно проверяем на корректность даты
except
bRecordDel := False;//некорректную дату не удаляем
continue;//в случае некорректной даты пропускаем её
end;//try-except
//если встретилась хоть одна будущая дата в списке, то эту запись не удаляем
if dDate >= fmSelDate.cxDateEdit1.Date then begin
bRecordDel := False;
break;//дальше не зачем проверять, т.к. уже найдена будущая дата
end;//if dDate >= fmSelDate.cxDateEdit1.EditValue then begin
end else begin
//если список дат пустой, то пропускаем такую запись
bRecordDel := False;
continue;
end;
end;//for i2 := 0 to slDatasDel.Count - 1 do begin
//если эта запись для удаления, то удаляем её
if bRecordDel then begin
dm.tReklama3.delete;
Inc(iDeleted);
Inc(iCommit);
if iCommit > 1000 then begin
if dm.tReklama3.UpdateTransaction.InTransaction then dm.tReklama3.UpdateTransaction.Commit;
iCommit := 0;//сброс счётчика подтверждений
end;
end else
dm.tReklama3.prior;//если запись не для удаления, то поднимаемся выше
//нажали Esc - останавливаем удаление
if bStopDelOldOblv then begin
StatusBar1.Panels[1].Text := 'ОТМЕНА УДАЛЕНИЯ...';
Application.ProcessMessages;
exit;
end;
end;//while
end;//with
if dm.tReklama3.UpdateTransaction.InTransaction then dm.tReklama3.UpdateTransaction.Commit;
end;//if fmSelDate.ShowModal = mrok then begin
finally
dm.tReklama3.AutoCommit := True;
Freel(fmSelDate);
Freel(slDatasDel);
dm.tReklama3.EnableControls;
Screen.Cursor := crDefault;
ProgressBar1.Visible := false;
Application.ProcessMessages;
StatusBar1.Panels[1].Text := 'ЗАВЕРШЕНИЕ ОПЕРАЦИИ...';
Application.ProcessMessages;
tEnd := Time;
actUpdateExecute(nil);
StatusBar1.Panels[0].Text := '';
StatusBar1.Panels[1].Text := '';
ShowMessage('Готово. Время операции: ' + TimeToStr(tEnd - tStart) );
end;
end;
|
|
Удаление в цикле, с проверкой 
Дата 23.8.2008, 00:15 (
Загрузка ...
. 
