IT SOLUTIONS
Your full service technology partner! 
-Collapse +Expand
Delphi
Search Delphi Group:

Advanced
-Collapse +Expand Delphi To/From
To/FromCODEGuides
-Collapse +Expand Delphi Store
PRESTWOODSTORE

Prestwood eMagazine

May Edition
Subscribe now! It's Free!
Enter your email:

   ► KBProgrammingDelphi for W...Using DataBDE   Print This     
 
Delphi BDE:
BDE Paradox Robust table openning
 
Posted 9 years ago on 4/6/2011
Delphi Code Snippet:
 A flashcard from our Delphi Flashcards Library
 A code snippet from our Delphi Code Snippets Page

KB102273

This is a rough draft version of a procedure that provides a robust way to open paradox tables in a delphi program

Syntax Example:

unit DataModule;

interface

uses
  windows,SysUtils, Classes, DB, DBTables, controls, DateUtils, Dialogs, shellapi;

type
  TDataModule1 = class(TDataModule)
    Table1: TTable;

    ......

    ......

  public
    SauveTable: boolean;
  end;

......

.......

procedure TDataModule1.DataModuleCreate(Sender: TObject);
var
  DtBs : string;
  DirVers : string;
  DirDepuis: string;
  TableNam : string;
  st1,st2 : string;
  i,j,k : integer;
  TableTemp,
  TableSours : TTable;
  Transefrt : TBatchMove;
  res : boolean;
  f: TSearchRec;
  ListFichier : TStringList;
begin
SauveTable:=true;
DecimalSeparator:='.';
ThousandSeparator:=' ';

Transefrt:=TBatchMove.Create(Self);
TableTemp:=TTable.Create(Self);

for i:=0 to Self.ComponentCount-1 do
 if (self.Components[i] is TTable) and (self.Components[i]<>TableTemp) then
 begin
  if not TTable(Self.Components[i]).Exists then
    if Messagedlg('Erreurr Fatal: La table '+TTable(Self.Components[i]).TableName+' est manquante'#10#13+
                   'Voulez vous recuprer la table partir de la dernire sauveguarde',mtError ,mbOKCancel,0)=mrok
       then begin
          DirDepuis:=Sessions.FindSession(TTable(Self.Components[i]).SessionName).FindDatabase(TTable(Self.Components[i]).DatabaseName).Directory;
          if DirDepuis[length(DirDepuis)]='\' then DirDepuis:=copy(DirDepuis,1,length(DirDepuis)-1);
          ListFichier:=TStringList.Create;
          res:=false;
          if FindFirst(DirDepuis+'\sauv_*.*',faDirectory,f)=0
          then
              repeat
                    ListFichier.Add(f.name);
              until FindNext(f)<>0;
          FindClose(f);
          ListFichier.Sorted:=true;
          if ListFichier.Count<1
            then begin
              ShowMessage('Pas de sauvguard trouv?!! Veuillez contacter l''administrateur informatique');
              for k:=0 to Self.ComponentCount-1 do
                 if self.Components[k] is TTable
                   then if TTable(Self.Components[k]).Active
                            then TTable(self.Components[k]).close;
              ListFichier.Free;
              FormPrincipal.Close;
              exit;
            end;
          DirVers:=DirDepuis+'\'+ListFichier[ListFichier.count-1];
          ListFichier.Free;
          ListFichier:=TStringList.Create;
          res:=false;
          if FindFirst(DirVers+'\'
              +copy(TTable(Self.Components[i]).TableName,1,pos('.',TTable(Self.Components[i]).TableName)-1)+'.*',faAnyFile,f)=0
          then
              repeat
                    ListFichier.Add(f.name);
              until FindNext(f)<>0;
          FindClose(f);
          for j := ListFichier.Count - 1 downto 0
          do    CopyFile(Pchar(DirVers+'\' + ListFichier[j]),
                           Pchar(DirDepuis+'\' + ListFichier[j]),res);
          ListFichier.Free;
       end;

  try
    TTable(Self.Components[i]).Open;
    except
    DirDepuis:=Sessions.FindSession(TTable(Self.Components[i]).SessionName).FindDatabase(TTable(Self.Components[i]).DatabaseName).Directory;
    if DirDepuis[length(DirDepuis)]='\' then DirDepuis:=copy(DirDepuis,1,length(DirDepuis)-1);
    DirVers:=DirDepuis+'\Sauv_'+FormatDateTime('dd-mm-yyyy',Date)+'_'+FormatDateTime('hh-mm',time);
    if not DirectoryExists(DirVers)
     then CreateDir(DirVers);
    ListFichier:=TStringList.Create;
    res:=false;
    if FindFirst(DirDepuis+'\'
        +copy(TTable(Self.Components[i]).TableName,1,pos('.',TTable(Self.Components[i]).TableName)-1)+'.*',faAnyFile,f)=0
    then
        repeat
              ListFichier.Add(f.name);
        until FindNext(f)<>0;
    FindClose(f);
    for j := ListFichier.Count - 1 downto 0
    do    CopyFile(Pchar(DirDepuis+'\' + ListFichier[j]),
                     Pchar(DirVers+'\' + ListFichier[j]),res);
    DirVers:=DirDepuis+'\Rindx';
    if not DirectoryExists(DirVers)
     then CreateDir(DirVers);
    st1:=DirDepuis+'\'+TTable(Self.Components[i]).TableName;
    st2:=DirVers+'\'+TTable(Self.Components[i]).TableName;
    copyfile(pchar(st1),pchar(st2),res);
    if FileExists(DirDepuis+'\'+ChangeFileExt( TTable(Self.Components[i]).TableName,'.MB'))
      then begin
            st1:=DirDepuis+'\'+ChangeFileExt( TTable(Self.Components[i]).TableName,'.MB');
            st2:=DirVers+'\'+ChangeFileExt( TTable(Self.Components[i]).TableName,'.MB');
            copyfile(pchar(st1),pchar(st2),res);
      end;
    ListFichier.Free;
    st1:='-t '+DirDepuis+'\Rindx\'
                      + TTable(Self.Components[i]).TableName
                      + ' -AUTO -CLOSE -p amadou';
    ShellExecute(FormPrincipal.Handle,
                'open',
                'TableRepairCommand.exe',
                Pchar(st1),
                nil,
                1);

    tabletemp.DatabaseName:=DirDepuis+'\Rindx';
    TableTemp.TableName:=TTable(Self.Components[i]).TableName;
    TableTemp.SessionName:=TTable(Self.Components[i]).SessionName;
    if TTable(Self.Components[i]).Active then TTable(Self.Components[i]).Close;
    if TTable(Self.Components[i]).Exists
     then TTable(Self.Components[i]).DeleteTable;
    TTable(Self.Components[i]).CreateTable;
    TTable(Self.Components[i]).Open;
    TableTemp.Open;  //
    Transefrt.Source:=TableTemp;
    Transefrt.Destination:=TTable(Self.Components[i]);
    Transefrt.Mode:=batAppend;
    Transefrt.Execute;
    TableTemp.Close;
  end;
 end;
Transefrt.Destroy;
TableTemp.Destroy;
for i:=0 to Self.ComponentCount-1 do
   if self.Components[i] is TTable
     then if not TTable(Self.Components[i]).Active
              then TTable(self.Components[i]).Open;

SauveTable:=true;
end;

......

......

procedure TDataModule.DataModuleDestroy(Sender: TObject);

var
  DtBs : string;
  DirVers : string;
  DirDepuis: string;
  TableNam : string;
  st1,st2 : string;
  i,j,k,l : integer;
  TableTemp,
  TableSours : TTable;
  Transefrt : TBatchMove;
  res : boolean;
  f: TSearchRec;
  ListFichier : TStringList;
begin
if (Messagedlg('Voulez vous effectuer une sauvguarde?',mtConfirmation ,mbOKCancel,0)=mrok
)
   and (SauveTable)

  then begin
    for l:=0 to form1.Application.ComponentCount-1 do
     if (form1.Application.components[l] is TForm) or (form1.Application.components[l] is TDataModule)
      then begin
         for i:=0 to form1.Application.components[l].ComponentCount-1 do
            if (form1.Application.components[l].Components[i] is TTable) and (form1.Application.components[l].Components[i]<>TableTemp) then
             begin
                DirDepuis:=Sessions.FindSession(TTable(form1.Application.components[l].Components[i]).SessionName).FindDatabase(TTable(form1.Application.components[l].Components[i]).DatabaseName).Directory;
                if DirDepuis[length(DirDepuis)]='\' then DirDepuis:=copy(DirDepuis,1,length(DirDepuis)-1);
                DirVers:=DirDepuis+'\Sauv_'+FormatDateTime('yyyy-mm-dd',Date)+'_'+FormatDateTime('hh-mm',time);
                if not DirectoryExists(DirVers)
                 then CreateDir(DirVers);
                ListFichier:=TStringList.Create;
                res:=false;
                if FindFirst(DirDepuis+'\'
                    +copy(TTable(form1.Application.components[l].Components[i]).TableName,1,pos('.',TTable(form1.Application.components[l].Components[i]).TableName)-1)+'.*',faAnyFile,f)=0
                then
                    repeat
                          ListFichier.Add(f.name);
                    until FindNext(f)<>0;
                FindClose(f);
                for j := ListFichier.Count - 1 downto 0
                do    CopyFile(Pchar(DirDepuis+'\' + ListFichier[j]),
                                 Pchar(DirVers+'\' + ListFichier[j]),res);
                ListFichier.Free;
             end;
          end;
      end;
For i:=0 to Self.ComponentCount-1 do
  if self.Components[i] is TTable then TTable(Self.Components[i]).Close;
end;


Comments

1 Comments.
Share a thought or comment...
Comment 2 of 2

Such a wonderful work of art keep it up and see a look at https://rsglogistics.com.au/service/third-party-warehouse/

Posted 29 days ago

Comment 1 of 2

I appreciate your concept keep up the great work, visit https://macvideos.com/

Posted 30 days ago
 
Write a Comment...
...
Sign in...

If you are a member, Sign In. Or, you can Create a Free account now.


Anonymous Post (text-only, no HTML):

Enter your name and security key.

Your Name:
Security key = P1307A1
Enter key:
Code Contributed By Ahmed.A:
Visit Profile

 KB Article #102273 Counter
11558
Since 4/6/2011
Go ahead!   Use Us! Call: 916-726-5675  Or visit our new sales site: 
www.prestwood.com


©1995-2020 Prestwood IT Solutions.   [Security & Privacy]