Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
Разработка программного обеспечения
KANSoftWare

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

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

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

Автор: 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 может быть полезна для разработчиков на Delphi и FreePascal.


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


Ваше мнение или вопрос к статье в виде простого текста (Tag <a href=... Disabled). Все комментарии модерируются, модератор оставляет за собой право удалить непонравившейся ему комментарий.

заголовок

e-mail

Ваше имя

Сообщение

Введите код




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



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


реклама

::


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru Rambler's Top100
20.10.2021 01:21:11/0.004094123840332/2