Создавать таблицы такой же структуры



Автор: Nomadic

В 1995 годy на компьютеpной выставке CeBIT в Ганновеpе во вpемя доклада Билла Гейтса в зале поднимали плакат "Alt+F4".

Удобней всего, напpимеp, так


with bmovMyBatchMove do
begin
Mode := bmCopy;
RecordCount := 1;
Execute;R Destination.Delete;
end;

Где bmovMyBatchMove - экземпляр класса TBatchMove из VCL.

Hеправда Ваша! ;)

Этот загадочный BatchMove имеет одну очень неприятную особенность (по крайней мере при работе с DBF-таблицами и в Delphi 1.0x), как-то:

увеличивает в создаваемых таблицах в полях типа NUMBER количество значащих цифр после запятой (не помню - возможно, что и до), если там указаны небольшие (около 1-3 цифр) значения :(.

Я эту особенность побороть не сумел, а мириться с ней в условиях нашей конторы (когда приходится бороться за место под солнцем с программистами на Clipper и FoxPro совершенно неприемлемо.

Кроме того, в предложенном выше варианте еще и запись удалять приходится...:)

Решалась же эта проблема следующим способом:


procedure CopyStruct(SrcTable, DestTable: TTable; cpyFields: array of string);
var
i: Integer;
bActive: Boolean;
SrcDatabase, DestDatabase: TDatabase;
iSrcMemSize, iDestMemSize: Integer;
pSrcFldDes: PFldDesc;
CrtTableDesc: CRTblDesc;
bNeedAllFields: Boolean;
begin
SrcDatabase := Session.OpenDatabase(SrcTable.DatabaseName);
try
DestDatabase := Session.OpenDatabase(DestTable.DatabaseName);
try
bActive := SrcTable.Active;
SrcTable.FieldDefs.Update;
iSrcMemSize := SrcTable.FieldDefs.Count * SizeOf(FLDDesc);
pSrcFldDes := AllocMem(iSrcMemSize);
if pSrcFldDes = nil then
begin
raise EOutOfMemory.Create('Не хватает памяти!');
end;
try
SrcTable.Open;
Check(DbiGetFieldDescs(SrcTable.Handle, pSrcFldDes));
SrcTable.Active := bActive;
FillChar(CrtTableDesc, SizeOf(CrtTableDesc), 0);
with CrtTableDesc do
begin
StrPcopy(szTblName, DestTable.TableName);
StrPcopy(szTblType, 'DBASE');
if (Length(cpyFields[0]) = 0) or (cpyFields[0] = '*') then
begin
bNeedAllFields := True;
SrcTable.FieldDefs.Update;
iFldCount := SrcTable.FieldDefs.Count;
end
else
begin
bNeedAllFields := False;
iFldCount := High(cpyFields) + 1;
end;
iDestMemSize := iFldCount * Sizeof(FLDDesc);
CrtTableDesc.pFLDDesc := AllocMem(iDestMemSize);
if CrtTableDesc.pFLDDesc = nil then
begin
raise EOutOfMemory.Create('Не хватает памяти!');
end;
end;
try
if bNeedAllFields then
begin
for i := 0 to CrtTableDesc.iFldCount - 1 do
begin
Move(PFieldDescList(pSrcFldDes)^[i],
PFieldDescList(CrtTableDesc.pFLDDesc)^[i], SizeOf(FldDesc));
end;
end
else
begin
for i := 0 to CrtTableDesc.iFldCount - 1 do
begin
Move(PFieldDescList(pSrcFldDes)^[SrcTable.FieldDefs.Find(cpyFields[i]).FieldNo - 1],
PFieldDescList(CrtTableDesc.pFLDDesc)^[i], SizeOf(FldDesc));
end;
end;
Check(DbiCreateTable(DestDatabase.Handle, True, CrtTableDesc));
finally
FreeMem(CrtTableDesc.pFLDDesc, iDestMemSize);
end;
finally
FreeMem(pSrcFldDes, iSrcMemSize);
end;
finally
Session.CloseDatabase(DestDatabase);
end;
finally
Session.CloseDatabase(SrcDatabase);
end;
end;


Далее: Пересборка индексов с помощью TBatchMove »»