|
Создание таблицы программным путем
Автор: Цымбал Виталий
{ **** 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;;;') |
Автор проекта: ___Nikolay