index.pas

示范复制、排序、输出、过滤、查询、打印、压缩重整 ( Pack )、取得字段及索引信息的范例程序

{Form for reindex.

 It is convenient before calling it, to make it a Session.Close; to be assured
 of the fact that all tables are closed}

unit Index;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, DB, DBTables, DbiProcs, DbiErrs,
  DbiTypes, ExtCtrls, ComCtrls;

type
  TIndexa = class(TForm)
    Label1: TLabel;
    CBALias: TComboBox;
    TablaIndexar: TTable;
    Label2: TLabel;
    CBTabla: TComboBox;
    BotonSalir: TBitBtn;
    BotonReconstruir: TBitBtn;
    Edit2: TEdit;
    Edit1: TEdit;
    ProgressBar1: TProgressBar;
    SpeedButton2: TSpeedButton;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure CbAliasChange(Sender: TObject);
    procedure BotonReconstruirClick(Sender: TObject);
    procedure BotonSalirClick(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure CBTablaChange(Sender: TObject);
  public
    procedure Mensaje(Escribe : String);
    procedure HandleExcepcion(Sender: TObject; E: Exception);
    procedure ChangeDataBaseName(sDataBaseName : String);
    function Indexar(Alias,Tabla : String; var Error : String) : Boolean;
    function RemoveMDXByte(dbFile: String): Boolean;
  end;

var
  Indexa: TIndexa;

implementation

{$R *.DFM}

procedure TIndexa.HandleExcepcion(Sender: Tobject; E: Exception);
begin
 if E.Message <> '' then begin
  Screen.Cursor := crArrow;
  MessageDlg(E.Message, mtError, [mbOK], 0);
 end;
end;

procedure TIndexa.Mensaje(Escribe : String);
begin
 Edit1.Text := Escribe;
 Edit1.Refresh;
end;

function  TIndexa.Indexar(Alias,Tabla : String; var Error : String) : Boolean;
var
 BdeResultado : DBIResult;
begin
 Result := False;

 if TablaIndexar.Active then TablaIndexar.Active := False;

 TablaIndexar.DatabaseName := Alias;
 TablaIndexar.TableName    := Tabla;

 Screen.Cursor             := CrHourGlass;
 try
  Mensaje('Opening ' + Tabla + '...');
  TablaIndexar.Open;
 except
  on E:EDBEngineError do begin
   TablaIndexar.Close;
   { The following mistake message, indicates that the index does not exist: }
   if Pos('Index does not exist. File', E.Message) > 0 then begin
    ShowMessage('The .MDX file of the table' + #13 + Tabla + ' not found.');

   { It is possible that we go to reindex some table that it does not has the
    .Mdx associate, for something which can be eliminated the index brand of
    the .dbf

    With a MessageDlg to request the erased, we would remove the reference
    from the index file of the head-board of table.

    RemoveMDXByte(TablePath + TableName + '.dbf');
   }
    end;
   end;
  end;
  Screen.Cursor := CrDefault;

  if not TablaIndexar.Active then
   Error := 'It is not possible to open the table ' + Tabla
  else begin
   Mensaje('Reindexing the Table ' + Tabla + '...');
   Screen.Cursor := crHourGlass;
   try
    BdeResultado := dbiRegenIndexes(TablaIndexar.Handle);
    case BdeResultado of
     DBIERR_NONE:           Result := True;
     DBIERR_INVALIDHNDL:    Error  := 'Invalid Handle of the Table';
     DBIERR_NEEDEXCLACCESS: Error  := 'The table is open in Shared mode';
     DBIERR_NOTSUPPORTED:   Error  := 'The index can not be Reconstructed';
    else
     Error := 'The BDE returns a not waited error';
    end;
   finally
    Screen.Cursor := CrDefault;
   end;
  end;
  Mensaje('');
end;

procedure TIndexa.FormCreate(Sender: TObject);
begin
 Application.OnException := HandleExcepcion;
 Screen.Cursor := CrHourGlass;
 try
  Session.GetAliasNames(CbAlias.Items);
  CbAlias.ItemIndex := 0;
 finally
  Screen.Cursor := CrDefault;
 end;
 CbAliasChange(nil);
end;

procedure TIndexa.CBALiasChange(Sender: TObject);
begin
 ChangeDataBaseName(CbAlias.Items[CbAlias.ItemIndex]);
end;

procedure TIndexa.BotonReconstruirClick(Sender: TObject);
var
  Contador: Integer;
  NTablas : Integer;
  strError: string;
begin
 ProgressBar1.Position := 0;
 strError := '';
 if CbTabla.ItemIndex > 0 then begin
  if not Indexar(CbAlias.Items[CbAlias.ItemIndex],
                 CbTabla.Items[CbTabla.ItemIndex],
                 strError)
  then MessageDlg('Can not Reindex ' + cbTabla.Items[ cbTabla.ItemIndex ] +
                  '.  Reason: ' +  '. ' +
                  #10 + #10 + strError, mtError, [mbOK], 0);
  ProgressBar1.Position := 100;
 end else begin {All Tables}
  NTablas := cbTabla.Items.Count;
  for Contador := 1 to cbTabla.Items.Count - 1 do begin
   Edit2.Text := IntToStr(NTablas - Contador);
   Edit2.Refresh;
   if not Indexar(cbAlias.Items[cbAlias.ItemIndex],
                  cbTabla.Items[Contador],
                  strError)
   then MessageDlg('Can not Reindex ' + cbTabla.Items[Contador] + '. ' +
                   #10 + #10 + '. Motive: ' + strError, mtError, [mbOK], 0 );

   ProgressBar1.Position := Round((Contador * 100) / NTablas);

  end;

  if Contador = NTablas then ProgressBar1.Position := 100;

  Edit2.Text := '';
  Edit2.Refresh;
  BotonSalir.SetFocus;
 end;
 Mensaje('Reindex ended.');
end;

procedure TIndexa.BotonSalirClick(Sender: TObject);
begin
 Close;
end;

procedure TIndexa.SpeedButton2Click(Sender: TObject);
var
 s : String;
begin
 if OpenDialog1.Execute then begin
  s := UpperCase(OpenDialog1.FileName);
  {Get path only}
  while (s[Length(s)] <> '\') and (Length(s) > 0) do s := Copy(s,1,Length(s)-1);

  CbAlias.Items.Insert(0, s);
  CbAlias.ItemIndex := 0;
  ChangeDataBaseName(s);
 end;
end;

procedure TIndexa.ChangeDataBaseName(sDataBaseName : String);
begin
 Screen.Cursor         := crHourGlass;
 Edit1.Text            := '';
 ProgressBar1.Position := 0;
 try
  with CbTabla do begin
   Session.GetTableNames(sDataBaseName,'',True,False,Items);
   Items.Insert(0, '< All Tables >');
   ItemIndex := 0;
  end;
 finally
  Screen.Cursor      := crDefault;
 end;
end;

{ This function accepts a file dbf as parameter. Modify the head-board of the
  file to eliminate the file brand associated MDX

  It must be happened the Path of DOS.  Complete}
function TIndexa.RemoveMDXByte(dbFile: String): Boolean;
const
 Value: Byte = 0;
var
 f: file of byte;
begin
 Result := True;
 try
  AssignFile(f, dbFile);
  Reset(f);
  Seek(f, 28);
  Write(f, Value);
  CloseFile(f);
 except
  Result := False;
 end;
end;

procedure TIndexa.CBTablaChange(Sender: TObject);
begin
 Edit1.Text            := '';
 ProgressBar1.Position := 0;
end;

end.