{**********************************************************}
{ This unit was generated by IndexGen version 1.2          }
{                                                          }
{ Program......: Indexar.Pas                               }
{ Date.........: 02/02/2002 11:43:23 Õ                       }
{ Code Style...: Object Pascal for Delphi                  }
{ Purpose......: To create indexes of Tables Paradox       }
{ Idea.........: Toninho Nunes                             }
{ Written for..: Delphi 1.0x Delphi 2.0x / Delphi 3.0x     }
{                Delphi 4.0x C++ Builder.(Shortly)         }
{**********************************************************}
{ Note: Delphi 1.0x, care with the mistake line to loong   }
{ it happens for exceeding the width of the line, break    }
{ the line when this happens.                              }
{**********************************************************}
Unit Indexar;

{$T-}
interface

Uses
   { Directivas de compilação / Directive of the compilation }
   {$ifdef win32} 
     BDE, { BDE 32 BITS } 
   {$else}
     DBIProcs, DBITypes, DbiErrs, { IDAPI 16 BITS} 
   {$endif}
   Winprocs, Wintypes, Classes, SysUtils, Forms, Dialogs,
   DB, DBTables, Controls;

type
  TRIDesc = array[0..MaxInt div SizeOf(RINTDesc)-1] of RINTDesc;
  TRIOp   = array[0..MaxInt div SizeOf(CROpType)-1] of CROpType;
  TVCDesc = array[0..MaxInt div SizeOf(VCHKDesc)-1] of VCHKDesc;

{ Esta procedure é a principal / Main Procedure}
procedure Idx;
{ Deletar indices, integridades e valid checks / to delete indexes and integrities, valcheck }
procedure Del_IDX_RI(sDir : String);
{ Executar pack nas Tabelas / to execute pack in the tables }
procedure Pack_PassWord(Table: TTable; Const sPassWord : String);
{ Executar rotina de acesso ao pack / to execute routine of access to pack }
procedure PassarPack;
{ Criar integridade Refêncial / to create the Referential Integrity } 
procedure CreateRI;
{ Criar Valid Checks  / To Create the Valids Checks }
procedure CreateVC;
procedure EnCodeValueCheck(const aValues : array of byte; var aValue : DBIVCHK);
{ função para retirar brancos na string / to remove spaces of a string}
function MyTrim(S : String) : String;
function fcGetAliasPath( sAlias : String) : String;

implementation

var
  sPath : String;

procedure Idx;
var
  oTable : TTable;
  oTableList : TList;
  I : Integer;
begin
  try
    Screen.Cursor := crHourglass;

    { Fechar DataSets Abertos / Close all DataSets opened }

    oTableList := TList.Create;
    for I := Session.DatabaseCount-1 downto 0 do
      with Session.Databases[I] do
        while DatasetCount > 0 do
        begin
          oTableList.Add(Datasets[0]);
          DataSets[0].Close;
        end;

    oTable := TTable.Create(Nil);
    With oTable do begin
      DataBaseName := 'A12001';

      Exclusive := true;
      Application.ProcessMessages;


      sPath := fcGetAliasPath('A12001');


      Del_IDX_RI(sPath);

      { Criando Indice da Tabela / creating index of the table AccData.DB}
      TableName := 'AccData.DB';
      try 
        open;
        AddIndex('PrimaryKey','Acc_No', [ixPrimary, ixUnique ]);
        AddIndex('Acc_Na','Acc_AName', [ixCaseInsensitive ]);
        AddIndex('Acc_D','Acc_Date', [ixCaseInsensitive ]);
        AddIndex('Acc_Dc','Acc_D_C', [ixCaseInsensitive ]);
        AddIndex('Acc_K','Acc_Kind', [ixCaseInsensitive ]);
        AddIndex('Acc_Up','Acc_Up_No', [ixCaseInsensitive ]);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela AccData.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table ACCState.DB}
      TableName := 'ACCState.DB';
      try 
        open;
        AddIndex('PrimaryKey','AccountNo', [ixPrimary, ixUnique ]);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela ACCState.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table BSGroup.DB}
      TableName := 'BSGroup.DB';
      try 
        open;
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela BSGroup.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table CostData.DB}
      TableName := 'CostData.DB';
      try 
        open;
        AddIndex('PrimaryKey','Cost_No', [ixPrimary, ixUnique ]);
        AddIndex('Cost_An','Cost_AName', [ixCaseInsensitive ]);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela CostData.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table Customer.DB}
      TableName := 'Customer.DB';
      try 
        open;
        AddIndex('PrimaryKey','CustNo', [ixPrimary, ixUnique ]);
        AddIndex('ByCompany','Company', [ixCaseInsensitive ]);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela Customer.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table DVoucher.DB}
      TableName := 'DVoucher.DB';
      try 
        open;
        AddIndex('PrimaryKey','Counter;VNo;VDate', [ixPrimary, ixUnique ]);
        AddIndex('VNo','VNo', []);
        AddIndex('VDate','VDate', []);
        AddIndex('voc','VNo;VDate', []);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela DVoucher.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table EmpData.DB}
      TableName := 'EmpData.DB';
      try 
        open;
        AddIndex('PrimaryKey','Emp_No', [ixPrimary, ixUnique ]);
        AddIndex('Emp_PH1','Emp_Phone1', [ixCaseInsensitive ]);
        AddIndex('Emp_CN','Emp_CardNo', [ixCaseInsensitive ]);
        AddIndex('Emp_FN','Emp_FileNo', [ixCaseInsensitive ]);
        AddIndex('Emp_AD','Emp_Addr', [ixCaseInsensitive ]);
        AddIndex('Emp_K','Emp_Kind', [ixCaseInsensitive ]);
        AddIndex('Emp_N','Emp_AName', [ixCaseInsensitive ]);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela EmpData.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table Employee.DB}
      TableName := 'Employee.DB';
      try 
        open;
        AddIndex('PrimaryKey','EmpNo', [ixPrimary, ixUnique ]);
        AddIndex('ByName','LastName;FirstName', [ixCaseInsensitive ]);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela Employee.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table GLData.DB}
      TableName := 'GLData.DB';
      try 
        open;
        AddIndex('PrimaryKey','Gl_No', [ixPrimary, ixUnique ]);
        AddIndex('GLD','Gl_Date', [ixCaseInsensitive ]);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela GLData.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table GltrData.DB}
      TableName := 'GltrData.DB';
      try 
        open;
        AddIndex('PrimaryKey','Gl_No;GL_Count;GlTr_AccNo', [ixPrimary, ixUnique ]);
        AddIndex('Gl_No','Gl_No', []);
        AddIndex('GAN','GlTr_AccNo', [ixCaseInsensitive ]);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela GltrData.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table Items.DB}
      TableName := 'Items.DB';
      try 
        open;
        AddIndex('PrimaryKey','OrderNo;Kind;ItemNo;PartNo', [ixPrimary, ixUnique ]);
        AddIndex('Discount','Discount', []);
        AddIndex('Qty','Qty', []);
        AddIndex('ByOrderNo','OrderNo', [ixCaseInsensitive ]);
        AddIndex('PartNo','PartNo', []);
        AddIndex('od','OrderNo;Kind', [ixCaseInsensitive ]);
        AddIndex('TrDate','TrDate', []);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela Items.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table LendData.DB}
      TableName := 'LendData.DB';
      try 
        open;
        AddIndex('PrimaryKey','Lend_No;Lend_EmpNo', [ixPrimary, ixUnique ]);
        AddIndex('ld','Lend_Date', [ixCaseInsensitive ]);
        AddIndex('len','Lend_EmpNo', [ixCaseInsensitive ]);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela LendData.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table MItems.DB}
      TableName := 'MItems.DB';
      try 
        open;
        AddIndex('PrimaryKey','PartNo', [ixPrimary, ixUnique ]);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela MItems.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table MVoucher.DB}
      TableName := 'MVoucher.DB';
      try 
        open;
        AddIndex('PrimaryKey','VNo;VDate', [ixPrimary, ixUnique ]);
        AddIndex('VNo','VNo', []);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela MVoucher.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table Nextcust.DB}
      TableName := 'Nextcust.DB';
      try 
        open;
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela Nextcust.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table Nextord.DB}
      TableName := 'Nextord.DB';
      try 
        open;
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela Nextord.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table Orders.DB}
      TableName := 'Orders.DB';
      try 
        open;
        AddIndex('PrimaryKey','OrderNo;Kind', [ixPrimary, ixUnique ]);
        AddIndex('CustNo','CustNo', []);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela Orders.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table Parts.DB}
      TableName := 'Parts.DB';
      try 
        open;
        AddIndex('PrimaryKey','StoreN;PartNo;VendorNo', [ixPrimary, ixUnique ]);
        AddIndex('PartNo','PartNo', []);
        AddIndex('SP','StoreN;PartNo', [ixCaseInsensitive ]);
        AddIndex('SN','StoreN', [ixCaseInsensitive ]);
        AddIndex('VendorNo','VendorNo', []);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela Parts.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table POrders.DB}
      TableName := 'POrders.DB';
      try 
        open;
        AddIndex('PrimaryKey','OrderNo;VendorNo;PDate', [ixPrimary, ixUnique ]);
        AddIndex('VendorNo','VendorNo', []);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela POrders.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table RecData.DB}
      TableName := 'RecData.DB';
      try 
        open;
        AddIndex('PrimaryKey','Rec_No;IsRec', [ixPrimary, ixUnique ]);
        AddIndex('RCD','Rec_Date', [ixCaseInsensitive ]);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela RecData.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table RectrData.DB}
      TableName := 'RectrData.DB';
      try 
        open;
        AddIndex('PrimaryKey','Rec_No;IsRec;RecTr_Count', [ixPrimary, ixUnique ]);
        AddIndex('Rec_No','Rec_No', []);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela RectrData.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table StoreData.DB}
      TableName := 'StoreData.DB';
      try 
        open;
        AddIndex('PrimaryKey','Store_No', [ixPrimary, ixUnique ]);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela StoreData.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table Vendors.DB}
      TableName := 'Vendors.DB';
      try 
        open;
        AddIndex('PrimaryKey','VendorNo', [ixPrimary, ixUnique ]);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela Vendors.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table VList.DB}
      TableName := 'VList.DB';
      try 
        open;
        AddIndex('PrimaryKey','VendorNo;VListNo;VVDate;Terms;OrderNo', [ixPrimary, ixUnique ]);
        AddIndex('ListRD','RecDate', [ixCaseInsensitive ]);
        AddIndex('ListSD','VVDate', [ixCaseInsensitive ]);
        AddIndex('OrderNo','OrderNo', []);
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela VList.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Criando Indice da Tabela / creating index of the table WorkP.DB}
      TableName := 'WorkP.DB';
      try 
        open;
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela WorkP.DB is Busy!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;
    end; { With }

    { Criar as integridades Referenciais / to Create Referential Integrity}
    CreateRI;


    { Criar os Valids Checks / To Create Valids Checks }
    CreateVC;

    { Agora vamos passar o pack nas tabelas / To Pass Pack }
    PassarPack; { acessando a rotina / Access the routine }

  finally
    oTable.Free;

    { Abrir todos DataSets do Object List / To Open All DataSets of Object TList }

    for I := oTableList.Count-1 downto 0 do
      with TDBDataset(oTableList[I]) do
      begin
        try
          Open;
          EnableControls;
          Refresh;
        except
        on E:EDataBaseError do
          showmessage(E.Message + ' - ' + TDBDataset(oTableList[I]).Name );
        end;
      end;

    Screen.Cursor := crDefault;
    oTableList.Free
  end;

end; { Fim da Procedure / End of the Procedure }

procedure PassarPack;
var
  oTable : TTable;
begin
  try
    Screen.Cursor := crHourglass;
    oTable := TTable.Create(Nil);
    With oTable do begin
      DataBaseName := 'A12001';
      Exclusive := true;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table AccData.DB}
      TableName := 'AccData.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela AccData.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table ACCState.DB}
      TableName := 'ACCState.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela ACCState.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table BSGroup.DB}
      TableName := 'BSGroup.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela BSGroup.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table CostData.DB}
      TableName := 'CostData.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela CostData.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table Customer.DB}
      TableName := 'Customer.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela Customer.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table DVoucher.DB}
      TableName := 'DVoucher.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela DVoucher.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table EmpData.DB}
      TableName := 'EmpData.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela EmpData.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table Employee.DB}
      TableName := 'Employee.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela Employee.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table GLData.DB}
      TableName := 'GLData.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela GLData.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table GltrData.DB}
      TableName := 'GltrData.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela GltrData.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table Items.DB}
      TableName := 'Items.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela Items.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table LendData.DB}
      TableName := 'LendData.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela LendData.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table MItems.DB}
      TableName := 'MItems.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela MItems.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table MVoucher.DB}
      TableName := 'MVoucher.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela MVoucher.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table Nextcust.DB}
      TableName := 'Nextcust.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela Nextcust.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table Nextord.DB}
      TableName := 'Nextord.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela Nextord.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table Orders.DB}
      TableName := 'Orders.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela Orders.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table Parts.DB}
      TableName := 'Parts.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela Parts.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table POrders.DB}
      TableName := 'POrders.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela POrders.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table RecData.DB}
      TableName := 'RecData.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela RecData.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table RectrData.DB}
      TableName := 'RectrData.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela RectrData.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table StoreData.DB}
      TableName := 'StoreData.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela StoreData.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table Vendors.DB}
      TableName := 'Vendors.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela Vendors.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table VList.DB}
      TableName := 'VList.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela VList.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;

      { Dar Pack na Tabela / To pass Pack in the table WorkP.DB}
      TableName := 'WorkP.DB';
      try 
        open;
        Pack_PassWord(oTable, ''); { Executar Pack na tabela / to execute the pack}
        close;
      except
        on EDatabaseError do
          MessageDlg('Tabela WorkP.DB está com problemas!',mterror, [mbok],0);
      end;
      Application.ProcessMessages;
    end; { With }
  finally
    oTable.Free;
    Screen.Cursor := crDefault;
  end; { Fim do try }
end; { Fim da Procedure }


function MyTrim(S : String) : String;
begin
  while Pos(' ', S) > 0 do 
    Delete(S, Pos(' ', S),1);
  Result := S;
end; { fim da função / End of function }

procedure Del_IDX_RI(sDir : String);
var
  Resultado, I : Integer;
  Pesq : TSearchRec;
Const
  Extensao : array[1..4] of String =  ('.px' , '.x??' , '.y??', '.val' ); 
begin
  I := 0;
  try
    for I := 1 to 4 do begin
      Resultado := FindFirst(sDir + '*' + Extensao[I], faDirectory, Pesq);
      While Resultado = 0 do begin
        DeleteFile(sDir + Pesq.Name);
        Resultado := FindNext(Pesq);
      end; { fim do While }
    end; {fim do for} 
  finally
    FindClose(Pesq);
  end;
end; { fim da procedure / End of Procedure }

procedure Pack_PassWord(Table: TTable; Const sPassWord : String);
Var
  Props: CURProps;
  hDb: hDBIDb;
  TableDesc: CRTblDesc;
begin
  if Table.Active = False then
    raise EDatabaseError.Create('Tabela é obrigada estar aberta / It is obligatory that the table is open');
  if Table.Exclusive = False then
    raise EDatabaseError.Create('Tabela é obrigada estar em modo exclusivo / Table is forced to be in exclusive way');

  Check(DbiGetCursorProps(Table.Handle, Props));

  FillChar(TableDesc, sizeof(TableDesc), #0);
  Check(DbiGetObjFromObj(hDBIObj(Table.Handle), objDATABASE, hDBIObj(hDb)));
  With TableDesc do begin
    StrPCopy(TableDesc.szTblName, Table.TableName);
    StrPCopy(TableDesc.szTblType, Props.szTableType);

    { Verificar PassWord e adicionar / To Verify Password and to Add }

    bProtected := (sPassWord <> '');
    if bProtected then begin
      StrPCopy(szPassword, sPassWord);
      Session.AddPassword(sPassWord);
    end;
    bPack := True;
  end;
  Table.Close;
  Check(DbiDoRestructure(hDb, 1, @TableDesc, nil, nil, nil, FALSE));
end; { fim da procedure}


procedure CreateRI;
var
  TableDesc : pCRTblDesc;
  hDb : hDbiDb;
  SingleRi : ^TRIDesc;
  SingleOp : ^TRIOp;
  oTable : TTable;
begin

  {Obter DHandle }

  try
    oTable := TTable.Create(nil);
    With oTable do begin
    DataBaseName := 'A12001';
      TableName := 'DVoucher.DB';
      Open;

      { Obter o handle do objecto aqui }
      Check(DbiGetObjFromObj(hDBIObj(oTable.Handle), 
      objDATABASE, hDBIObj(hDb)));
    end;
  finally
    oTable.Free;
  end;


  try
    TableDesc := nil;
    TableDesc := AllocMem(sizeof(CRTblDesc));

    FillChar(TableDesc^, sizeOf(CRTblDesc), #0);
    With TableDesc^ do begin

      StrPCopy(szTblName, 'DVoucher.DB');
      iRintCount := 1;

      SingleOp := nil;
      SingleOp := AllocMem( iRintCount * sizeof(CROpType) );

      SingleRi := nil;
      SingleRi := AllocMem(iRintCount * sizeof(RintDesc) );

      { Agora vamos montar a integridade / Now we will set up the integrity };
      singleOp^[0] := crAdd;
      FillChar(SingleRI^[0], sizeOf(RintDesc), #0);
      With SingleRi^[0] do
      begin
        iRintNum := 1;
        StrPCopy(szRIntName,'voc');
        StrPCopy(szTblName, sPath + 'MVoucher.DB');
        eType := rintDEPENDENT;
        eModOp := rintCASCADE;
        eDelOp := rintRESTRICT;
        iFldCount := 2;
        aiThisTabFld[0] := 2;
        aiThisTabFld[1] := 3;
        aiOthTabFld[0] := 1;
        aiOthTabFld[1] := 2;
      end;
      pecrRintOp := @singleop^;
      PrintDesc := @SingleRi^;
    end;
    Check(DbiDoRestructure(hDb, 1, tabledesc, nil, nil, nil, false));
  Finally
    FreeMem(SingleRi, (TableDesc^.iRintCount * sizeof(RintDesc)) );
    FreeMem(SingleOp, TableDesc^.iRintCount * sizeof(CROpType) );
    FreeMem(TableDesc, sizeof(CRTblDesc));
  end;


  try
    TableDesc := nil;
    TableDesc := AllocMem(sizeof(CRTblDesc));

    FillChar(TableDesc^, sizeOf(CRTblDesc), #0);
    With TableDesc^ do begin

      StrPCopy(szTblName, 'Items.DB');
      iRintCount := 1;

      SingleOp := nil;
      SingleOp := AllocMem( iRintCount * sizeof(CROpType) );

      SingleRi := nil;
      SingleRi := AllocMem(iRintCount * sizeof(RintDesc) );

      { Agora vamos montar a integridade / Now we will set up the integrity };
      singleOp^[0] := crAdd;
      FillChar(SingleRI^[0], sizeOf(RintDesc), #0);
      With SingleRi^[0] do
      begin
        iRintNum := 1;
        StrPCopy(szRIntName,'it');
        StrPCopy(szTblName, sPath + 'Orders.DB');
        eType := rintDEPENDENT;
        eModOp := rintCASCADE;
        eDelOp := rintRESTRICT;
        iFldCount := 2;
        aiThisTabFld[0] := 1;
        aiThisTabFld[1] := 2;
        aiOthTabFld[0] := 1;
        aiOthTabFld[1] := 2;
      end;
      pecrRintOp := @singleop^;
      PrintDesc := @SingleRi^;
    end;
    Check(DbiDoRestructure(hDb, 1, tabledesc, nil, nil, nil, false));
  Finally
    FreeMem(SingleRi, (TableDesc^.iRintCount * sizeof(RintDesc)) );
    FreeMem(SingleOp, TableDesc^.iRintCount * sizeof(CROpType) );
    FreeMem(TableDesc, sizeof(CRTblDesc));
  end;


  try
    TableDesc := nil;
    TableDesc := AllocMem(sizeof(CRTblDesc));

    FillChar(TableDesc^, sizeOf(CRTblDesc), #0);
    With TableDesc^ do begin

      StrPCopy(szTblName, 'Parts.DB');
      iRintCount := 1;

      SingleOp := nil;
      SingleOp := AllocMem( iRintCount * sizeof(CROpType) );

      SingleRi := nil;
      SingleRi := AllocMem(iRintCount * sizeof(RintDesc) );

      { Agora vamos montar a integridade / Now we will set up the integrity };
      singleOp^[0] := crAdd;
      FillChar(SingleRI^[0], sizeOf(RintDesc), #0);
      With SingleRi^[0] do
      begin
        iRintNum := 1;
        StrPCopy(szRIntName,'pn');
        StrPCopy(szTblName, sPath + 'MItems.DB');
        eType := rintDEPENDENT;
        eModOp := rintCASCADE;
        eDelOp := rintRESTRICT;
        iFldCount := 1;
        aiThisTabFld[0] := 2;
        aiOthTabFld[0] := 1;
      end;
      pecrRintOp := @singleop^;
      PrintDesc := @SingleRi^;
    end;
    Check(DbiDoRestructure(hDb, 1, tabledesc, nil, nil, nil, false));
  Finally
    FreeMem(SingleRi, (TableDesc^.iRintCount * sizeof(RintDesc)) );
    FreeMem(SingleOp, TableDesc^.iRintCount * sizeof(CROpType) );
    FreeMem(TableDesc, sizeof(CRTblDesc));
  end;


  try
    TableDesc := nil;
    TableDesc := AllocMem(sizeof(CRTblDesc));

    FillChar(TableDesc^, sizeOf(CRTblDesc), #0);
    With TableDesc^ do begin

      StrPCopy(szTblName, 'RectrData.DB');
      iRintCount := 1;

      SingleOp := nil;
      SingleOp := AllocMem( iRintCount * sizeof(CROpType) );

      SingleRi := nil;
      SingleRi := AllocMem(iRintCount * sizeof(RintDesc) );

      { Agora vamos montar a integridade / Now we will set up the integrity };
      singleOp^[0] := crAdd;
      FillChar(SingleRI^[0], sizeOf(RintDesc), #0);
      With SingleRi^[0] do
      begin
        iRintNum := 1;
        StrPCopy(szRIntName,'RRF');
        StrPCopy(szTblName, sPath + 'RecData.DB');
        eType := rintDEPENDENT;
        eModOp := rintCASCADE;
        eDelOp := rintRESTRICT;
        iFldCount := 2;
        aiThisTabFld[0] := 1;
        aiThisTabFld[1] := 2;
        aiOthTabFld[0] := 1;
        aiOthTabFld[1] := 2;
      end;
      pecrRintOp := @singleop^;
      PrintDesc := @SingleRi^;
    end;
    Check(DbiDoRestructure(hDb, 1, tabledesc, nil, nil, nil, false));
  Finally
    FreeMem(SingleRi, (TableDesc^.iRintCount * sizeof(RintDesc)) );
    FreeMem(SingleOp, TableDesc^.iRintCount * sizeof(CROpType) );
    FreeMem(TableDesc, sizeof(CRTblDesc));
  end;
end; { fim da procedure WriteRi / End of Procedure }


procedure CreateVC;
var
  TableDesc : pCRTblDesc;
  hDb : hDbiDb;
  ValCheck : ^TVCDesc;
  SingleOp : ^TRIOp;
  oTable : TTable;
begin

  {Obter DHandle }

  try
    oTable := TTable.Create(nil);
    With oTable do begin
    DataBaseName := 'A12001';
      TableName := 'AccData.DB';
      Open;

      { Obter o handle do objecto aqui }
      Check(DbiGetObjFromObj(hDBIObj(oTable.Handle), 
      objDATABASE, hDBIObj(hDb)));
    end;
  finally
    oTable.Free;
  end;

  try

    TableDesc := nil;
    TableDesc := AllocMem(sizeof(CRTblDesc));

    FillChar(TableDesc^, sizeOf(CRTblDesc), #0);
    With TableDesc^ do begin
      StrPCopy(szTblName, sPath + 'AccData.DB');
      iValChkCount := 7;

      SingleOp := nil;
      SingleOp := AllocMem( iValChkCount * sizeof(CROpType) );

      ValCheck := nil;
      ValCheck := AllocMem(iValChkCount * sizeof(VCHKDesc) );

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[0] := crAdd;
      FillChar(ValCheck^[0], sizeOf(ValCheck), #0);
      With ValCheck^[0] do
      begin
        iFldNum := 3;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([68,101,98,105,116], aDefVal) ;
        szPict  := '';
      end;

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[1] := crAdd;
      FillChar(ValCheck^[1], sizeOf(ValCheck), #0);
      With ValCheck^[1] do
      begin
        iFldNum := 4;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([77,97,115,116,101,114], aDefVal) ;
        szPict  := '';
      end;

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[2] := crAdd;
      FillChar(ValCheck^[2], sizeOf(ValCheck), #0);
      With ValCheck^[2] do
      begin
        iFldNum := 10;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([66,97,108,97,110,99,101,32,83,104,101,101,116], aDefVal) ;
        szPict  := '';
      end;

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[3] := crAdd;
      FillChar(ValCheck^[3], sizeOf(ValCheck), #0);
      With ValCheck^[3] do
      begin
        iFldNum := 11;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([84,114,117,101], aDefVal) ;
        szPict  := '';
      end;

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[4] := crAdd;
      FillChar(ValCheck^[4], sizeOf(ValCheck), #0);
      With ValCheck^[4] do
      begin
        iFldNum := 12;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([0], aDefVal) ;
        szPict  := '';
      end;

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[5] := crAdd;
      FillChar(ValCheck^[5], sizeOf(ValCheck), #0);
      With ValCheck^[5] do
      begin
        iFldNum := 13;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([0], aDefVal) ;
        szPict  := '';
      end;

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[6] := crAdd;
      FillChar(ValCheck^[6], sizeOf(ValCheck), #0);
      With ValCheck^[6] do
      begin
        iFldNum := 14;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([70,97,108,115,101], aDefVal) ;
        szPict  := '';
      end;
      pecrValChkOp := @singleop^;
      pVChkDesc := @ValCheck^
    end;
    Check(DbiDoRestructure(hDb, 1, tabledesc, nil, nil, nil, false));
  Finally
    FreeMem(ValCheck, (TableDesc^.iValChkCount * sizeof(VCHKDesc)) );
    FreeMem(SingleOp, TableDesc^.iValChkCount * sizeof(CROpType) );
    FreeMem(TableDesc, sizeof(CRTblDesc));
  end;
  try

    TableDesc := nil;
    TableDesc := AllocMem(sizeof(CRTblDesc));

    FillChar(TableDesc^, sizeOf(CRTblDesc), #0);
    With TableDesc^ do begin
      StrPCopy(szTblName, sPath + 'GLData.DB');
      iValChkCount := 3;

      SingleOp := nil;
      SingleOp := AllocMem( iValChkCount * sizeof(CROpType) );

      ValCheck := nil;
      ValCheck := AllocMem(iValChkCount * sizeof(VCHKDesc) );

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[0] := crAdd;
      FillChar(ValCheck^[0], sizeOf(ValCheck), #0);
      With ValCheck^[0] do
      begin
        iFldNum := 1;
        bRequired := true;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := false;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([0], aDefVal) ;
        szPict  := '';
      end;

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[1] := crAdd;
      FillChar(ValCheck^[1], sizeOf(ValCheck), #0);
      With ValCheck^[1] do
      begin
        iFldNum := 2;
        bRequired := true;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := false;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0,0,0,128], aMinVal) ;
        EnCodeValueCheck([0,0,0,128], aMaxVal) ;
        EnCodeValueCheck([0,0,0,128], aDefVal) ;
        szPict  := '';
      end;

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[2] := crAdd;
      FillChar(ValCheck^[2], sizeOf(ValCheck), #0);
      With ValCheck^[2] do
      begin
        iFldNum := 7;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([0], aDefVal) ;
        szPict  := '';
      end;
      pecrValChkOp := @singleop^;
      pVChkDesc := @ValCheck^
    end;
    Check(DbiDoRestructure(hDb, 1, tabledesc, nil, nil, nil, false));
  Finally
    FreeMem(ValCheck, (TableDesc^.iValChkCount * sizeof(VCHKDesc)) );
    FreeMem(SingleOp, TableDesc^.iValChkCount * sizeof(CROpType) );
    FreeMem(TableDesc, sizeof(CRTblDesc));
  end;
  try

    TableDesc := nil;
    TableDesc := AllocMem(sizeof(CRTblDesc));

    FillChar(TableDesc^, sizeOf(CRTblDesc), #0);
    With TableDesc^ do begin
      StrPCopy(szTblName, sPath + 'GltrData.DB');
      iValChkCount := 1;

      SingleOp := nil;
      SingleOp := AllocMem( iValChkCount * sizeof(CROpType) );

      ValCheck := nil;
      ValCheck := AllocMem(iValChkCount * sizeof(VCHKDesc) );

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[0] := crAdd;
      FillChar(ValCheck^[0], sizeOf(ValCheck), #0);
      With ValCheck^[0] do
      begin
        iFldNum := 3;
        bRequired := true;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := false;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([0], aDefVal) ;
        szPict  := '';
      end;
      pecrValChkOp := @singleop^;
      pVChkDesc := @ValCheck^
    end;
    Check(DbiDoRestructure(hDb, 1, tabledesc, nil, nil, nil, false));
  Finally
    FreeMem(ValCheck, (TableDesc^.iValChkCount * sizeof(VCHKDesc)) );
    FreeMem(SingleOp, TableDesc^.iValChkCount * sizeof(CROpType) );
    FreeMem(TableDesc, sizeof(CRTblDesc));
  end;
  try

    TableDesc := nil;
    TableDesc := AllocMem(sizeof(CRTblDesc));

    FillChar(TableDesc^, sizeOf(CRTblDesc), #0);
    With TableDesc^ do begin
      StrPCopy(szTblName, sPath + 'Items.DB');
      iValChkCount := 1;

      SingleOp := nil;
      SingleOp := AllocMem( iValChkCount * sizeof(CROpType) );

      ValCheck := nil;
      ValCheck := AllocMem(iValChkCount * sizeof(VCHKDesc) );

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[0] := crAdd;
      FillChar(ValCheck^[0], sizeOf(ValCheck), #0);
      With ValCheck^[0] do
      begin
        iFldNum := 2;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([83,116,111,114,101,115], aDefVal) ;
        szPict  := '';
      end;
      pecrValChkOp := @singleop^;
      pVChkDesc := @ValCheck^
    end;
    Check(DbiDoRestructure(hDb, 1, tabledesc, nil, nil, nil, false));
  Finally
    FreeMem(ValCheck, (TableDesc^.iValChkCount * sizeof(VCHKDesc)) );
    FreeMem(SingleOp, TableDesc^.iValChkCount * sizeof(CROpType) );
    FreeMem(TableDesc, sizeof(CRTblDesc));
  end;
  try

    TableDesc := nil;
    TableDesc := AllocMem(sizeof(CRTblDesc));

    FillChar(TableDesc^, sizeOf(CRTblDesc), #0);
    With TableDesc^ do begin
      StrPCopy(szTblName, sPath + 'LendData.DB');
      iValChkCount := 1;

      SingleOp := nil;
      SingleOp := AllocMem( iValChkCount * sizeof(CROpType) );

      ValCheck := nil;
      ValCheck := AllocMem(iValChkCount * sizeof(VCHKDesc) );

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[0] := crAdd;
      FillChar(ValCheck^[0], sizeOf(ValCheck), #0);
      With ValCheck^[0] do
      begin
        iFldNum := 6;
        bRequired := false;
        bHasMinVal := true;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0,0,0,0,0,0,240,63], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([0,0,0,0,0,0,240,63], aDefVal) ;
        szPict  := '';
      end;
      pecrValChkOp := @singleop^;
      pVChkDesc := @ValCheck^
    end;
    Check(DbiDoRestructure(hDb, 1, tabledesc, nil, nil, nil, false));
  Finally
    FreeMem(ValCheck, (TableDesc^.iValChkCount * sizeof(VCHKDesc)) );
    FreeMem(SingleOp, TableDesc^.iValChkCount * sizeof(CROpType) );
    FreeMem(TableDesc, sizeof(CRTblDesc));
  end;
  try

    TableDesc := nil;
    TableDesc := AllocMem(sizeof(CRTblDesc));

    FillChar(TableDesc^, sizeOf(CRTblDesc), #0);
    With TableDesc^ do begin
      StrPCopy(szTblName, sPath + 'MItems.DB');
      iValChkCount := 3;

      SingleOp := nil;
      SingleOp := AllocMem( iValChkCount * sizeof(CROpType) );

      ValCheck := nil;
      ValCheck := AllocMem(iValChkCount * sizeof(VCHKDesc) );

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[0] := crAdd;
      FillChar(ValCheck^[0], sizeOf(ValCheck), #0);
      With ValCheck^[0] do
      begin
        iFldNum := 4;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([0], aDefVal) ;
        szPict  := '';
      end;

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[1] := crAdd;
      FillChar(ValCheck^[1], sizeOf(ValCheck), #0);
      With ValCheck^[1] do
      begin
        iFldNum := 5;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([0], aDefVal) ;
        szPict  := '';
      end;

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[2] := crAdd;
      FillChar(ValCheck^[2], sizeOf(ValCheck), #0);
      With ValCheck^[2] do
      begin
        iFldNum := 6;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([0], aDefVal) ;
        szPict  := '';
      end;
      pecrValChkOp := @singleop^;
      pVChkDesc := @ValCheck^
    end;
    Check(DbiDoRestructure(hDb, 1, tabledesc, nil, nil, nil, false));
  Finally
    FreeMem(ValCheck, (TableDesc^.iValChkCount * sizeof(VCHKDesc)) );
    FreeMem(SingleOp, TableDesc^.iValChkCount * sizeof(CROpType) );
    FreeMem(TableDesc, sizeof(CRTblDesc));
  end;
  try

    TableDesc := nil;
    TableDesc := AllocMem(sizeof(CRTblDesc));

    FillChar(TableDesc^, sizeOf(CRTblDesc), #0);
    With TableDesc^ do begin
      StrPCopy(szTblName, sPath + 'MVoucher.DB');
      iValChkCount := 1;

      SingleOp := nil;
      SingleOp := AllocMem( iValChkCount * sizeof(CROpType) );

      ValCheck := nil;
      ValCheck := AllocMem(iValChkCount * sizeof(VCHKDesc) );

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[0] := crAdd;
      FillChar(ValCheck^[0], sizeOf(ValCheck), #0);
      With ValCheck^[0] do
      begin
        iFldNum := 7;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([0], aDefVal) ;
        szPict  := '';
      end;
      pecrValChkOp := @singleop^;
      pVChkDesc := @ValCheck^
    end;
    Check(DbiDoRestructure(hDb, 1, tabledesc, nil, nil, nil, false));
  Finally
    FreeMem(ValCheck, (TableDesc^.iValChkCount * sizeof(VCHKDesc)) );
    FreeMem(SingleOp, TableDesc^.iValChkCount * sizeof(CROpType) );
    FreeMem(TableDesc, sizeof(CRTblDesc));
  end;
  try

    TableDesc := nil;
    TableDesc := AllocMem(sizeof(CRTblDesc));

    FillChar(TableDesc^, sizeOf(CRTblDesc), #0);
    With TableDesc^ do begin
      StrPCopy(szTblName, sPath + 'Orders.DB');
      iValChkCount := 6;

      SingleOp := nil;
      SingleOp := AllocMem( iValChkCount * sizeof(CROpType) );

      ValCheck := nil;
      ValCheck := AllocMem(iValChkCount * sizeof(VCHKDesc) );

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[0] := crAdd;
      FillChar(ValCheck^[0], sizeOf(ValCheck), #0);
      With ValCheck^[0] do
      begin
        iFldNum := 1;
        bRequired := false;
        bHasMinVal := true;
        bHasMaxVal := false;
        bHasDefVal := false;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0,0,0,0,0,0,240,63], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([0], aDefVal) ;
        szPict  := '';
      end;

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[1] := crAdd;
      FillChar(ValCheck^[1], sizeOf(ValCheck), #0);
      With ValCheck^[1] do
      begin
        iFldNum := 2;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([83,116,111,114,101,115], aDefVal) ;
        szPict  := '';
      end;

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[2] := crAdd;
      FillChar(ValCheck^[2], sizeOf(ValCheck), #0);
      With ValCheck^[2] do
      begin
        iFldNum := 17;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([0], aDefVal) ;
        szPict  := '';
      end;

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[3] := crAdd;
      FillChar(ValCheck^[3], sizeOf(ValCheck), #0);
      With ValCheck^[3] do
      begin
        iFldNum := 18;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([0], aDefVal) ;
        szPict  := '';
      end;

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[4] := crAdd;
      FillChar(ValCheck^[4], sizeOf(ValCheck), #0);
      With ValCheck^[4] do
      begin
        iFldNum := 21;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([0], aDefVal) ;
        szPict  := '';
      end;

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[5] := crAdd;
      FillChar(ValCheck^[5], sizeOf(ValCheck), #0);
      With ValCheck^[5] do
      begin
        iFldNum := 34;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([0], aDefVal) ;
        szPict  := '';
      end;
      pecrValChkOp := @singleop^;
      pVChkDesc := @ValCheck^
    end;
    Check(DbiDoRestructure(hDb, 1, tabledesc, nil, nil, nil, false));
  Finally
    FreeMem(ValCheck, (TableDesc^.iValChkCount * sizeof(VCHKDesc)) );
    FreeMem(SingleOp, TableDesc^.iValChkCount * sizeof(CROpType) );
    FreeMem(TableDesc, sizeof(CRTblDesc));
  end;
  try

    TableDesc := nil;
    TableDesc := AllocMem(sizeof(CRTblDesc));

    FillChar(TableDesc^, sizeOf(CRTblDesc), #0);
    With TableDesc^ do begin
      StrPCopy(szTblName, sPath + 'POrders.DB');
      iValChkCount := 1;

      SingleOp := nil;
      SingleOp := AllocMem( iValChkCount * sizeof(CROpType) );

      ValCheck := nil;
      ValCheck := AllocMem(iValChkCount * sizeof(VCHKDesc) );

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[0] := crAdd;
      FillChar(ValCheck^[0], sizeOf(ValCheck), #0);
      With ValCheck^[0] do
      begin
        iFldNum := 2;
        bRequired := true;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := false;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([0], aDefVal) ;
        szPict  := '';
      end;
      pecrValChkOp := @singleop^;
      pVChkDesc := @ValCheck^
    end;
    Check(DbiDoRestructure(hDb, 1, tabledesc, nil, nil, nil, false));
  Finally
    FreeMem(ValCheck, (TableDesc^.iValChkCount * sizeof(VCHKDesc)) );
    FreeMem(SingleOp, TableDesc^.iValChkCount * sizeof(CROpType) );
    FreeMem(TableDesc, sizeof(CRTblDesc));
  end;
  try

    TableDesc := nil;
    TableDesc := AllocMem(sizeof(CRTblDesc));

    FillChar(TableDesc^, sizeOf(CRTblDesc), #0);
    With TableDesc^ do begin
      StrPCopy(szTblName, sPath + 'RecData.DB');
      iValChkCount := 3;

      SingleOp := nil;
      SingleOp := AllocMem( iValChkCount * sizeof(CROpType) );

      ValCheck := nil;
      ValCheck := AllocMem(iValChkCount * sizeof(VCHKDesc) );

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[0] := crAdd;
      FillChar(ValCheck^[0], sizeOf(ValCheck), #0);
      With ValCheck^[0] do
      begin
        iFldNum := 2;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([84,114,117,101], aDefVal) ;
        szPict  := '';
      end;

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[1] := crAdd;
      FillChar(ValCheck^[1], sizeOf(ValCheck), #0);
      With ValCheck^[1] do
      begin
        iFldNum := 6;
        bRequired := true;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := false;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([0], aDefVal) ;
        szPict  := '';
      end;

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[2] := crAdd;
      FillChar(ValCheck^[2], sizeOf(ValCheck), #0);
      With ValCheck^[2] do
      begin
        iFldNum := 9;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([0], aDefVal) ;
        szPict  := '';
      end;
      pecrValChkOp := @singleop^;
      pVChkDesc := @ValCheck^
    end;
    Check(DbiDoRestructure(hDb, 1, tabledesc, nil, nil, nil, false));
  Finally
    FreeMem(ValCheck, (TableDesc^.iValChkCount * sizeof(VCHKDesc)) );
    FreeMem(SingleOp, TableDesc^.iValChkCount * sizeof(CROpType) );
    FreeMem(TableDesc, sizeof(CRTblDesc));
  end;
  try

    TableDesc := nil;
    TableDesc := AllocMem(sizeof(CRTblDesc));

    FillChar(TableDesc^, sizeOf(CRTblDesc), #0);
    With TableDesc^ do begin
      StrPCopy(szTblName, sPath + 'RectrData.DB');
      iValChkCount := 2;

      SingleOp := nil;
      SingleOp := AllocMem( iValChkCount * sizeof(CROpType) );

      ValCheck := nil;
      ValCheck := AllocMem(iValChkCount * sizeof(VCHKDesc) );

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[0] := crAdd;
      FillChar(ValCheck^[0], sizeOf(ValCheck), #0);
      With ValCheck^[0] do
      begin
        iFldNum := 2;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([84,114,117,101], aDefVal) ;
        szPict  := '';
      end;

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[1] := crAdd;
      FillChar(ValCheck^[1], sizeOf(ValCheck), #0);
      With ValCheck^[1] do
      begin
        iFldNum := 3;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := false;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0,0,0,128], aMinVal) ;
        EnCodeValueCheck([0,0,0,128], aMaxVal) ;
        EnCodeValueCheck([0,0,0,128], aDefVal) ;
        szPict  := '';
      end;
      pecrValChkOp := @singleop^;
      pVChkDesc := @ValCheck^
    end;
    Check(DbiDoRestructure(hDb, 1, tabledesc, nil, nil, nil, false));
  Finally
    FreeMem(ValCheck, (TableDesc^.iValChkCount * sizeof(VCHKDesc)) );
    FreeMem(SingleOp, TableDesc^.iValChkCount * sizeof(CROpType) );
    FreeMem(TableDesc, sizeof(CRTblDesc));
  end;
  try

    TableDesc := nil;
    TableDesc := AllocMem(sizeof(CRTblDesc));

    FillChar(TableDesc^, sizeOf(CRTblDesc), #0);
    With TableDesc^ do begin
      StrPCopy(szTblName, sPath + 'Vendors.DB');
      iValChkCount := 1;

      SingleOp := nil;
      SingleOp := AllocMem( iValChkCount * sizeof(CROpType) );

      ValCheck := nil;
      ValCheck := AllocMem(iValChkCount * sizeof(VCHKDesc) );

      { Agora vamos montar os valid Checks / Now we will set up the valid Checks };

      singleOp^[0] := crAdd;
      FillChar(ValCheck^[0], sizeOf(ValCheck), #0);
      With ValCheck^[0] do
      begin
        iFldNum := 11;
        bRequired := false;
        bHasMinVal := false;
        bHasMaxVal := false;
        bHasDefVal := true;

        FillChar(aMinVal, sizeof(aMinVal), #0);
        FillChar(aMaxVal, sizeof(aMaxVal), #0);
        FillChar(aDefVal, sizeof(aDefVal), #0);

        EnCodeValueCheck([0], aMinVal) ;
        EnCodeValueCheck([0], aMaxVal) ;
        EnCodeValueCheck([76,111,99,97,108], aDefVal) ;
        szPict  := '';
      end;
      pecrValChkOp := @singleop^;
      pVChkDesc := @ValCheck^
    end;
    Check(DbiDoRestructure(hDb, 1, tabledesc, nil, nil, nil, false));
  Finally
    FreeMem(ValCheck, (TableDesc^.iValChkCount * sizeof(VCHKDesc)) );
    FreeMem(SingleOp, TableDesc^.iValChkCount * sizeof(CROpType) );
    FreeMem(TableDesc, sizeof(CRTblDesc));
  end;
end; { fim da procedure WriteVC / End of Procedure }

{ Montar valores para o valid checks / To Mount Values for valids checks }
procedure EnCodeValueCheck(const aValues : array of byte;
                            var aValue : DBIVCHK);
var
  b : Byte;
begin
  for b := Low(aValues) to High(aValues) do
    aValue[b] := aValues[b];
end;



function fcGetAliasPath( sAlias : String) : String;
var
  oAliasProp : TStringList;
  sDir : String;
begin
  try
    oAliasProp := TStringList.Create;
    Session.GetAliasParams( sAlias, oAliasProp );
    sDir := oAliasProp.Strings[0];
    if pos('PATH',sdir) <> 0 then
      System.Delete(sdir,1,5)
    else 
      sdir := '';

      Result := sDir + '\' ;
  finally
    oAliasProp.Free;
  end;
end; { fim da procedure / End of procedure }

end. { Fim da unit / End of the Unit}
