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;