Difference between revisions of "How to write in-memory database applications in Lazarus/FPC/ru"
(19 intermediate revisions by 2 users not shown) | |||
Line 1: | Line 1: | ||
{{How_to_write_in-memory_database_applications_in_Lazarus/FPC}} | {{How_to_write_in-memory_database_applications_in_Lazarus/FPC}} | ||
{{Infobox databases}} | {{Infobox databases}} | ||
− | == | + | == Введение == |
− | + | Существуют определенные обстоятельства, когда наборы данных в памяти имеют смысл. Если вам нужна быстрая, однопользовательская, не критически важная база данных, отличная от SQL, без транзакций, [[TMemDataset]] может удовлетворить ваши потребности. | |
− | + | Некоторые преимущества: | |
− | * | + | * Быстрое выполнение. Поскольку вся обработка выполняется в памяти, данные не сохраняются на жестком диске до тех пор, пока это не будет задано явно. Память, безусловно, быстрее, чем жесткий диск. |
− | * | + | * Нет необходимости во внешних библиотеках (нет файлов .so или .dll), нет необходимости в установке сервера. |
− | * | + | * Код является мультиплатформенным и может быть скомпилирован в любой ОС. |
− | * | + | * Поскольку все программирование выполняется в Lazarus/FPC, такие приложения проще в обслуживании. Вместо того, чтобы постоянно переключаться с внутреннего программирования на внешнее, используя MemDatasets, вы можете сосредоточиться на своем коде Pascal. |
− | {{Note| | + | {{Note|позже в этой статье будет представлен BufDataset. [[TBufDataset]] часто является лучшим выбором, чем [[TMemDataset]]}} |
− | + | Я проиллюстрирую, как программировать реляционные не-SQL базы данных в памяти, сосредоточив внимание на обеспечении целостности отношений и фильтрации, моделировании основных полей с автоинкрементом и т.п. | |
− | + | Эта страница поделится с вами тем, что я узнал, экспериментируя с TMemDatasets. Возможно даже, что есть какой-то другой, более эффективный способ сделать это. Если это так, пожалуйста, не стесняйтесь вносить свой вклад в этот документ в интересах сообщества Lazarus/FPC. | |
− | + | Модуль memds предоставляет TMemDataset, так что вам нужно будет добавить его в раздел uses вашего проекта. | |
− | == | + | == Сохранение MemDataset в постоянные файлы == |
− | + | В [[Interface|интерфейсной]] части вашего кода объявите тип массива для хранения информации обо всех TMemDataSets, которые вы хотите сделать постоянными в конце сеанса и восстановить в начале следующего сеанса. Вы также должны объявить переменную типа TSaveTables. | |
− | + | Я также использую глобальную переменную vSuppressEvents типа boolean для подавления событий Dataset, используемых для обеспечения ссылочной целостности, во время восстановления данных. | |
− | + | Вот, что у вас должно получиться: | |
− | <syntaxhighlight>type | + | <syntaxhighlight lang=pascal>type |
TSaveTables=array[1..15] of TMemDataset; | TSaveTables=array[1..15] of TMemDataset; | ||
var | var | ||
− | // | + | //Глобальная переменная, которая хранит таблицы для сохранения/восстановления сеанса работы |
vSaveTables:TSaveTables; | vSaveTables:TSaveTables; | ||
− | // | + | //Переменная-флаг подавления событий датасета. Используется при загрузке данных из файлов. |
vSuppressEvents:Boolean;</syntaxhighlight> | vSuppressEvents:Boolean;</syntaxhighlight> | ||
− | + | Вместо того, чтобы использовать глобальные переменные, как это сделал, например, я, вы также можете сделать их свойством главной формы. TMemDataset имеет способ хранения данных в постоянном файле: метод SaveToFile. Но вы, возможно, захотите сохранить данные в файлы [[CSV]] для упрощения работы с ними в дальнейшем. Поэтому я объединю оба способа в одни и те же процедуры. | |
− | TMemDataset | + | |
− | + | Я задаю константу cSaveRestore в интерфейсной части модуля, с помощью которой я могу определить, будут ли данные храниться и загружаться как нативные файлы MemDataset, или как файлы CSV. | |
− | <syntaxhighlight>const | + | <syntaxhighlight lang=pascal>const |
− | // | + | //Константа cSaveRestore определяет способ сохранения и восстановления MemDataset в постоянные файлы. |
− | cSaveRestore=0; //0=MemDataset | + | cSaveRestore=0; //0=собственный формат MemDataset, 1=сохранение и восстановление из CSV |
</syntaxhighlight> | </syntaxhighlight> | ||
− | + | Теперь вы можете сохранить MemDataset'ы в событии OnFormClose и загрузить их в событие OnFormCreate. Заполнить элементы массива экземплярами MemDataset можно также в событии OnFormCreate. | |
− | <syntaxhighlight>procedure TMainForm.FormCreate(Sender: TObject); | + | <syntaxhighlight lang=pascal>procedure TMainForm.FormCreate(Sender: TObject); |
begin | begin | ||
− | // | + | //Список таблиц, которые будут сохранены/восстановлены для сеанса работы |
vSaveTables[1]:=Products; | vSaveTables[1]:=Products; | ||
vSaveTables[2]:=Boms; | vSaveTables[2]:=Boms; | ||
Line 60: | Line 60: | ||
vSaveTables[14]:=ImportFromTables; | vSaveTables[14]:=ImportFromTables; | ||
vSaveTables[15]:=ImportFromFields; | vSaveTables[15]:=ImportFromFields; | ||
− | // | + | //Восстанавливаем сеанс работы |
RestoreSession; | RestoreSession; | ||
GetAutoincrementPrimaryFields; | GetAutoincrementPrimaryFields; | ||
end;</syntaxhighlight> | end;</syntaxhighlight> | ||
− | <syntaxhighlight>procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction); | + | <syntaxhighlight lang=pascal>procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction); |
begin | begin | ||
− | // | + | //Сохраняем наборы данных в файлы (чтобы сохранить текущий сеанс) |
SaveSession; | SaveSession; | ||
end;</syntaxhighlight> | end;</syntaxhighlight> | ||
− | <syntaxhighlight>procedure RestoreSession; | + | <syntaxhighlight lang=pascal>procedure RestoreSession; |
var | var | ||
I:Integer; | I:Integer; | ||
begin | begin | ||
try | try | ||
− | MemoMessages.Append(TimeToStr(Now())+' | + | MemoMessages.Append(TimeToStr(Now())+' Начало восстановления ранее сохраненного сеанса.'); |
− | vSuppressEvents:=True; // | + | vSuppressEvents:=True; //Подавляем события, используемые для обеспечения ссылочной целостности |
− | // | + | //Отключаем элементы управления и обновляем все наборы данных |
for I:=Low(vSaveTables) to High(vSaveTables) do begin | for I:=Low(vSaveTables) to High(vSaveTables) do begin | ||
vSaveTables[I].DisableControls; | vSaveTables[I].DisableControls; | ||
− | vSaveTables[I].Refresh; // | + | vSaveTables[I].Refresh; //Важный момент, если набор данных был отфильтрован |
end; | end; | ||
− | // | + | //Загружаем memdataset'ы из файлов (для восстановления предыдущего сеанса) |
for I:=Low(vSaveTables) to High(vSaveTables) do begin | for I:=Low(vSaveTables) to High(vSaveTables) do begin | ||
vSaveTables[I].First; | vSaveTables[I].First; | ||
− | MemoMessages.Append(TimeToStr(Now())+' | + | MemoMessages.Append(TimeToStr(Now())+' Начинаем восстановление таблицы: '+vSaveTables[I].Name); |
try | try | ||
− | // | + | //Если данные загружаются из CSV-файла, то сначала необходимо удалить таблицу. |
if cSaveRestore=1 then begin | if cSaveRestore=1 then begin | ||
− | MemoMessages.Append(TimeToStr(Now())+' | + | MemoMessages.Append(TimeToStr(Now())+' Начинаем удаление всех записей в таблице: '+vSaveTables[I].Name); |
− | // | + | //Этот способ удаления всех записей невероятно медленный. |
{while not vSaveTables[I].EOF do begin | {while not vSaveTables[I].EOF do begin | ||
vSaveTables[I].Delete; | vSaveTables[I].Delete; | ||
end;} | end;} | ||
− | // | + | //Этот метод для удаления всех записей намного быстрее |
EmptyMemDataSet(vSaveTables[I]); | EmptyMemDataSet(vSaveTables[I]); | ||
− | MemoMessages.Append(TimeToStr(Now())+' | + | MemoMessages.Append(TimeToStr(Now())+' Все записи из таблицы: '+vSaveTables[I].Name+' удалены.'); |
end; | end; | ||
except | except | ||
on E:Exception do begin | on E:Exception do begin | ||
− | MemoMessages.Append(TimeToStr(Now())+' | + | MemoMessages.Append(TimeToStr(Now())+' Ошибка при удалении записей из таблицы: '+vSaveTables[I].Name +'. '+E.Message); |
end; | end; | ||
end; | end; | ||
try | try | ||
try | try | ||
− | MemoMessages.Append(TimeToStr(Now())+' | + | MemoMessages.Append(TimeToStr(Now())+' Восстановление таблицы: '+vSaveTables[I].Name); |
− | // | + | //Проверяем константу для выбора способа сохранения/восстановления данных и загрузки сохраненного сеанса |
case cSaveRestore of | case cSaveRestore of | ||
0:vSaveTables[I].LoadFromFile(vSaveTables[I].Name); | 0:vSaveTables[I].LoadFromFile(vSaveTables[I].Name); | ||
Line 114: | Line 114: | ||
except | except | ||
on E:Exception do begin | on E:Exception do begin | ||
− | MemoMessages.Append(TimeToStr(Now())+' | + | MemoMessages.Append(TimeToStr(Now())+' Ошибка при восстановлении таблицы: '+vSaveTables[I].Name +'. '+E.Message); |
end; | end; | ||
end; | end; | ||
finally | finally | ||
− | vSaveTables[I].Active:=True;// | + | vSaveTables[I].Active:=True;//Требуется из-за метода LoadFromFile.... |
end; | end; | ||
− | MemoMessages.Append(TimeToStr(Now())+' | + | MemoMessages.Append(TimeToStr(Now())+' Таблица: '+vSaveTables[I].Name+' восстановлена.'); |
end; | end; | ||
finally | finally | ||
vSuppressEvents:=False; | vSuppressEvents:=False; | ||
− | // | + | //Обновляем все наборы данных и включаем элементы управления |
for I:=Low(vSaveTables) to High(vSaveTables) do begin | for I:=Low(vSaveTables) to High(vSaveTables) do begin | ||
− | vSaveTables[I].Refresh; // | + | vSaveTables[I].Refresh; //Необходимо для таблиц, которые фильтруются. |
vSaveTables[I].EnableControls; | vSaveTables[I].EnableControls; | ||
end; | end; | ||
− | MemoMessages.Append(TimeToStr(Now())+' | + | MemoMessages.Append(TimeToStr(Now())+' Все таблицы восстановлены из сохраненных файлов.'); |
end; | end; | ||
end;</syntaxhighlight> | end;</syntaxhighlight> | ||
− | <syntaxhighlight>procedure SaveSession; | + | <syntaxhighlight lang=pascal>procedure SaveSession; |
var | var | ||
I:Integer; | I:Integer; | ||
begin | begin | ||
try | try | ||
− | MemoMessages.Append(TimeToStr(Now())+' | + | MemoMessages.Append(TimeToStr(Now())+' Начало сохранения сеанса в постоянные файлы.'); |
vSuppressEvents:=True; | vSuppressEvents:=True; | ||
− | // | + | //Отключаем элементы управления и обновляем все наборы данных |
for I:=Low(vSaveTables) to High(vSaveTables) do begin | for I:=Low(vSaveTables) to High(vSaveTables) do begin | ||
vSaveTables[I].DisableControls; | vSaveTables[I].DisableControls; | ||
− | vSaveTables[I].Refresh; // | + | vSaveTables[I].Refresh; //Важный момент, если набор данных был отфильтрован |
end; | end; | ||
− | // | + | //Сохраняем сеанс работы в файл |
for I:=Low(vSaveTables) to High(vSaveTables) do begin | for I:=Low(vSaveTables) to High(vSaveTables) do begin | ||
vSaveTables[I].First; | vSaveTables[I].First; | ||
− | MemoMessages.Append(TimeToStr(Now())+' | + | MemoMessages.Append(TimeToStr(Now())+' Сохранение таблицы: '+vSaveTables[I].Name); |
try | try | ||
− | // | + | //Проверяем константу для выбора способа сохранения/восстановления данных и загрузки сохраненного сеанса |
case cSaveRestore of | case cSaveRestore of | ||
0:vSaveTables[I].SaveToFile(vSaveTables[I].Name); | 0:vSaveTables[I].SaveToFile(vSaveTables[I].Name); | ||
Line 157: | Line 157: | ||
except | except | ||
on E:Exception do begin | on E:Exception do begin | ||
− | MemoMessages.Append(TimeToStr(Now())+' | + | MemoMessages.Append(TimeToStr(Now())+' Ошибка при сохранении таблицы: '+vSaveTables[I].Name +'. '+E.Message); |
end; | end; | ||
end; | end; | ||
− | MemoMessages.Append(TimeToStr(Now())+' | + | MemoMessages.Append(TimeToStr(Now())+' Таблица: '+vSaveTables[I].Name+' сохранена.'); |
end; | end; | ||
finally | finally | ||
vSuppressEvents:=False; | vSuppressEvents:=False; | ||
− | // | + | //Обновляем все наборы данных и включаем элементы управления |
for I:=Low(vSaveTables) to High(vSaveTables) do begin | for I:=Low(vSaveTables) to High(vSaveTables) do begin | ||
− | vSaveTables[I].Refresh; // | + | vSaveTables[I].Refresh; //Необходимо для таблиц, которые фильтруются |
vSaveTables[I].EnableControls; | vSaveTables[I].EnableControls; | ||
end; | end; | ||
− | MemoMessages.Append(TimeToStr(Now())+' | + | MemoMessages.Append(TimeToStr(Now())+' Все таблицы сохранены в файлы.'); |
end; | end; | ||
end;</syntaxhighlight> | end;</syntaxhighlight> | ||
− | <syntaxhighlight>procedure EmptyMemDataSet(DataSet:TMemDataSet); | + | <syntaxhighlight lang=pascal>procedure EmptyMemDataSet(DataSet:TMemDataSet); |
var | var | ||
vTemporaryMemDataSet:TMemDataSet; | vTemporaryMemDataSet:TMemDataSet; | ||
Line 180: | Line 180: | ||
begin | begin | ||
try | try | ||
− | // | + | //Создаем временный MemDataSet |
vTemporaryMemDataSet:=TMemDataSet.Create(nil); | vTemporaryMemDataSet:=TMemDataSet.Create(nil); | ||
− | // | + | //Сохраняем FieldDefs во временном MemDataSet |
for I:=0 to DataSet.FieldDefs.Count-1 do begin | for I:=0 to DataSet.FieldDefs.Count-1 do begin | ||
vFieldDef:=vTemporaryMemDataSet.FieldDefs.AddFieldDef; | vFieldDef:=vTemporaryMemDataSet.FieldDefs.AddFieldDef; | ||
Line 192: | Line 192: | ||
end; | end; | ||
end; | end; | ||
− | // | + | //Очищаем существующие fielddefs |
DataSet.Clear; | DataSet.Clear; | ||
− | // | + | //Восстанавливаем fielddefs |
DataSet.FieldDefs:=vTemporaryMemDataSet.FieldDefs; | DataSet.FieldDefs:=vTemporaryMemDataSet.FieldDefs; | ||
DataSet.Active:=True; | DataSet.Active:=True; | ||
Line 203: | Line 203: | ||
end;</syntaxhighlight> | end;</syntaxhighlight> | ||
− | <syntaxhighlight>procedure LoadFromCsv(DataSet:TDataSet); | + | <syntaxhighlight lang=pascal>procedure LoadFromCsv(DataSet:TDataSet); |
var | var | ||
vFieldCount:Integer; | vFieldCount:Integer; | ||
Line 209: | Line 209: | ||
begin | begin | ||
try | try | ||
− | // | + | //Назначаем SdfDataSetTemporary |
with SdfDataSetTemporary do begin | with SdfDataSetTemporary do begin | ||
Active:=False; | Active:=False; | ||
Line 216: | Line 216: | ||
FirstLineAsSchema:=True; | FirstLineAsSchema:=True; | ||
Active:=True; | Active:=True; | ||
− | // | + | //Определяем количество полей |
vFieldCount:=FieldDefs.Count; | vFieldCount:=FieldDefs.Count; | ||
end; | end; | ||
− | // | + | //Выполняем итерацию по SdfDataSetTeditional и вставляем записи в MemDataSet. |
SdfDataSetTemporary.First; | SdfDataSetTemporary.First; | ||
while not SdfDataSetTemporary.EOF do begin | while not SdfDataSetTemporary.EOF do begin | ||
DataSet.Append; | DataSet.Append; | ||
− | // | + | //Итерация по FieldDefs |
for I:=0 to vFieldCount-1 do begin | for I:=0 to vFieldCount-1 do begin | ||
try | try | ||
Line 229: | Line 229: | ||
except | except | ||
on E:Exception do begin | on E:Exception do begin | ||
− | MemoMessages.Append(TimeToStr(Now())+' | + | MemoMessages.Append(TimeToStr(Now())+' Ошибка при установке значения для поля: ' |
+DataSet.Name+'.'+DataSet.Fields[I].Name +'. '+E.Message); | +DataSet.Name+'.'+DataSet.Fields[I].Name +'. '+E.Message); | ||
end; | end; | ||
Line 238: | Line 238: | ||
except | except | ||
on E:Exception do begin | on E:Exception do begin | ||
− | MemoMessages.Append(TimeToStr(Now())+' | + | MemoMessages.Append(TimeToStr(Now())+' Ошибка при сохранении записи в таблицу: ' |
+DataSet.Name+'.'+E.Message); | +DataSet.Name+'.'+E.Message); | ||
end; | end; | ||
Line 250: | Line 250: | ||
end;</syntaxhighlight> | end;</syntaxhighlight> | ||
− | <syntaxhighlight>procedure SaveToCsv(DataSet:TDataSet); | + | <syntaxhighlight lang=pascal>procedure SaveToCsv(DataSet:TDataSet); |
var | var | ||
myFileName:string; | myFileName:string; | ||
Line 258: | Line 258: | ||
begin | begin | ||
myFileName:=DataSet.Name+'.txt'; | myFileName:=DataSet.Name+'.txt'; | ||
− | // | + | //создаем новый файл |
AssignFile(myTextFile, myFileName); | AssignFile(myTextFile, myFileName); | ||
Rewrite(myTextFile); | Rewrite(myTextFile); | ||
− | s := ''; // | + | s := ''; //инициализируем пустую строку |
try | try | ||
− | // | + | //записываем имена полей (как заголовки столбцов) |
for i := 0 to DataSet.Fields.Count - 1 do | for i := 0 to DataSet.Fields.Count - 1 do | ||
begin | begin | ||
Line 270: | Line 270: | ||
Writeln(myTextFile, s); | Writeln(myTextFile, s); | ||
DataSet.First; | DataSet.First; | ||
− | // | + | //записываем значения полей |
while not DataSet.Eof do | while not DataSet.Eof do | ||
begin | begin | ||
Line 276: | Line 276: | ||
for i := 0 to DataSet.FieldCount - 1 do | for i := 0 to DataSet.FieldCount - 1 do | ||
begin | begin | ||
− | // | + | //Числовые поля без кавычек, строковые поля с кавычками |
if ((DataSet.FieldDefs[i].DataType=ftInteger) | if ((DataSet.FieldDefs[i].DataType=ftInteger) | ||
or (DataSet.FieldDefs[i].DataType=ftFloat)) then | or (DataSet.FieldDefs[i].DataType=ftFloat)) then | ||
Line 291: | Line 291: | ||
end;</syntaxhighlight> | end;</syntaxhighlight> | ||
− | == | + | == Автогенератор первичных ключей == |
− | Autoincrement | + | Тип поля Autoincrement не поддерживается MemDataset. Тем не менее, вы можете имитировать его, используя тип поля Integer и предоставляя калькулятор для полей автогенератора. Нам нужны глобальные переменные или открытые свойства для хранения текущего значения поля автогенератора. Я предпочитаю глобальные переменные, объявленные в интерфейсной части модуля. |
− | + | <syntaxhighlight lang=pascal>var | |
− | <syntaxhighlight>var | + | //Глобальные переменные, используемые для вычисления полей автогенератора первичного ключа MemDatasets |
− | // | ||
vCurrentId:Integer=0; | vCurrentId:Integer=0; | ||
vProductsId:Integer=0; | vProductsId:Integer=0; | ||
Line 313: | Line 312: | ||
vImportFromTablesId:Integer=0; | vImportFromTablesId:Integer=0; | ||
vImportFromFieldsId:Integer=0;</syntaxhighlight> | vImportFromFieldsId:Integer=0;</syntaxhighlight> | ||
− | + | Тогда у нас есть процедура для расчета значений полей автогенератора: | |
− | <syntaxhighlight>procedure GetAutoincrementPrimaryFields; | + | <syntaxhighlight lang=pascal>procedure GetAutoincrementPrimaryFields; |
var | var | ||
I:Integer; | I:Integer; | ||
Line 321: | Line 320: | ||
begin | begin | ||
try | try | ||
− | MemoMessages.Lines.Append(TimeToStr(Now())+' | + | MemoMessages.Lines.Append(TimeToStr(Now())+' Получение информации о полях автогенератора'); |
vSuppressEvents:=True; | vSuppressEvents:=True; | ||
− | // | + | //Отключаем элементы управления и обновляем все наборы данных |
for I:=Low(vSaveTables) to High(vSaveTables) do begin | for I:=Low(vSaveTables) to High(vSaveTables) do begin | ||
vSaveTables[I].DisableControls; | vSaveTables[I].DisableControls; | ||
− | vSaveTables[I].Refresh; // | + | vSaveTables[I].Refresh; //Важный момент, если набор данных был отфильтрован |
end; | end; | ||
for I:=Low(vSaveTables) to High(vSaveTables) do begin | for I:=Low(vSaveTables) to High(vSaveTables) do begin | ||
with vSaveTables[I] do begin | with vSaveTables[I] do begin | ||
− | // | + | //Используем соответствующую глобальную переменную |
case StringToCaseSelect(Name, | case StringToCaseSelect(Name, | ||
['Products','Boms','Stocks','Orders', | ['Products','Boms','Stocks','Orders', | ||
Line 353: | Line 352: | ||
end; | end; | ||
try | try | ||
− | // | + | //Находим последнее значение ID и сохраняем его в глобальной переменной |
Last; | Last; | ||
vCurrentId:=FieldByName(Name+'Id').AsInteger; | vCurrentId:=FieldByName(Name+'Id').AsInteger; | ||
if (vCurrentId>vId^) then vId^:=vCurrentId; | if (vCurrentId>vId^) then vId^:=vCurrentId; | ||
finally | finally | ||
− | // | + | //Удаляем ссылку |
vId:=nil; | vId:=nil; | ||
end; | end; | ||
Line 365: | Line 364: | ||
finally | finally | ||
vSuppressEvents:=False; | vSuppressEvents:=False; | ||
− | // | + | //Обновляем все наборы данных и включаем элементы управления |
for I:=Low(vSaveTables) to High(vSaveTables) do begin | for I:=Low(vSaveTables) to High(vSaveTables) do begin | ||
vSaveTables[I].Refresh; | vSaveTables[I].Refresh; | ||
vSaveTables[I].EnableControls; | vSaveTables[I].EnableControls; | ||
end; | end; | ||
− | MemoMessages.Lines.Append(TimeToStr(Now())+' | + | MemoMessages.Lines.Append(TimeToStr(Now())+' Автоинкрементные поля - готовы.'); |
end; | end; | ||
end;</syntaxhighlight> | end;</syntaxhighlight> | ||
− | <syntaxhighlight>function StringToCaseSelect(Selector:string;CaseList:array of string):Integer; | + | <syntaxhighlight lang=pascal>function StringToCaseSelect(Selector:string;CaseList:array of string):Integer; |
var | var | ||
cnt: integer; | cnt: integer; | ||
Line 389: | Line 388: | ||
end;</syntaxhighlight> | end;</syntaxhighlight> | ||
− | + | Процедура <tt>GetAutoincrementPrimaryFields</tt> вызывается каждый раз после восстановления (загрузки) данных из постоянных файлов, чтобы загрузить последние значения автогенератора в глобальные переменные (или свойства, как вы предпочитаете). Автоинкрементация выполняется в событии OnNewRecord каждого MemDataset. Например, для таблицы Orders MemDataset: | |
− | |||
− | <syntaxhighlight>procedure TMainForm.OrdersNewRecord(DataSet: TDataSet); | + | <syntaxhighlight lang=pascal>procedure TMainForm.OrdersNewRecord(DataSet: TDataSet); |
begin | begin | ||
− | if vSuppressEvents | + | if vSuppressEvents then Exit; |
− | // | + | //Устанавливаем новое значение автогенератора |
vOrdersId:=vOrdersId+1; | vOrdersId:=vOrdersId+1; | ||
DataSet.FieldByName('OrdersId').AsInteger:=vOrdersId; | DataSet.FieldByName('OrdersId').AsInteger:=vOrdersId; | ||
end;</syntaxhighlight> | end;</syntaxhighlight> | ||
− | + | Как уже объяснялось, я использую глобальную переменную vSuppressEvents в качестве флага для случая восстановления данных из постоянных файлов. | |
− | == | + | == Обеспечение ссылочной целостности == |
− | + | В компоненте MemDataset встроенная ссылочная целостность не реализована, поэтому вы должны сделать это самостоятельно. | |
− | + | Предположим, у нас есть две таблицы: MasterTable и DetailTable. | |
− | + | Существуют различные места, где необходимо использовать код ссылочной целостности: | |
− | * | + | * Код вставки/обновления находится в событии <code>BeforePost</code> DetailTable: перед сохранением новой/обновленной detail-записи ее необходимо проверить на соответствие требованиям ссылочной целостности |
− | * | + | * Код удаления находится в событии <code>BeforeDelete</code> в MasterTable: перед удалением master-записи необходимо убедиться, что все дочерние записи соответствуют требованиям ссылочной целостности |
− | <syntaxhighlight> | + | <syntaxhighlight lang=pascal> |
procedure TMainForm.MasterTableBeforeDelete(DataSet: TDataSet); | procedure TMainForm.MasterTableBeforeDelete(DataSet: TDataSet); | ||
begin | begin | ||
− | if vSuppressEvents | + | if vSuppressEvents then Exit; |
try | try | ||
DetailTable.DisableControls; | DetailTable.DisableControls; | ||
− | // | + | // Принудительное удаление ссылок («каскадное удаление») для таблицы «MasterTable» |
while not DetailTable.EOF do begin | while not DetailTable.EOF do begin | ||
DetailTable.Delete; | DetailTable.Delete; | ||
Line 428: | Line 426: | ||
</syntaxhighlight> | </syntaxhighlight> | ||
− | <syntaxhighlight> | + | <syntaxhighlight lang=pascal> |
procedure TMainForm.DetailTableBeforePost(DataSet: TDataSet); | procedure TMainForm.DetailTableBeforePost(DataSet: TDataSet); | ||
begin | begin | ||
if vSuppressEvents=True then Exit; | if vSuppressEvents=True then Exit; | ||
− | // | + | // Принудительное использование ссылочной вставки/обновления для таблицы «DetailTable» с |
− | // | + | // внешним ключом «MasterTableID», ссылающимся на |
− | // | + | // поле первичного ключа идентификатора MasterTable ID |
DataSet.FieldByName('MasterTableId').AsInteger:= | DataSet.FieldByName('MasterTableId').AsInteger:= | ||
MasterTable.FieldByName('ID').AsInteger; | MasterTable.FieldByName('ID').AsInteger; | ||
Line 440: | Line 438: | ||
</syntaxhighlight> | </syntaxhighlight> | ||
− | + | После того, как вы предоставили ссылочную вставку/обновление/удаление, все, что вам нужно сделать, это предоставить код для master/detail фильтрации данных. Это делается в событии <code>AfterScroll</code> в MasterTable и в событии <code>OnFilter</code> в DetailTable. | |
− | + | Не забудьте установить для свойства <code>Filtered</code> DetailTable значение True. | |
− | <syntaxhighlight> | + | <syntaxhighlight lang=pascal> |
procedure TMainForm.MasterTableAfterScroll(DataSet: TDataSet); | procedure TMainForm.MasterTableAfterScroll(DataSet: TDataSet); | ||
begin | begin | ||
Line 452: | Line 450: | ||
</syntaxhighlight> | </syntaxhighlight> | ||
− | <syntaxhighlight> | + | <syntaxhighlight lang=pascal> |
procedure TMainForm.DetailTableFilterRecord(DataSet: TDataSet; | procedure TMainForm.DetailTableFilterRecord(DataSet: TDataSet; | ||
var Accept: Boolean); | var Accept: Boolean); | ||
begin | begin | ||
if vSuppressEvents=True then Exit; | if vSuppressEvents=True then Exit; | ||
− | // | + | // Показывем только дочерние поля, внешний ключ которых указывает на текущую |
− | // master | + | // запись master таблицы |
Accept:=DataSet.FieldByName('MasterTableId').AsInteger= | Accept:=DataSet.FieldByName('MasterTableId').AsInteger= | ||
MasterTable.FieldByName('ID').AsInteger; | MasterTable.FieldByName('ID').AsInteger; | ||
Line 464: | Line 462: | ||
</syntaxhighlight> | </syntaxhighlight> | ||
− | == | + | == Известные проблемы == |
− | + | Есть несколько ограничений при использовании MemDatasets. | |
− | * | + | *Метод locate не работает |
− | * | + | *Фильтрация с использованием свойства Filter и Filtered не работает. Вы должны использовать жесткое кодирование в событии OnFilter. |
− | * | + | *Повторное удаление записей кажется невероятно медленным. Поэтому я использую мою процедуру EmptyMemDataset вместо <code>while not EOF do Delete;</code> |
− | * | + | *В FPC 2.6.x и более ранних версиях метод CopyFromDataSet копирует данные только с текущей позиции курсора в конец набора исходных данных. Итак, вы должны написать <code>MemDataset1.First;</code> перед <code>MemDataSet2.CopyFromDataSet(MemDataset1);</code>. Исправлено в транке ревизии FPC 26233. |
− | ** | + | ** Обратите внимание, что более старые версии FPC не имеют CopyFromDataset в Bufdataset, в то время как это - преимущество для MemDs. |
− | ** | + | ** См. багрепорт http://bugs.freepascal.org/view.php?id=25426. |
== TBufDataSet == | == TBufDataSet == | ||
− | + | Как упоминалось ранее, в MemDataSet отсутствуют пользовательские фильтры, тип данных автоинкремента и метод Locate, поэтому взамен лучше использовать TBufDataSet. TBufDataset предоставляется модулем BufDataset. | |
− | TBufDataset | ||
− | + | Поскольку нет компонента для редактирования TBufDataSet во время разработки (но вы можете настроить определения полей во время разработки), вы можете создать пользовательский компонент-обертку или использовать его через код так же, как ClientDataSet в Delphi. Подробности смотрите в документации Delphi, касающейся наборов данных клиента для подробностей. | |
− | + | Вы можете использовать те же методы для обеспечения ссылочной целостности и первичных полей автоинкремента, как описано для MemDataSet. | |
− | + | Между MemDataSet и BufDataset есть только небольшие различия: | |
{| class="wikitable sortable" | {| class="wikitable sortable" | ||
! MemDataSet | ! MemDataSet | ||
Line 491: | Line 488: | ||
|} | |} | ||
− | == | + | == Сортировка DBGrid по событию OnTitleClick для TBufDataSet == |
− | + | Если вы хотите включить последовательную сортировку DBGrid по возрастанию и убыванию, показывающую некоторые данные из TBufDataSet, вы можете использовать следующий метод: | |
− | <syntaxhighlight> | + | <syntaxhighlight lang=pascal> |
Uses | Uses | ||
BufDataset, typinfo; | BufDataset, typinfo; | ||
Line 508: | Line 505: | ||
Result := False; | Result := False; | ||
Field := DataSet.Fields.FindField(FieldName); | Field := DataSet.Fields.FindField(FieldName); | ||
− | // | + | //Если неверное имя поля, выйдем. |
if Field = nil then Exit; | if Field = nil then Exit; | ||
− | // | + | //Если неверный тип поля, выйдем. |
if {(Field is TObjectField) or} (Field is TBlobField) or | if {(Field is TObjectField) or} (Field is TBlobField) or | ||
{(Field is TAggregateField) or} (Field is TVariantField) | {(Field is TAggregateField) or} (Field is TVariantField) | ||
or (Field is TBinaryField) then Exit; | or (Field is TBinaryField) then Exit; | ||
− | // | + | //Получаем IndexDefs и IndexName, используя RTTI |
if IsPublishedProp(DataSet, 'IndexDefs') then | if IsPublishedProp(DataSet, 'IndexDefs') then | ||
IndexDefs := GetObjectProp(DataSet, 'IndexDefs') as TIndexDefs | IndexDefs := GetObjectProp(DataSet, 'IndexDefs') as TIndexDefs | ||
Line 523: | Line 520: | ||
else | else | ||
Exit; | Exit; | ||
− | // | + | //Убедитесь, что IndexDefs об-нов-лен |
− | IndexDefs.Updated:=false; {<<<<--- | + | IndexDefs.Updated:=false; {<<<<---Эта строка имеет решающее значение, так как IndexDefs.Update ничего не будет делать при следующей сортировке, если она уже верна} |
IndexDefs.Update; | IndexDefs.Update; | ||
− | // | + | //Если восходящий индекс уже используется, |
− | // | + | //переключаемся на нисходящий индекс |
if IndexName = FieldName + '__IdxA' | if IndexName = FieldName + '__IdxA' | ||
then | then | ||
Line 539: | Line 536: | ||
IndexOptions := []; | IndexOptions := []; | ||
end; | end; | ||
− | // | + | //ищем существующий индекс |
for i := 0 to Pred(IndexDefs.Count) do | for i := 0 to Pred(IndexDefs.Count) do | ||
begin | begin | ||
Line 548: | Line 545: | ||
end; //if | end; //if | ||
end; // for | end; // for | ||
− | // | + | //Если существующий индекс не найден, создаем его |
if not Result then | if not Result then | ||
begin | begin | ||
Line 557: | Line 554: | ||
Result := True; | Result := True; | ||
end; // if not | end; // if not | ||
− | // | + | //Устанавливаем индекс |
SetStrProp(DataSet, 'IndexName', IndexName); | SetStrProp(DataSet, 'IndexName', IndexName); | ||
end;</syntaxhighlight> | end;</syntaxhighlight> | ||
− | + | Итак, вы можете вызвать эту функцию из DBGrid следующим образом: | |
− | <syntaxhighlight>procedure TFormMain.DBGridProductsTitleClick(Column: TColumn); | + | <syntaxhighlight lang=pascal>procedure TFormMain.DBGridProductsTitleClick(Column: TColumn); |
begin | begin | ||
SortBufDataSet(Products, Column.FieldName); | SortBufDataSet(Products, Column.FieldName); | ||
end;</syntaxhighlight> | end;</syntaxhighlight> | ||
+ | == Сортировка нескольких столбцов в grid == | ||
+ | Я написал TDBGridHelper для сортировки grid по нескольким столбцам, удерживая клавишу Shift. | ||
+ | {{Note| MaxIndexesCount должен быть достаточно большим для TBufDataSet, потому что могут быть довольно большие комбинации возможных вариантов сортировки.}} | ||
− | + | Но я думаю, что люди не будут использовать больше 10, поэтому установка 100 должна быть теоретически приемлемой. | |
− | |||
− | |||
− | <syntaxhighlight> | + | <syntaxhighlight lang=pascal> |
{ TDBGridHelper } | { TDBGridHelper } | ||
Line 696: | Line 694: | ||
Dir := 'A'; | Dir := 'A'; | ||
− | // | + | //Если нажата клавиша Shift, добавляем поле в список полей. |
if ssShift in GetKeyShiftState then | if ssShift in GetKeyShiftState then | ||
begin | begin | ||
Fields.Values[FieldName] := Dir; | Fields.Values[FieldName] := Dir; | ||
− | // | + | //Мы не добавляем в сортировку больше полей, если общее количество полей превышает cMaxColCOunt |
if Fields.Count > cMaxColCOunt then | if Fields.Count > cMaxColCOunt then | ||
Exit; | Exit; | ||
Line 746: | Line 744: | ||
</syntaxhighlight> | </syntaxhighlight> | ||
− | + | Чтобы использовать сортировку, нужно вызвать вспомогательные методы в OnCellClick и onTitleClick. | |
− | OnTitleClick - | + | OnTitleClick - если вы удерживаете клавишу shift, добавляется новый столбец в список сортировки, или меняется направление сортировки выбранного столбца, или просто сортируется один столбец. |
− | OnCellClick | + | OnCellClick - если дважды щелкнуть ячейку [0, 0], сетка очищает ее сортировку. |
− | <syntaxhighlight> | + | <syntaxhighlight lang=pascal> |
procedure TForm1.grdCountriesCellClick(Column: TColumn); | procedure TForm1.grdCountriesCellClick(Column: TColumn); | ||
begin | begin | ||
Line 762: | Line 760: | ||
end; | end; | ||
</syntaxhighlight> | </syntaxhighlight> | ||
− | + | Если вы назначили TitleImageList, вы можете указать, какое изображение использовать для восходящей, а какое для нисходящей сортировки. | |
== ZMSQL== | == ZMSQL== | ||
− | + | Другой, часто лучший способ написания баз данных в памяти - это использование пакета ZMSQL: | |
* [[ZMSQL]] | * [[ZMSQL]] | ||
Line 771: | Line 769: | ||
* [http://www.lazarus.freepascal.org/index.php/topic,13821.30.html http://www.lazarus.freepascal.org/index.php/topic,13821.30.html] | * [http://www.lazarus.freepascal.org/index.php/topic,13821.30.html http://www.lazarus.freepascal.org/index.php/topic,13821.30.html] | ||
− | == | + | == Авторство == |
− | + | Оригинальный текст написан: Zlatko Matić (matalab@gmail.com) | |
− | + | Вклад других авторов, как показано на странице History. | |
<br/> | <br/> |
Latest revision as of 21:20, 19 October 2019
│
English (en) │
français (fr) │
日本語 (ja) │
русский (ru) │
References:
Tutorials/practical articles:
Databases |
Введение
Существуют определенные обстоятельства, когда наборы данных в памяти имеют смысл. Если вам нужна быстрая, однопользовательская, не критически важная база данных, отличная от SQL, без транзакций, TMemDataset может удовлетворить ваши потребности.
Некоторые преимущества:
- Быстрое выполнение. Поскольку вся обработка выполняется в памяти, данные не сохраняются на жестком диске до тех пор, пока это не будет задано явно. Память, безусловно, быстрее, чем жесткий диск.
- Нет необходимости во внешних библиотеках (нет файлов .so или .dll), нет необходимости в установке сервера.
- Код является мультиплатформенным и может быть скомпилирован в любой ОС.
- Поскольку все программирование выполняется в Lazarus/FPC, такие приложения проще в обслуживании. Вместо того, чтобы постоянно переключаться с внутреннего программирования на внешнее, используя MemDatasets, вы можете сосредоточиться на своем коде Pascal.
Я проиллюстрирую, как программировать реляционные не-SQL базы данных в памяти, сосредоточив внимание на обеспечении целостности отношений и фильтрации, моделировании основных полей с автоинкрементом и т.п.
Эта страница поделится с вами тем, что я узнал, экспериментируя с TMemDatasets. Возможно даже, что есть какой-то другой, более эффективный способ сделать это. Если это так, пожалуйста, не стесняйтесь вносить свой вклад в этот документ в интересах сообщества Lazarus/FPC.
Модуль memds предоставляет TMemDataset, так что вам нужно будет добавить его в раздел uses вашего проекта.
Сохранение MemDataset в постоянные файлы
В интерфейсной части вашего кода объявите тип массива для хранения информации обо всех TMemDataSets, которые вы хотите сделать постоянными в конце сеанса и восстановить в начале следующего сеанса. Вы также должны объявить переменную типа TSaveTables.
Я также использую глобальную переменную vSuppressEvents типа boolean для подавления событий Dataset, используемых для обеспечения ссылочной целостности, во время восстановления данных.
Вот, что у вас должно получиться:
type
TSaveTables=array[1..15] of TMemDataset;
var
//Глобальная переменная, которая хранит таблицы для сохранения/восстановления сеанса работы
vSaveTables:TSaveTables;
//Переменная-флаг подавления событий датасета. Используется при загрузке данных из файлов.
vSuppressEvents:Boolean;
Вместо того, чтобы использовать глобальные переменные, как это сделал, например, я, вы также можете сделать их свойством главной формы. TMemDataset имеет способ хранения данных в постоянном файле: метод SaveToFile. Но вы, возможно, захотите сохранить данные в файлы CSV для упрощения работы с ними в дальнейшем. Поэтому я объединю оба способа в одни и те же процедуры.
Я задаю константу cSaveRestore в интерфейсной части модуля, с помощью которой я могу определить, будут ли данные храниться и загружаться как нативные файлы MemDataset, или как файлы CSV.
const
//Константа cSaveRestore определяет способ сохранения и восстановления MemDataset в постоянные файлы.
cSaveRestore=0; //0=собственный формат MemDataset, 1=сохранение и восстановление из CSV
Теперь вы можете сохранить MemDataset'ы в событии OnFormClose и загрузить их в событие OnFormCreate. Заполнить элементы массива экземплярами MemDataset можно также в событии OnFormCreate.
procedure TMainForm.FormCreate(Sender: TObject);
begin
//Список таблиц, которые будут сохранены/восстановлены для сеанса работы
vSaveTables[1]:=Products;
vSaveTables[2]:=Boms;
vSaveTables[3]:=Stocks;
vSaveTables[4]:=Orders;
vSaveTables[5]:=BomCalculationProducts;
vSaveTables[6]:=BomCalculationComponents;
vSaveTables[7]:=BomCalculationFooter;
vSaveTables[8]:=BomCalculationProductsMultiple;
vSaveTables[9]:=BomCalculationComponentsMultiple;
vSaveTables[10]:=BomCalculationFooterMultiple;
vSaveTables[11]:=ImportVariants;
vSaveTables[12]:=ImportToTables;
vSaveTables[13]:=ImportToFields;
vSaveTables[14]:=ImportFromTables;
vSaveTables[15]:=ImportFromFields;
//Восстанавливаем сеанс работы
RestoreSession;
GetAutoincrementPrimaryFields;
end;
procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
//Сохраняем наборы данных в файлы (чтобы сохранить текущий сеанс)
SaveSession;
end;
procedure RestoreSession;
var
I:Integer;
begin
try
MemoMessages.Append(TimeToStr(Now())+' Начало восстановления ранее сохраненного сеанса.');
vSuppressEvents:=True; //Подавляем события, используемые для обеспечения ссылочной целостности
//Отключаем элементы управления и обновляем все наборы данных
for I:=Low(vSaveTables) to High(vSaveTables) do begin
vSaveTables[I].DisableControls;
vSaveTables[I].Refresh; //Важный момент, если набор данных был отфильтрован
end;
//Загружаем memdataset'ы из файлов (для восстановления предыдущего сеанса)
for I:=Low(vSaveTables) to High(vSaveTables) do begin
vSaveTables[I].First;
MemoMessages.Append(TimeToStr(Now())+' Начинаем восстановление таблицы: '+vSaveTables[I].Name);
try
//Если данные загружаются из CSV-файла, то сначала необходимо удалить таблицу.
if cSaveRestore=1 then begin
MemoMessages.Append(TimeToStr(Now())+' Начинаем удаление всех записей в таблице: '+vSaveTables[I].Name);
//Этот способ удаления всех записей невероятно медленный.
{while not vSaveTables[I].EOF do begin
vSaveTables[I].Delete;
end;}
//Этот метод для удаления всех записей намного быстрее
EmptyMemDataSet(vSaveTables[I]);
MemoMessages.Append(TimeToStr(Now())+' Все записи из таблицы: '+vSaveTables[I].Name+' удалены.');
end;
except
on E:Exception do begin
MemoMessages.Append(TimeToStr(Now())+' Ошибка при удалении записей из таблицы: '+vSaveTables[I].Name +'. '+E.Message);
end;
end;
try
try
MemoMessages.Append(TimeToStr(Now())+' Восстановление таблицы: '+vSaveTables[I].Name);
//Проверяем константу для выбора способа сохранения/восстановления данных и загрузки сохраненного сеанса
case cSaveRestore of
0:vSaveTables[I].LoadFromFile(vSaveTables[I].Name);
1:LoadFromCsv(vSaveTables[I]);
end;
except
on E:Exception do begin
MemoMessages.Append(TimeToStr(Now())+' Ошибка при восстановлении таблицы: '+vSaveTables[I].Name +'. '+E.Message);
end;
end;
finally
vSaveTables[I].Active:=True;//Требуется из-за метода LoadFromFile....
end;
MemoMessages.Append(TimeToStr(Now())+' Таблица: '+vSaveTables[I].Name+' восстановлена.');
end;
finally
vSuppressEvents:=False;
//Обновляем все наборы данных и включаем элементы управления
for I:=Low(vSaveTables) to High(vSaveTables) do begin
vSaveTables[I].Refresh; //Необходимо для таблиц, которые фильтруются.
vSaveTables[I].EnableControls;
end;
MemoMessages.Append(TimeToStr(Now())+' Все таблицы восстановлены из сохраненных файлов.');
end;
end;
procedure SaveSession;
var
I:Integer;
begin
try
MemoMessages.Append(TimeToStr(Now())+' Начало сохранения сеанса в постоянные файлы.');
vSuppressEvents:=True;
//Отключаем элементы управления и обновляем все наборы данных
for I:=Low(vSaveTables) to High(vSaveTables) do begin
vSaveTables[I].DisableControls;
vSaveTables[I].Refresh; //Важный момент, если набор данных был отфильтрован
end;
//Сохраняем сеанс работы в файл
for I:=Low(vSaveTables) to High(vSaveTables) do begin
vSaveTables[I].First;
MemoMessages.Append(TimeToStr(Now())+' Сохранение таблицы: '+vSaveTables[I].Name);
try
//Проверяем константу для выбора способа сохранения/восстановления данных и загрузки сохраненного сеанса
case cSaveRestore of
0:vSaveTables[I].SaveToFile(vSaveTables[I].Name);
1:SaveToCsv(vSaveTables[I]);
end;
except
on E:Exception do begin
MemoMessages.Append(TimeToStr(Now())+' Ошибка при сохранении таблицы: '+vSaveTables[I].Name +'. '+E.Message);
end;
end;
MemoMessages.Append(TimeToStr(Now())+' Таблица: '+vSaveTables[I].Name+' сохранена.');
end;
finally
vSuppressEvents:=False;
//Обновляем все наборы данных и включаем элементы управления
for I:=Low(vSaveTables) to High(vSaveTables) do begin
vSaveTables[I].Refresh; //Необходимо для таблиц, которые фильтруются
vSaveTables[I].EnableControls;
end;
MemoMessages.Append(TimeToStr(Now())+' Все таблицы сохранены в файлы.');
end;
end;
procedure EmptyMemDataSet(DataSet:TMemDataSet);
var
vTemporaryMemDataSet:TMemDataSet;
vFieldDef:TFieldDef;
I:Integer;
begin
try
//Создаем временный MemDataSet
vTemporaryMemDataSet:=TMemDataSet.Create(nil);
//Сохраняем FieldDefs во временном MemDataSet
for I:=0 to DataSet.FieldDefs.Count-1 do begin
vFieldDef:=vTemporaryMemDataSet.FieldDefs.AddFieldDef;
with DataSet.FieldDefs[I] do begin
vFieldDef.Name:=Name;
vFieldDef.DataType:=DataType;
vFieldDef.Size:=Size;
vFieldDef.Required:=Required;
end;
end;
//Очищаем существующие fielddefs
DataSet.Clear;
//Восстанавливаем fielddefs
DataSet.FieldDefs:=vTemporaryMemDataSet.FieldDefs;
DataSet.Active:=True;
finally
vTemporaryMemDataSet.Clear;
vTemporaryMemDataSet.Free;
end;
end;
procedure LoadFromCsv(DataSet:TDataSet);
var
vFieldCount:Integer;
I:Integer;
begin
try
//Назначаем SdfDataSetTemporary
with SdfDataSetTemporary do begin
Active:=False;
ClearFields;
FileName:=DataSet.Name+'.txt';
FirstLineAsSchema:=True;
Active:=True;
//Определяем количество полей
vFieldCount:=FieldDefs.Count;
end;
//Выполняем итерацию по SdfDataSetTeditional и вставляем записи в MemDataSet.
SdfDataSetTemporary.First;
while not SdfDataSetTemporary.EOF do begin
DataSet.Append;
//Итерация по FieldDefs
for I:=0 to vFieldCount-1 do begin
try
DataSet.Fields[I].Value:=SdfDataSetTemporary.Fields[I].Value;
except
on E:Exception do begin
MemoMessages.Append(TimeToStr(Now())+' Ошибка при установке значения для поля: '
+DataSet.Name+'.'+DataSet.Fields[I].Name +'. '+E.Message);
end;
end;
end;
try
DataSet.Post;
except
on E:Exception do begin
MemoMessages.Append(TimeToStr(Now())+' Ошибка при сохранении записи в таблицу: '
+DataSet.Name+'.'+E.Message);
end;
end;
SdfDataSetTemporary.Next;
end;
finally
SdfDataSetTemporary.Active:=False;
SdfDataSetTemporary.ClearFields;
end;
end;
procedure SaveToCsv(DataSet:TDataSet);
var
myFileName:string;
myTextFile: TextFile;
i: integer;
s: string;
begin
myFileName:=DataSet.Name+'.txt';
//создаем новый файл
AssignFile(myTextFile, myFileName);
Rewrite(myTextFile);
s := ''; //инициализируем пустую строку
try
//записываем имена полей (как заголовки столбцов)
for i := 0 to DataSet.Fields.Count - 1 do
begin
s := s + Format('%s,', [DataSet.Fields[i].FieldName]);
end;
Writeln(myTextFile, s);
DataSet.First;
//записываем значения полей
while not DataSet.Eof do
begin
s := '';
for i := 0 to DataSet.FieldCount - 1 do
begin
//Числовые поля без кавычек, строковые поля с кавычками
if ((DataSet.FieldDefs[i].DataType=ftInteger)
or (DataSet.FieldDefs[i].DataType=ftFloat)) then
s := s + Format('%s,', [DataSet.Fields[i].AsString])
else
s := s + Format('"%s",', [DataSet.Fields[i].AsString]);
end;
Writeln(myTextfile, s);
DataSet.Next;
end;
finally
CloseFile(myTextFile);
end;
end;
Автогенератор первичных ключей
Тип поля Autoincrement не поддерживается MemDataset. Тем не менее, вы можете имитировать его, используя тип поля Integer и предоставляя калькулятор для полей автогенератора. Нам нужны глобальные переменные или открытые свойства для хранения текущего значения поля автогенератора. Я предпочитаю глобальные переменные, объявленные в интерфейсной части модуля.
var
//Глобальные переменные, используемые для вычисления полей автогенератора первичного ключа MemDatasets
vCurrentId:Integer=0;
vProductsId:Integer=0;
vBomsId:Integer=0;
vBomCalculationProductsId:Integer=0;
vBomCalculationComponentsId:Integer=0;
vBomCalculationFooterId:Integer=0;
vBomCalculationProductsMultipleId:Integer=0;
vBomCalculationComponentsMultipleId:Integer=0;
vBomCalculationFooterMultipleId:Integer=0;
vStocksId:Integer=0;
vOrdersId:Integer=0;
vImportVariantsId:Integer=0;
vImportToTablesId:Integer=0;
vImportToFieldsId:Integer=0;
vImportFromTablesId:Integer=0;
vImportFromFieldsId:Integer=0;
Тогда у нас есть процедура для расчета значений полей автогенератора:
procedure GetAutoincrementPrimaryFields;
var
I:Integer;
vId:^Integer;
begin
try
MemoMessages.Lines.Append(TimeToStr(Now())+' Получение информации о полях автогенератора');
vSuppressEvents:=True;
//Отключаем элементы управления и обновляем все наборы данных
for I:=Low(vSaveTables) to High(vSaveTables) do begin
vSaveTables[I].DisableControls;
vSaveTables[I].Refresh; //Важный момент, если набор данных был отфильтрован
end;
for I:=Low(vSaveTables) to High(vSaveTables) do begin
with vSaveTables[I] do begin
//Используем соответствующую глобальную переменную
case StringToCaseSelect(Name,
['Products','Boms','Stocks','Orders',
'BomCalculationProducts','BomCalculationComponents','BomCalculationFooter',
'BomCalculationProductsMultiple','BomCalculationComponentsMultiple','BomCalculationFooterMultiple',
'ImportVariants','ImportToTables','ImportToFields','ImportFromTables','ImportFromFields']) of
0:vId:=@vProductsId;
1:vId:=@vBomsId;
2:vId:=@vStocksId;
3:vId:=@vOrdersId;
4:vId:=@vBomCalculationProductsId;
5:vId:=@vBomCalculationComponentsId;
6:vId:=@vBomCalculationFooterId;
7:vId:=@vBomCalculationProductsMultipleId;
8:vId:=@vBomCalculationComponentsMultipleId;
9:vId:=@vBomCalculationFooterMultipleId;
10:vId:=@vImportVariantsId;
11:vId:=@vImportToTablesId;
12:vId:=@vImportToFieldsId;
13:vId:=@vImportFromTablesId;
14:vId:=@vImportFromFieldsId;
end;
try
//Находим последнее значение ID и сохраняем его в глобальной переменной
Last;
vCurrentId:=FieldByName(Name+'Id').AsInteger;
if (vCurrentId>vId^) then vId^:=vCurrentId;
finally
//Удаляем ссылку
vId:=nil;
end;
end;
end;
finally
vSuppressEvents:=False;
//Обновляем все наборы данных и включаем элементы управления
for I:=Low(vSaveTables) to High(vSaveTables) do begin
vSaveTables[I].Refresh;
vSaveTables[I].EnableControls;
end;
MemoMessages.Lines.Append(TimeToStr(Now())+' Автоинкрементные поля - готовы.');
end;
end;
function StringToCaseSelect(Selector:string;CaseList:array of string):Integer;
var
cnt: integer;
begin
Result:=-1;
for cnt:=0 to Length(CaseList)-1 do
begin
if CompareText(Selector, CaseList[cnt]) = 0 then
begin
Result:=cnt;
Break;
end;
end;
end;
Процедура GetAutoincrementPrimaryFields вызывается каждый раз после восстановления (загрузки) данных из постоянных файлов, чтобы загрузить последние значения автогенератора в глобальные переменные (или свойства, как вы предпочитаете). Автоинкрементация выполняется в событии OnNewRecord каждого MemDataset. Например, для таблицы Orders MemDataset:
procedure TMainForm.OrdersNewRecord(DataSet: TDataSet);
begin
if vSuppressEvents then Exit;
//Устанавливаем новое значение автогенератора
vOrdersId:=vOrdersId+1;
DataSet.FieldByName('OrdersId').AsInteger:=vOrdersId;
end;
Как уже объяснялось, я использую глобальную переменную vSuppressEvents в качестве флага для случая восстановления данных из постоянных файлов.
Обеспечение ссылочной целостности
В компоненте MemDataset встроенная ссылочная целостность не реализована, поэтому вы должны сделать это самостоятельно.
Предположим, у нас есть две таблицы: MasterTable и DetailTable.
Существуют различные места, где необходимо использовать код ссылочной целостности:
- Код вставки/обновления находится в событии
BeforePost
DetailTable: перед сохранением новой/обновленной detail-записи ее необходимо проверить на соответствие требованиям ссылочной целостности - Код удаления находится в событии
BeforeDelete
в MasterTable: перед удалением master-записи необходимо убедиться, что все дочерние записи соответствуют требованиям ссылочной целостности
procedure TMainForm.MasterTableBeforeDelete(DataSet: TDataSet);
begin
if vSuppressEvents then Exit;
try
DetailTable.DisableControls;
// Принудительное удаление ссылок («каскадное удаление») для таблицы «MasterTable»
while not DetailTable.EOF do begin
DetailTable.Delete;
end;
DetailTable.Refresh;
finally
DetailTable.EnableControls;
end;
end;
procedure TMainForm.DetailTableBeforePost(DataSet: TDataSet);
begin
if vSuppressEvents=True then Exit;
// Принудительное использование ссылочной вставки/обновления для таблицы «DetailTable» с
// внешним ключом «MasterTableID», ссылающимся на
// поле первичного ключа идентификатора MasterTable ID
DataSet.FieldByName('MasterTableId').AsInteger:=
MasterTable.FieldByName('ID').AsInteger;
end;
После того, как вы предоставили ссылочную вставку/обновление/удаление, все, что вам нужно сделать, это предоставить код для master/detail фильтрации данных. Это делается в событии AfterScroll
в MasterTable и в событии OnFilter
в DetailTable.
Не забудьте установить для свойства Filtered
DetailTable значение True.
procedure TMainForm.MasterTableAfterScroll(DataSet: TDataSet);
begin
if vSuppressEvents=True then Exit;
DetailTable.Refresh;
end;
procedure TMainForm.DetailTableFilterRecord(DataSet: TDataSet;
var Accept: Boolean);
begin
if vSuppressEvents=True then Exit;
// Показывем только дочерние поля, внешний ключ которых указывает на текущую
// запись master таблицы
Accept:=DataSet.FieldByName('MasterTableId').AsInteger=
MasterTable.FieldByName('ID').AsInteger;
end;
Известные проблемы
Есть несколько ограничений при использовании MemDatasets.
- Метод locate не работает
- Фильтрация с использованием свойства Filter и Filtered не работает. Вы должны использовать жесткое кодирование в событии OnFilter.
- Повторное удаление записей кажется невероятно медленным. Поэтому я использую мою процедуру EmptyMemDataset вместо
while not EOF do Delete;
- В FPC 2.6.x и более ранних версиях метод CopyFromDataSet копирует данные только с текущей позиции курсора в конец набора исходных данных. Итак, вы должны написать
MemDataset1.First;
передMemDataSet2.CopyFromDataSet(MemDataset1);
. Исправлено в транке ревизии FPC 26233.- Обратите внимание, что более старые версии FPC не имеют CopyFromDataset в Bufdataset, в то время как это - преимущество для MemDs.
- См. багрепорт http://bugs.freepascal.org/view.php?id=25426.
TBufDataSet
Как упоминалось ранее, в MemDataSet отсутствуют пользовательские фильтры, тип данных автоинкремента и метод Locate, поэтому взамен лучше использовать TBufDataSet. TBufDataset предоставляется модулем BufDataset.
Поскольку нет компонента для редактирования TBufDataSet во время разработки (но вы можете настроить определения полей во время разработки), вы можете создать пользовательский компонент-обертку или использовать его через код так же, как ClientDataSet в Delphi. Подробности смотрите в документации Delphi, касающейся наборов данных клиента для подробностей.
Вы можете использовать те же методы для обеспечения ссылочной целостности и первичных полей автоинкремента, как описано для MemDataSet.
Между MemDataSet и BufDataset есть только небольшие различия:
MemDataSet | BufDataset |
---|---|
DataSet.ClearFields | DataSet.Fields.Clear |
DataSet.CreateTable | DataSet.CreateDataSet |
Сортировка DBGrid по событию OnTitleClick для TBufDataSet
Если вы хотите включить последовательную сортировку DBGrid по возрастанию и убыванию, показывающую некоторые данные из TBufDataSet, вы можете использовать следующий метод:
Uses
BufDataset, typinfo;
function SortBufDataSet(DataSet: TBufDataSet;const FieldName: String): Boolean;
var
i: Integer;
IndexDefs: TIndexDefs;
IndexName: String;
IndexOptions: TIndexOptions;
Field: TField;
begin
Result := False;
Field := DataSet.Fields.FindField(FieldName);
//Если неверное имя поля, выйдем.
if Field = nil then Exit;
//Если неверный тип поля, выйдем.
if {(Field is TObjectField) or} (Field is TBlobField) or
{(Field is TAggregateField) or} (Field is TVariantField)
or (Field is TBinaryField) then Exit;
//Получаем IndexDefs и IndexName, используя RTTI
if IsPublishedProp(DataSet, 'IndexDefs') then
IndexDefs := GetObjectProp(DataSet, 'IndexDefs') as TIndexDefs
else
Exit;
if IsPublishedProp(DataSet, 'IndexName') then
IndexName := GetStrProp(DataSet, 'IndexName')
else
Exit;
//Убедитесь, что IndexDefs об-нов-лен
IndexDefs.Updated:=false; {<<<<---Эта строка имеет решающее значение, так как IndexDefs.Update ничего не будет делать при следующей сортировке, если она уже верна}
IndexDefs.Update;
//Если восходящий индекс уже используется,
//переключаемся на нисходящий индекс
if IndexName = FieldName + '__IdxA'
then
begin
IndexName := FieldName + '__IdxD';
IndexOptions := [ixDescending];
end
else
begin
IndexName := FieldName + '__IdxA';
IndexOptions := [];
end;
//ищем существующий индекс
for i := 0 to Pred(IndexDefs.Count) do
begin
if IndexDefs[i].Name = IndexName then
begin
Result := True;
Break
end; //if
end; // for
//Если существующий индекс не найден, создаем его
if not Result then
begin
if IndexName=FieldName + '__IdxD' then
DataSet.AddIndex(IndexName, FieldName, IndexOptions, FieldName)
else
DataSet.AddIndex(IndexName, FieldName, IndexOptions);
Result := True;
end; // if not
//Устанавливаем индекс
SetStrProp(DataSet, 'IndexName', IndexName);
end;
Итак, вы можете вызвать эту функцию из DBGrid следующим образом:
procedure TFormMain.DBGridProductsTitleClick(Column: TColumn);
begin
SortBufDataSet(Products, Column.FieldName);
end;
Сортировка нескольких столбцов в grid
Я написал TDBGridHelper для сортировки grid по нескольким столбцам, удерживая клавишу Shift.
Но я думаю, что люди не будут использовать больше 10, поэтому установка 100 должна быть теоретически приемлемой.
{ TDBGridHelper }
TDBGridHelper = class helper for TDBGrid
public const
cMaxColCOunt = 3;
private
procedure Interbal_MakeNames(Fields: TStrings; out FieldsList, DescFields: String);
procedure Internal_SetColumnsIcons(Fields: TStrings; AscIdx, DescIdx: Integer);
function Internal_IndexNameExists(IndexDefs: TIndexDefs; IndexName: String): Boolean;
public
procedure Sort(const FieldName: String; AscIdx: Integer = -1; DescIdx: Integer = -1);
procedure ClearSort;
end;
{ TDBGridHelper }
procedure TDBGridHelper.Interbal_MakeNames(Fields: TStrings; out FieldsList, DescFields: String);
var
FldList: TStringList;
DscList: TStringList;
FldDesc, FldName: String;
i: Integer;
begin
if Fields.Count = 0 then
begin
FieldsList := '';
DescFields := '';
Exit;
end;
FldList := TStringList.Create;
DscList := TStringList.Create;
try
FldList.Delimiter := ';';
DscList.Delimiter := ';';
for i := 0 to Fields.Count - 1 do
begin
Fields.GetNameValue(i, FldName, FldDesc);
FldList.Add(FldName);
if FldDesc = 'D' then
DscList.Add(FldName);
end;
FieldsList := FldList.DelimitedText;
DescFields := DscList.DelimitedText;
finally
FldList.Free;
DscList.Free;
end;
end;
procedure TDBGridHelper.Internal_SetColumnsIcons(Fields: TStrings; AscIdx, DescIdx: Integer);
var
i: Integer;
FldDesc: String;
begin
for i := 0 to Self.Columns.Count - 1 do
begin
FldDesc := Fields.Values[Self.Columns[i].Field.FieldName];
if FldDesc = 'A' then
Self.Columns[i].Title.ImageIndex := AscIdx
else
if FldDesc = 'D' then
Self.Columns[i].Title.ImageIndex := DescIdx
else
Self.Columns[i].Title.ImageIndex := -1
end;
end;
function TDBGridHelper.Internal_IndexNameExists(IndexDefs: TIndexDefs; IndexName: String): Boolean;
var
i: Integer;
begin
for i := 0 to IndexDefs.Count - 1 do
begin
if IndexDefs[i].Name = IndexName then
Exit(True)
end;
Result := False
end;
procedure TDBGridHelper.Sort(const FieldName: String; AscIdx: Integer;
DescIdx: Integer);
var
Field: TField;
DataSet: TBufDataset;
IndexDefs: TIndexDefs;
IndexName, Dir, DescFields, FieldsList: String;
Fields: TStringList;
begin
if not Assigned(DataSource.DataSet) or
not DataSource.DataSet.Active or
not (DataSource.DataSet is TBufDataset) then
Exit;
DataSet := DataSource.DataSet as TBufDataset;
Field := DataSet.FieldByName(FieldName);
if (Field is TBlobField) or (Field is TVariantField) or (Field is TBinaryField) then
Exit;
IndexDefs := DataSet.IndexDefs;
IndexName := DataSet.IndexName;
if not IndexDefs.Updated then
IndexDefs.Update;
Fields := TStringList.Create;
try
Fields.DelimitedText := IndexName;
Dir := Fields.Values[FieldName];
if Dir = 'A' then
Dir := 'D'
else
if Dir = 'D' then
Dir := 'A'
else
Dir := 'A';
//Если нажата клавиша Shift, добавляем поле в список полей.
if ssShift in GetKeyShiftState then
begin
Fields.Values[FieldName] := Dir;
//Мы не добавляем в сортировку больше полей, если общее количество полей превышает cMaxColCOunt
if Fields.Count > cMaxColCOunt then
Exit;
end
else
begin
Fields.Clear;
Fields.Values[FieldName] := Dir;
end;
IndexName := Fields.DelimitedText;
if not Internal_IndexNameExists(IndexDefs, IndexName) then
begin
Interbal_MakeNames(Fields, FieldsList, DescFields);
TBufDataset(DataSet).AddIndex(IndexName, FieldsList, [], DescFields, '');
end;
DataSet.IndexName := IndexName;
Internal_SetColumnsIcons(Fields, AscIdx, DescIdx)
finally
Fields.Free;
end;
end;
procedure TDBGridHelper.ClearSort;
var
DataSet: TBufDataset;
Fields: TStringList;
begin
if not Assigned(DataSource.DataSet) or
not DataSource.DataSet.Active or
not (DataSource.DataSet is TBufDataset) then
Exit;
DataSet := DataSource.DataSet as TBufDataset;
DataSet.IndexName := '';
Fields := TStringList.Create;
try
Internal_SetColumnsIcons(Fields, -1, -1)
finally
Fields.Free
end
end;
Чтобы использовать сортировку, нужно вызвать вспомогательные методы в OnCellClick и onTitleClick. OnTitleClick - если вы удерживаете клавишу shift, добавляется новый столбец в список сортировки, или меняется направление сортировки выбранного столбца, или просто сортируется один столбец. OnCellClick - если дважды щелкнуть ячейку [0, 0], сетка очищает ее сортировку.
procedure TForm1.grdCountriesCellClick(Column: TColumn);
begin
if not Assigned(Column) then
grdCountries.ClearSort
end;
procedure TForm1.grdCountriesTitleClick(Column: TColumn);
begin
grdCountries.Sort(Column.Field.FieldName, 0, 1);
end;
Если вы назначили TitleImageList, вы можете указать, какое изображение использовать для восходящей, а какое для нисходящей сортировки.
ZMSQL
Другой, часто лучший способ написания баз данных в памяти - это использование пакета ZMSQL:
- ZMSQL
- http://sourceforge.net/projects/lazarus-ccr/files/zmsql/
- http://www.lazarus.freepascal.org/index.php/topic,13821.30.html
Авторство
Оригинальный текст написан: Zlatko Matić (matalab@gmail.com)
Вклад других авторов, как показано на странице History.