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

{codecitation class=»brush: pascal; gutter: false;» width=»600px»}

Автор: Цымбал Виталий

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;;;’)

{/codecitation}

Добавить комментарий