Создание таблицы программным путем

Delphi , Базы данных , Таблицы

Автор: Цымбал Виталий
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> 
Function CreateTable(liTableType:Integer;lsTableName:AnsiString;lsFields:AnsiString):BOOLEAN;

liTableType
Value Meaning
0 ttDefault (Default) Determine table type based on file extension for the table.
1 ttParadox Table is a Paradox table.
2 ttDBase Table is a dBASE table.
3 ttFoxPro Table is a FoxPro table.
4 ttASCII Table is a text file with comma-delimited, quoted strings for each field

If liTableType is set to 0(ttDefault), the lsTableName extension determines the table type:
Extension Meaning
DB or none Paradox table
DBF dBASE table
TXT ASCII table

ATTENTION!!
lsFields
‘Name1;DataType1;Size1;Precision1;Requered1;Name2;DataType2;Size2;
Precision2;Requered2;…;…;…;…;…; NameN;DataTypeN;SizeN;PrecisionN;RequeredN’

1.Name : string;
2.DataType : TFieldType:

Value Description
ftUnknown Unknown or undetermined
ftString Character or string field
ftSmallint 16-bit integer field
ftInteger 32-bit integer field
ftWord 16-bit unsigned integer field
ftBoolean Boolean field
ftFloat Floating-point numeric field
ftCurrency Money field
ftBCD Binary-Coded Decimal field
ftDate Date field
ftTime Time field
ftDateTime Date and time field
ftBytes Fixed number of bytes (binary storage)
ftVarBytes Variable number of bytes (binary storage)
ftAutoInc Auto-incrementing 32-bit integer counter field
ftBlob Binary Large OBject field
ftMemo Text memo field
ftGraphic Bitmap field
ftFmtMemo Formatted text memo field
ftParadoxOle Paradox OLE field
ftDBaseOle dBASE OLE field
ftTypedBinary Typed binary field
ftCursor Output cursor from an Oracle stored procedure (TParam only)
ftFixedChar Fixed character field
ftWideString Wide string field
ftLargeInt Large integer field
ftADT Abstract Data Type field
ftArray Array field
ftReference REF field
ftDataSet DataSet field
ftOraBlob BLOB fields in Oracle 8 tables
ftOraClob CLOB fields in Oracle 8 tables
ftVariant Data of unknown or undetermined type
ftInterface References to interfaces (IUnknown)
ftIDispatch References to IDispatch interfaces
ftGuid globally unique identifier (GUID) values

3. Size : integer
4. Precision : integer;
- for DataType ftBCD only
5. Requered : Boolean
Value – [true;false]

Example

CreateTable(1,'c:\base1','CODE;ftString;60;0;;NAME;ftString;100;0;true;COUNT;
ftInteger;;;;SUM;ftBCD;10;2;false;DATE;ftDate;;;')

Зависимости: Windows, Messages, SysUtils, Classes, Db, DBTables
Автор:       Цымбал Виталий Викторович, victor@ab-system.com, Львов
Copyright:   Cобственная разработка
Дата:        16 августа 2002 г.
***************************************************** }

function TForm1.CreateTable(liTableType: Integer; lsTableName: AnsiString;
  lsFields: AnsiString): BOOLEAN;
var
  TType, S, lSTR: AnsiString;
  i: integer;
  lSize: boolean;
  FTable: TTable;
begin
  try
    Result := True;
    i := 0;
    lSTR := lsFields;
    while Pos(';', lSTR) > 0 do
    begin
      lSTR[Pos(';', lSTR)] := '0';
      i := i + 1;
    end;
    i := i + 1;
    // проверка на количество разделителей ';' в описании полей - должно быть
    // кратно 5
    if (int(i / 5)) <> (i / 5) then
    begin
      ShowMessage('Ошибка!' + #13 +
        'Неверное количество параметров в строке с данными про поля таблицы');
      Result := False;
    end;
    // создание объекта - таблица
    FTable := TTable.Create(nil);
    with FTable do
    begin
      Active := False;
      // задание типа таблицы в числовом выражении
      case liTableType of
        0: TableType := ttDefault;
        1: TableType := ttParadox;
        2: TableType := ttDBase;
        3: TableType := ttFoxPro;
        4: TableType := ttASCII;
      else
        begin
          ShowMessage('Ошибка!' + #13 +
            'Неверно задан тип тиблицы (возможны значения 0-4)');
          Result := False;
        end;
      end;
      // ввод имени таблицы с полным путем
      TableName := lsTableName;
      FieldDefs.Clear;
      while Pos(';', lsFields) > 0 do
      begin
        with FieldDefs do
        begin
          S := copy(lsFields, 1, Pos(';', lsFields) - 1);
          with AddFieldDef do
          begin
            // анализ и разбивка строки с данными про поля таблицы
            system.delete(lsFields, 1, Pos(';', lsFields));
            Name := S;
            S := copy(lsFields, 1, Pos(';', lsFields) - 1);
            lSize := True;
            if (S = 'ftUnknown') then
            begin
              DataType := ftUnknown;
              lSize := False;
            end;
            if (S = 'ftString') then
              DataType := ftString;
            if (S = 'ftBCD') then
              DataType := ftBCD;
            if (S = 'ftBytes') then
              DataType := ftBytes;
            if (S = 'ftVarBytes') then
              DataType := ftVarBytes;
            if (S = 'ftBlob') then
              DataType := ftBlob;
            if (S = 'ftMemo') then
              DataType := ftMemo;
            if (S = 'ftFmtMemo') then
              DataType := ftFmtMemo;
            if (S = 'ftSmallint') then
            begin
              DataType := ftSmallint;
              lSize := False;
            end;
            if (S = 'ftInteger') then
            begin
              DataType := ftInteger;
              lSize := False;
            end;
            if (S = 'ftBoolean') then
              DataType := ftBoolean;
            if (S = 'ftFloat') then
            begin
              DataType := ftFloat;
              lSize := False;
            end;
            if (S = 'ftCurrency') then
            begin
              DataType := ftCurrency;
              lSize := False;
            end;
            if (S = 'ftTime') then
            begin
              DataType := ftTime;
              lSize := False;
            end;
            if (S = 'ftDate') then
            begin
              DataType := ftDate;
              lSize := False;
            end;
            if (S = 'ftDateTime') then
            begin
              DataType := ftDateTime;
              lSize := False;
            end;
            if (S = 'ftAutoInc') then
            begin
              DataType := ftAutoInc;
              lSize := False;
            end;
            if (S = 'ftGraphic') then
              DataType := ftGraphic;
            if (S = 'ftParadoxOle') then
              DataType := ftParadoxOle;
            if (S = 'ftDBaseOle') then
              DataType := ftDBaseOle;
            if (S = 'ftTypedBinary') then
              DataType := ftTypedBinary;
            if (S = 'ftCursor') then
            begin
              DataType := ftCursor;
              lSize := False;
            end;
            if (S = 'ftFixedChar') then
              DataType := ftFixedChar;
            if (S = 'ftWideString') then
              DataType := ftWideString;
            if (S = 'ftLargeint') then
              DataType := ftLargeint;
            if (S = 'ftADT') then
              DataType := ftADT;
            if (S = 'ftArray') then
              DataType := ftArray;
            if (S = 'ftReference') then
            begin
              DataType := ftReference;
              lSize := False;
            end;
            if (S = 'ftDataSet') then
            begin
              DataType := ftDataSet;
              lSize := False;
            end;
            if (S = 'ftOraBlob') then
              DataType := ftOraBlob;
            if (S = 'ftVariant') then
              DataType := ftVariant;
            if (S = 'ftInterface') then
              DataType := ftInterface;
            if (S = 'ftIDispatch') then
              DataType := ftIDispatch;
            if (S = 'ftGuid') then
              DataType := ftGuid;
            if (S = 'ftBoolean') then
            begin
              DataType := ftBoolean;
              lSize := False;
            end;
            if (S = 'ftWord') then
            begin
              DataType := ftWord;
              lSize := False;
            end;
            TType := S;
            system.delete(lsFields, 1, Pos(';', lsFields));
            S := copy(lsFields, 1, Pos(';', lsFields) - 1);
            // Precision(Точность) поддерживает только тип BCD
            if lSize then
              if S <> '' then
              begin
                if TType = 'ftBCD' then
                  Precision := StrToInt(S)
                else
                  Size := StrToInt(S);
              end;
            system.delete(lsFields, 1, Pos(';', lsFields));
            S := copy(lsFields, 1, Pos(';', lsFields) - 1);
            if (S <> '') and (TType = 'ftBCD') then
              Size := StrToInt(S); //!!!
            system.delete(lsFields, 1, Pos(';', lsFields));
            if Pos(';', lsFields) > 0 then
            begin
              S := copy(lsFields, 1, Pos(';', lsFields) - 1);
              system.delete(lsFields, 1, Pos(';', lsFields));
            end
            else
              S := lsFields;
            if (S <> '') then
              if (UPPERCASE(s) = 'TRUE') then
                Required := True;
          end;
        end;
      end;
      //создание таблицы с заданными параметрами
      CreateTable;
      // уничтожение объекта - таблица
      FTable.Free
    end;
    if Result = True then
      ShowMessage('Таблица создана успешно')
  except
    ShowMessage('Ошибка при создании таблицы');
  end;
end;
end;

Пример использования:

CreateTable(1, 'c:\base1',
  'CODE;ftString;60;0;;NAME;ftString;100;0;true;COUNT;ftInteger;;;;SUM;ftBCD;10;2;false;DATE;ftDate;;;')

Программирование таблицы программно в Delphi. Функция CreateTable принимает три параметра:

• liTableType: целочисленное значение, определяющее тип таблицы (Paradox, dBase, FoxPro и т.д.).
• lsTableName: строковое значение, указывающее имя и путь к таблице.
• lsFields: строковое значение, описывающее поля таблицы.

Функция сначала проверяет, является ли количество параметров в строке lsFields кратным 5 (числу полей). Если нет, она отображает сообщение об ошибке и возвращает False. Затем функция создает объект TTable и настраивает его свойства соответствующим образом. Функция анализирует каждое описание поля в строке lsFields и настраивает свойства соответствующие поля (Имя, Тип данных, Размер, Точность, Обязательное).

Пример использования:

CreateTable(1, 'c:\base1',
   'CODE;ftString;60;0;;NAME;ftString;100;0;true;COUNT;ftInteger;;;;SUM;ftBCD;10;2;false;DATE;ftDate;;;')

В этом примере создается таблица с именем "base1" в директории "c:\" с пятью полями: CODE (строка, 60 символов), NAME (строка, 100 символов), COUNT (целое число), SUM (BCD, 10 цифр, точность 2) и DATE (дата). Свойство "Обязательное" для поля NAME установлено в True.

Обратите внимание, что это код использует компонент TTable из библиотеки Database Delphi (Db.pas). Функция CreateTable создает новую таблицу с указанными свойствами и затем пытается создать ее на диске. Если возникает ошибка при создании, она отображает сообщение об ошибке.

В улучшении кода есть несколько предложений:

1. Обработка ошибок: Код только ловит общие исключения (E). Лучше ловить конкретные исключения, связанные с операциями базы данных (например, EDatabaseError).
2. Организация кода: Функция CreateTable слишком длинная и сложная. Рекомендуется разбивать ее на более маленькие функции или процедуры для более простой поддержки.
3. Проверка ввода: Код предполагает, что входные параметры являются валидными. Рекомендуется добавлять проверки для недопустимых значений входных параметров, таких как пустое имя таблицы или строка полей.
4. Документация: Добавьте комментарии, объясняющие цель каждого раздела кода и любые предположения о данных ввода.

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

Создание таблицы программным путем: функция CreateTable позволяет создавать таблицы с заданными параметрами, такими как тип таблицы, имя таблицы, поля и их свойства.

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

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

:: Главная :: Таблицы ::