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

Delphi , Компоненты и Классы , TBatchMove

Удобней всего, нап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;

Привет! Вот перевод текста на русский язык:

Это фрагмент кода на Delphi, который создает новый таблицу с тем же структурой как существующая таблица с помощью класса TBatchMove из VCL.

Автор оригинального поста Nomadic столкнулся с проблемой, когда класс TBatchMove увеличивал количество знаков после запятой в числовых полях при создании новой таблицы. Этот код предлагает решение этой проблемы, копируя поле определения из исходной таблицы в целевую таблицу.

Вот шаг за шагом, что код делает:

1. Он открывает два базы данных, одну для источника таблицы и одну для целевой таблицы.
2. Он получает активное состояние источника таблицы и сохраняет его в переменной bActive.
3. Он обновляет поле определения источника таблицы и выделяет память для массива описаний полей (pSrcFldDes).
4. Он открывает источник таблицы и получает ее поле описания с помощью DbiGetFieldDescs.
5. Если целевая таблица должна быть создана с всеми полями из источника таблицы, он обновляет поле определения источника таблицы и выделяет память для массива описаний полей (CrtTableDesc.pFLDDesc).
6. Он проходит по каждому полю в источнике таблицы (либо всем полям, либо только тем, которые указаны в массиве cpyFields) и копирует его описание в целевую таблицу с помощью Move.
7. Он создает целевую таблицу с помощью DbiCreateTable.
8. Наконец, он освобождает память, выделяемую для описаний полей.

Альтернативное решение предлагает более ручной подход к созданию новой таблицы с тем же структурой как существующая таблица. Этот код использует класс TTable и его методы (Open, FieldDefs.Update, и т.д.) для ручного копирования поле определения из источника таблицы в целевую таблицу.

Обратите внимание, что этот код является специфичным для Delphi 1.x, который является quite старым, и может не работать с новыми версиями Delphi.

В статье рассматривается проблема создания таблиц с одинаковой структурой в Delphi, а также предлагается решение этой проблемы через создание процедуры CopyStruct.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: TBatchMove ::