Mega Code Archive
Component to create index for dBase IV tables
<![CDATA[
Title: Component to create index for dBase IV tables
Question: How to create (or recreate) indexes for dBase IV tables
Answer:
unit IndexCreate;
interface
uses
Windows, Messages, SysUtils, Classes, DB, DBTables;
type
TIndexCreate = class(TComponent)
private
{ Private declarations }
FTableName: String;
FIndexName: TStrings;
FIndexKey: TStrings;
FAuthor: String;
FEMail: String;
FVersion: String;
TmpChr: String;
procedure SetTableName(Value: String);
procedure SetIndexName(Value: TStrings);
procedure SetIndexKey(Value: TStrings);
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Execute(var ErrNumber: Integer; var ErrMessage: String; var FileName: String);
published
{ Published declarations }
property Author: String read FAuthor write TmpChr;
property EMail: String read FEMail write TmpChr;
property Version: String read FVersion write TmpChr;
property TableName: String read FTableName write SetTableName;
property IndexName: TStrings read FIndexName write SetIndexName;
property IndexKey: TStrings read FIndexKey write SetIndexKey;
end;
const
CI_SUCCESS = 0;
CI_FILENOTFOUND = 1;
CI_BINARYOPENERROR = 2;
CI_READERROR = 3;
CI_WRITEERROR = 4;
CI_ADDINDEXERROR = 5;
CI_OPENERROR = 6;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('PRODB', [TIndexCreate]);
end;
constructor TIndexCreate.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FIndexName := TStringList.Create;
FIndexKey := TStringList.Create;
FAuthor := 'Marcelo Torres';
FEMail := 'marcelo.torres@task.com.br';
FVersion := '1.00';
FTableName := '';
FIndexName.Clear;
FIndexKey.Clear;
end;
destructor TIndexCreate.Destroy;
begin
FIndexName.Free;
FIndexKey.Free;
inherited Destroy;
end;
procedure TIndexCreate.SetTableName(Value: String);
begin
if Value '' then
FTableName := UpperCase(Trim(Value));
end;
procedure TIndexCreate.SetIndexName(Value: TStrings);
begin
FIndexName.Assign(Value);
end;
procedure TIndexCreate.SetIndexKey(Value: TStrings);
begin
FIndexKey.Assign(Value);
end;
procedure TIndexCreate.Execute(var ErrNumber: Integer; var ErrMessage: String; var FileName: String);
var
Arq : File of Byte;
Car : Byte;
Tbl : TTable;
Dbf : String;
Mdx : String;
Ind : Integer;
begin
Dbf := Trim(FTableName);
Mdx := ExtractFileName(Dbf);
if Pos('.DBF', Mdx) 0 then
Mdx := Copy(Mdx, 1, Pos('.DBF', Mdx)-1);
Mdx := Mdx + '.MDX';
Mdx := ExtractFilePath(Dbf)+Mdx;
ErrNumber := CI_SUCCESS;
ErrMessage := "Success";
FileName := Dbf;
if Pos('.DBF', FTableName) = 0 then
Dbf := Dbf + '.DBF';
if not FileExists(Dbf) then begin
ErrNumber := CI_FILENOTFOUND;
ErrMessage := "File not found";
Exit;
end;
if FileExists(Mdx) then
DeleteFile(Mdx);
try
AssignFile(Arq, Dbf);
except
ErrNumber := CI_BINARYOPENERROR;
ErrMessage := "Open error";
try
CloseFile(Arq);
except
end;
Exit;
end;
try
Reset(Arq);
Seek(Arq, 28);
except
ErrNumber := CI_READERROR;
ErrMessage := "Read error";
try
CloseFile(Arq);
except
end;
Exit;
end;
try
Car := 0;
Write(Arq, Car);
CloseFile(Arq);
except
ErrNumber := CI_WRITEERROR;
ErrMessage := "Write error";
try
CloseFile(Arq);
except
end;
Exit;
end;
try
Tbl := TTable.Create(nil);
Tbl.TableName := Dbf;
Tbl.Open;
Tbl.Close;
except
ErrNumber := CI_OPENERROR;
ErrMessage := "Open error";
try
CloseFile(Arq);
except
end;
Exit;
end;
try
// '+' in index key = index key is expression
for Ind := 0 to FIndexKey.Count-1 do
if Length(Trim(FIndexKey[Ind])) 0 then
if Pos('+', FIndexKey[Ind]) 0 then
Tbl.AddIndex(FIndexName[Ind], FIndexKey[Ind], [ixExpression]) // Chave de ndice uma expressao
else
Tbl.AddIndex(FIndexName[Ind], FIndexKey[Ind], []); // Chave de ndice um campo nico
except
ErrNumber := CI_ADDINDEXERROR;
ErrMessage := "Index create error";
try
CloseFile(Arq);
except
end;
Exit;
end;
try
Tbl.Open;
Tbl.Close;
except
ErrNumber := CI_OPENERROR;
ErrMessage := "Open error";
try
CloseFile(Arq);
except
end;
Exit;
end;
end;
end.
------------------
Instalation:
Install as a normal component. Menu Component, Install Component, Into new
package. Enter the name of new package and click on "Install" button.
Use:
Set the properties:
TableName: Name of dBase IV table
IndexName: Name of indexes the table (one index by line)
IndexKey: Indexes keys (one index key by line)
Call the "Execute" method to create the indexes.
In "Execute" method, three values are returned by reference, in order:
ErrNumber: Integer - Number of error (0=Success)
ErrMessage: String - Error message (textual form)
FileName: String - Name of table
Example:
IndexCreate1.TableName := 'C:\APPLICATION\DATA\TABLE.DBF';
IndexCreate1.IndexName.Add('INDEX1'); // Name of index
IndexCreate1.IndexName.Add('INDEX2');
IndexCraete1.IndexKey.Add('FIELD1'); // Index key of index 'INDEX1';
IndexCreate1.IndexKey.Add('FIELD2+FIELD3');// Index expression of index 'INDEX2'
NumErr := 0;
MsgErr := '';
Table := '';
IndexCreate1.Execute(NumErr, MsgErr, Table);
ShowMessage(IntToStr(NumErr)+': '+MsgErr+' - Table: '+Table);
]]>