Сначало хотел на UIB сделать, но там проблемы с копированием BLOB
http://www.progdigy.com/modules.php?nam ... pic&t=4050
Сейчас сделал на FIBL но при копировании BLOB полей память течёт очень жёстко.
Вариант на FIBL.
- Код: Выделить всё
// открытие FB базы.
// @param DBHost сервер где установлена СУБД
// @param DBName имя базы (путь к файлу или алиас)
// @param UserName имя пользователя
// @param Password пароль
// @return ссылка на TFIBDatabase, к которому привязан TFIBTransaction
// @seealso FBDBClose
function FBDBOpen(DBHost, DBName, UserName, Password:string):pointer;
var
FBDB: TFIBDatabase;
FBDBT: TFIBTransaction;
DBPath: String;
begin
result := nil;
DBPath := '';
if (length(DBHost) > 0) then
DBPath := DBHost + ':';
DBPath := DBPath + DBName;
FBDB := TFIBDatabase.Create(nil);
result := FBDB;
FBDB.DBName := DBPath;
FBDB.UserName := UserName;
FBDB.Password := Password;
FBDB.Encoding := 'WIN1251';
FBDBT := TFIBTransaction.Create(nil);
FBDBT.TRParams.Add('read_committed');
FBDBT.TRParams.Add('rec_version');
FBDBT.TRParams.Add('nowait');
FBDBT.DefaultDatabase := FBDB;
FBDB.DefaultTransaction := FBDBT;
try
FBDB.Connected := True;
except
raise Exception.Create('Не удалось соединиться с FB базой');
end;
end;// function FBDBOpen
// закрытие FB базы.
// @param DB открытая ранее база (ссылка на TFIBDatabase, к которому привязан
// TFIBTransaction)
// @seealso FBDBOpen
procedure FBDBClose(DB:pointer);
begin
if DB <> nil then
begin
TFIBDatabase(DB).Close;
TFIBDatabase(DB).Free;
end;
end;// procedure FBDBClose
function CopyTableFBToFB(FBDBFrom, FBDBTo:pointer;
table, filter:AnsiString):boolean;
var
FBFromDataSet, FBToDataSet : TFIBDataSet;
FieldsSQL, ValuesSQL:string;
request:AnsiString;
i : integer;
RecordsInTransaction : integer;
blob_stream:TMemoryStream;
begin
result := true;
FieldsSQL := '';
ValuesSQL := '';
FBFromDataSet := TFIBDataSet.Create(nil);
FBFromDataSet.Database := TFIBDatabase(FBDBFrom);
FBFromDataSet.Transaction := TFIBDatabase(FBDBFrom).DefaultTransaction;
FBFromDataSet.Transaction.StartTransaction;
FBFromDataSet.SelectSQL.Clear;
request := 'SELECT * FROM ' + table;
if (length(filter) <> 0) then
request := request + ' WHERE ' + filter;
FBFromDataSet.SelectSQL.Add(request);
FBFromDataSet.Open;
FBToDataSet := TFIBDataSet.Create(nil);
FBToDataSet.Database := TFIBDatabase(FBDBTo);
FBToDataSet.Transaction := TFIBDatabase(FBDBTo).DefaultTransaction;
FBToDataSet.Transaction.StartTransaction;
FBToDataSet.SelectSQL.Clear;
FBToDataSet.SelectSQL.Add('SELECT * FROM ' + table);
// формирование запроса на вставку
for i:= 0 to FBFromDataSet.FieldCount-1 do
begin
if AnsiCompareStr(AnsiLowerCase(FBFromDataSet.Fields.Fields[i].FieldName), 'type') = 0 then
FieldsSQL := FieldsSQL + '"' + AnsiUpperCase(FBFromDataSet.Fields.Fields[i].FieldName) + '"'
else
FieldsSQL := FieldsSQL + FBFromDataSet.Fields.Fields[i].FieldName;
if i < FBFromDataSet.FieldCount-1 then
FieldsSQL := FieldsSQL + ','
end;
ValuesSQL := ':' + StringReplace(FieldsSQL, ',', ',:', [rfReplaceAll]);
FBToDataSet.InsertSQL.Clear;
FBToDataSet.InsertSQL.Add('INSERT INTO ' + table +
'(' + FieldsSQL + ') VALUES (' + ValuesSQL + ')');
FBToDataSet.Open;
// проверка на соотвествие полей
for i:= 0 to FBFromDataSet.FieldCount-1 do
if (FBFromDataSet.Fields.Fields[i].FieldName <> FBToDataSet.Fields.Fields[i].FieldName) or
(FBFromDataSet.Fields.Fields[i].DataType <> FBToDataSet.Fields.Fields[i].DataType)
then
begin
result := false;
break;
end;
// копирование
RecordsInTransaction := 0;
try
FBFromDataSet.First;
while not FBFromDataSet.Eof do
begin
FBToDataSet.Insert;
for i:= 0 to FBFromDataSet.FieldCount-1 do
begin
if (FBToDataSet.Fields.Fields[i].DataType = ftBlob) then
begin
blob_stream := TMemoryStream.Create();
TBlobField(FBFromDataSet.Fields.Fields[i]).SaveToStream(blob_stream);
TBlobField(FBToDataSet.Fields.Fields[i]).LoadFromStream(blob_stream);
blob_stream.Clear;
blob_stream.Free;
end
else
FBToDataSet.FieldByName(FBToDataSet.Fields.Fields[i].FieldName).Assign(
FBFromDataSet.FieldByName(FBToDataSet.Fields.Fields[i].FieldName));
end;
FBToDataSet.Post;
// ограничение на кол-во записей вставляемых в рамках одной транзакции
inc(RecordsInTransaction);
if RecordsInTransaction > MaxRecordsInTransaction then
FBToDataSet.Transaction.CommitRetaining;
FBFromDataSet.Next;
end;// while not FBFromDataSet.Eof do
except
result := false;
end;
// освобождение ресурсов
if result then
FBToDataSet.Transaction.Commit
else
FBToDataSet.Transaction.Rollback;
FBToDataSet.Close;
FBToDataSet.Free;
FBFromDataSet.Close;
FBFromDataSet.Free;
end;// function CopyTableFBToFB
procedure TForm1.Button3Click(Sender: TObject);
var
from_db, to_db:pointer;
begin
from_db := FBDBOpen('', 'D:\AlexBer\MOD\MOD_TEST\MOD_TEST.GDB',
'sysdba', 'masterkey');
to_db := FBDBOpen('', 'D:\AlexBer\MOD\LazMod\DB_TEST.GDB',
'sysdba', 'masterkey');
CopyTableFBToFB(from_db, to_db, 'table1', '');
FBDBClose(to_db);
FBDBClose(from_db);
end;
в TFIBQuery не нашёл где кол-во полей брать.
что я сделал не так?
