Hi folks.
I have a "toast" to you.
I dont know english. I will try. :)
A sample code to read a file with tables structures (INI format).
I use this code to modify/create tables. It's made for Paradox
Files.
Enjoi it.
[]'s
Nileo
--------------------------
File with tables structure (APPNAME.TBL)
;
;Field Types (only valid first char)
;
; Alpha - ftString
; Date - ftDate
; Logical - ftBoolean
; Short - ftSmallInt
; Integer - ftInteger
; Currency - ftCurrency
; Number - ftFloat
; Memo - ftMemo
;
; Index files
;
; 1o Param, Index Key
; Ex.: Field1+Field2+Field3+...
;
; 2o Param (optional), Kind
; Ex.: Unique+Descending
;
; Primary - Primary Key
; Unique - ...
; Descending - ...
;To force rebuild
;
;Rebuild=true
;
;
;Example
;
[Tables]
Table1=Depart ;Departaments
Table2=Employee
[Depart]
Field1=DepatCode,Alpha,15
Field2=Name,Alpha,40
Field3=Emp_Counter,Number
Index1=+DepartCode,Primary
Rebuild=True
[Employee]
Field1=DepartCode,Alpha,15
Field2=EmpID,Alpha,5
Field3=Name,Date
Field4=Salary,Currency
Index1=DepartCode+EmpID,Primary
-------------------------
Att.
DEFAULTBLEXT contains ".DB" (Table file ext)
DEFAULIDXEXT contains ".PX" (Index file ext)
Put this code into main form
procedure TFormMain.FormCreate(Sender: TObject);
begin
{
.....
}
try
{ I made Depart table always opened, so i can test this}
{Try to open in exclusive mode}
if FileExists( DataBasePath + '\Depart' + DEFAULTBLEXT) then
with TBL_Dummy do {TBL_Dummy is a TTable object}
begin
Close;
Exclusive := True;
DataBaseName := DataBasePath;
TableName := 'Depart';
Open; {Try to Open Exclusive}
Close; {Opned, close and continue}
end;
{Scan Tables}
Application.CreateForm(TFormDataBase, FormDataBase);
if (FormDataBase.ShowModal <> mrOk) then
begin
Beep;
Application.MessageBox( 'Can't scan/create Tables.',
AppName, mb_OK + mb_IconExclamation);
Application.Terminate;
Exit;
end;
except
{Tables alread oppened, don't scan}
end; {try}
with TBL_Dummy do
begin
Close;
Exclusive := False;
DataBaseName := DataBasePath;
TableName := 'TABLEX';
Open;
end;
{
.....
}
end
-----------------------------------------
Creat a form with 3 labels, 2 TTable objects (TBL_Source & TBL_Dest) & a
timer.
unit DataBase;
interface
uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
StdCtrls, SysUtils, DB, IniFiles, DBTables, ExtCtrls;
type
TFormDataBase = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
TBL_Source: TTable;
TBL_Dest: TTable;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
lTableInfo : TIniFile;
lTableNames,
lTableFields,
lTableIndex : TStringList;
Scanned,
WithError : Boolean;
TmpFileName : String;
procedure ScanTable(lTableName : String);
procedure MakeTable( const lTableName, lExtensao : String;
const lTableFields, lTableIndex : TStringList);
procedure MakeField( const lFieldString : String;
var lFieldName : String;
var lFieldType : TFieldType;
var lFieldSize : Integer);
procedure MakeIndex( const lIndexString : String;
var lIndexFields : String;
var lIndexOptions : TIndexOptions);
public
{ Public declarations }
end;
var
FormDataBase: TFormDataBase;
implementation
const MAXTABLES = 10;
MAXFIELDS = 30;
MAXINDEX = 3; {max index by table}
{$R *.DFM}
procedure TFormDataBase.FormCreate(Sender: TObject);
begin
lTableInfo := TIniFile.Create( ApplicationPath + '\' + AppName +
'.tbl');
lTableNames := TStringList.Create;
lTableFields := TStringList.Create;
lTableIndex := TStringList.Create;
WithError := False;
Scanned := False;
TmpFileName := Copy( '~' + AppName, 1, 8);
end;
procedure TFormDataBase.FormActivate(Sender: TObject);
var i : Integer;
s : string;
begin
if Scanned then Exit;
Label1.Refresh;
Label3.Refresh;
for i := 1 to MAXTABLES do
begin
s := lTableInfo.ReadString( 'Tables', 'Table' + IntToStr(i), '');
if s = '' then break;
lTableNames.Add(s);
end;
for i := 0 to lTableNames.Count - 1 do
begin
Label2.Caption := 'Table: ' + lTableNames.Strings[i];
Label2.Refresh;
ScanTable( lTableNames.Strings[i]);
end;
Scanned := True;
Hide;
end;
procedure TFormDataBase.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
lTableInfo.Free;
lTableNames.Free;
lTableFields.Free;
lTableIndex.Free;
if WithError then
ModalResult := mrCancel
else
ModalResult := mrOk;
Action := caFree;
Release;
end;
procedure TFormDataBase.MakeField( const lFieldString : String;
var lFieldName : String;
var lFieldType : TFieldType;
var lFieldSize : Integer);
var j : Integer;
n, t, s : String;
begin
lFieldName := lFieldString;
while Pos( ' ', lFieldName) > 0 do
Delete( lFieldName, Pos( ' ', lFieldName), 1);
j := Pos( ',', lFieldName);
{DepatCode,Alpha,15}/{Salary,Currency}
n := Copy( lFieldName, 1, j - 1); {DepatCode}/{Salary}
s := Copy( lFieldName, j + 1, {Alpha,15}/{Currency}
Length( lFieldName) - j);
j := Pos( ',', s);
if j > 0 then
begin
t := Copy( s, 1, j - 1); {Alpha}
s := Copy( s, j + 1, Length(s) - j);
end
else
begin
t := s; {Currency}
s := '0';
end;
lFieldName := n;
case UpCase( t[1]) of
'A' : lFieldType := ftString;
'C' : lFieldType := ftCurrency;
'L' : lFieldType := ftBoolean;
'D' : lFieldType := ftDate;
'I' : lFieldType := ftInteger;
'S' : lFieldType := ftSmallInt;
'N' : lFieldType := ftFloat;
'M' : lFieldType := ftMemo;
else
lFieldType := ftUnknown;
WithError := True;
end;
lFieldSize := 0;
try
lFieldSize := StrToInt( s);
except
WithError := True;
end;
end;
procedure TFormDataBase.MakeIndex( const lIndexString : String;
var lIndexFields : String;
var lIndexOptions : TIndexOptions);
var j : Integer;
s, t : String;
begin
lIndexFields := '';
lIndexOptions := [];
s := lIndexString;
while Pos( ' ', s) > 0 do
Delete( s, Pos( ' ', s), 1);
j := Pos( ',', s);
{+Field1+Field2+Field3,Primary+Unique+Descending}
if j = 0 then
begin
lIndexFields := s;
t := '';
end
else
begin
lIndexFields := Copy( s, 1, j - 1);
{+Field1+Field2+Field3}
t := UpperCase( Copy( s, j + 1, Length(s) -
j));{+PRIMARY+UNIQUE+DESCENDING}
end;
{Index Fields}
{Change '+' to ';'}
while Pos( '+', lIndexFields) > 0 do
begin
lIndexFields[Pos( '+', lIndexFields)] := ';';
end;
{Out first '+'}
if lIndexFields[1] = ';' then
lIndexFields := Copy( lIndexFields, 2, Length( lIndexFields) - 1);
{Index Options}
{Out first '+'}
if t[1] = '+' then
t := Copy( t, 2, Length( t) - 1);
s := t;
while Length( t) > 0 do
begin
j := Pos( '+', t);
if j > 0 then
begin
s := Copy( t, 1, j - j);
t := Copy( t, j + 1, Length( t) - j);
end
else
t := '';
if s = 'PRIMARY' then
lIndexOptions := lIndexOptions + [ixPrimary,ixUnique]
else if s = 'UNIQUE' then
lIndexOptions := lIndexOptions + [ixUnique]
else if s = 'DESCENDING' then
lIndexOptions := lIndexOptions + [ixDescending];
end;
end;
procedure TFormDataBase.MakeTable( const lTableName, lExtensao : String;
const lTableFields, lTableIndex :
TStringList);
var i : Integer;
Table1 : TTable;
lFieldName : String;
lFieldType : TFieldType;
lFieldSize : Integer;
lIndexFields : String;
lIndexOptions : TIndexOptions;
begin
Table1 := TTable.Create(Self);
with Table1 do
begin
Active := False;
DataBaseName := DataBasePath;
TableName := lTableName;
TableType := ttParadox;
with FieldDefs do
begin
Clear;
for i := 0 to lTableFields.Count - 1 do
begin
MakeField(lTableFields.Strings[i], lFieldName, lFieldType,
lFieldSize);
Add(lFieldName, lFieldType, lFieldSize, false);
end;
end;
with IndexDefs do
begin
Clear;
for i := 0 to lTableIndex.Count - 1 do
begin
MakeIndex(lTableIndex.Strings[i], lIndexFields, lIndexOptions);
Add('Index' + IntToStr(i), lIndexFields, lIndexOptions);
end;
end;
try
CreateTable;
except
WithError := True;
end;
end;
Table1.Close;
Table1.Free;
end;
procedure TFormDataBase.ScanTable(lTableName : String);
var i, j : Integer;
Remonta : Boolean;
lFieldName : String;
lFieldType : TFieldType;
lFieldSize : Integer;
lIndexFields : String;
lIndexOptions : TIndexOptions;
begin
lTableFields.Clear;
lTableIndex.Clear;
for i := 1 to MAXFIELDS do
begin
lFieldName := lTableInfo.ReadString( lTableName, 'Field' +
IntToStr(i), '');
if lFieldName = '' then break;
lTableFields.Add(lFieldName);
end;
for i := 1 to MAXINDEX do
begin
lIndexFields := lTableInfo.ReadString( lTableName, 'Index' +
IntToStr(i), '');
if lIndexFields = '' then break;
lTableIndex.Add(lIndexFields);
end;
if FileExists( DataBasePath + '\' + lTableName + DEFAULTBLEXT) then
begin
Rebuild :=
...
read more »
