Soucis avec une restauration de base

Version imprimable

Bonjour,
J'ai fait un petit programme qui gère plusieurs tables avec une base Firebird

J'y ai introduit une partie sauvegarde/restauration de cette base.

La sauvegarde s'effectue sans soucis.

La restauration ne s'effectue pas, j'ai toujours un message que le fichier est occupé par un autre processus, pourtant je déconnecte bien la base avant de faire l'opération. Voici une partie du code
Code:

1 2 3 4 5 6 7 8 9 10 11 12 procedure Tfich_sauv_rest_base.btactionsauv_restClick(Sender: TObject); begin if messagedlg('CONFIRMEZ-VOUS CETTE OPERATION ? SOURCE '+LabeledEdit_chemin_base_source.Text +' VERS DESTINATION ' + edit2.Text,mtconfirmation,[mbyes,mbcancel],0)<>mryes then begin Sysutils.Abort; end else module_bases.ZConnection1.Connected:=false; if CopyFile(PChar(scrfilename),PChar(destfilename),false) then showmessage ('OPERATION REUSSIE !') else showmessage (SysErrorMessage(GetLastOSError)); end;
Je me demande cela ne pourrait pas provenir d'un TFilenameedit placé en amont avec un filtre sur ma base, activé en même temps que la form.

J'ai vérifié, la copie (via Windows) fonctionne bien, quand mon petit programme est fermé, c'est donc bien une erreur chez moi.

23/07/2018, 15h52
JCD59

Citation:

Envoyé par JCD59

Bonjour,
J'ai fait un petit programme qui gère plusieurs tables avec une base Firebird

J'y ai introduit une partie sauvegarde/restauration de cette base.

La sauvegarde s'effectue sans soucis.

La restauration ne s'effectue pas, j'ai toujours un message que le fichier est occupé par un autre processus, pourtant je déconnecte bien la base avant de faire l'opération. Voici une partie du code

Je me demande cela ne pourrais pas provenir d'un TFilenameedit placé en amont avec un filtre sur ma base, activé en même temps que la form.

J'ai vérifié, la copie (via Windows) fonctionne bien, quand mon petit programme est fermé, c'est donc bien une erreur chez moi.

Je confirme que cela doit bien être mon Tfilenameedit qui doit doit générer cette erreur, car j'ai saisi à un autre endroit sans cet élément le même code avec les noms de fichiers en 'dur" et là cela fonctionne......

J'avais initialement Filelistbox, mais je souhaité avoir la date des fichier ce que me donne Tfilenameedit.

Bonsoir

Pour ajouter une colonne "date" à un TShellListView (Ton FileListBox je suppose)

voici comment procéder
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Procedure TMainForm.FormCreate(Sender: TObject); Var aCol : TListColumn; Begin aCol := ShellListView.Columns.Add; aCol.Caption := 'Date'; aCol.AutoSize := true; end; // Évènement FileAdded Procedure TMainForm.ShellListViewFileAdded(Sender: TObject; Item: TListItem); Var dt: TDateTime; Begin FileAge(ShellListView.Root+Item.Caption, dt); Item.SubItems.Add(FormatDateTime('DD/MM/YYYY hh:mm',Dt)); end;
Le TFilenameedit doit avoir un bug, car ce n'est pas normal qu'il te "lock" le fichier sélectionné

Il semble que function TFileNameEdit.CreateDialog(AKind: TDialogKind): TCommonDialog; de l'unité "lcl\EditBtn.pas" la boite de dialogue créée avec cette fonction n'est pas libérée, correctement. Ce qui pourrais donc provoquer cette erreur. Je testerai plus tard et enverrai une note dans le "BugTracker" au besoin.

Bonne fin de soirée

Question bête, mais quand tu utilises ton TFileNameEdit, tu ouvres donc ta base si je comprend bien et tu déconnecte bien ta base avec module_bases.ZConnection1.Connected:=false; si ça se trouve c'est ZEOS qui ferme mal la connection et non ton filenameedit. En regardant le code de celui-ci je ne comprend pas en quoi et ou le fichier sélectionné peut-être "locker". Mise à part cette histoire de destruction mais je ne pense pas car je viens de faire un test simple
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 Unit Unit1; {$mode objfpc}{$H+} Interface Uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, EditBtn, StdCtrls; Type { TForm1 } TForm1 = Class(TForm) btnCopy: TButton; edtDir: TDirectoryEdit; edtFile: TFileNameEdit; Label1: TLabel; Procedure btnCopyClick(Sender: TObject); Procedure edtDirChange(Sender: TObject); private public End; Var Form1: TForm1; Implementation {$R *.lfm} { TForm1 } Procedure TForm1.btnCopyClick(Sender: TObject); Var ScrFileName, DstFileName : String; Begin ScrFileName := edtFile.FileName; DstFileName := edtDir.Directory + PathDelim + ExtractFileName(edtFile.Text); if messagedlg('CONFIRMEZ-VOUS CETTE OPERATION ? SOURCE '+edtFile.Text +' VERS DESTINATION ' + edtDir.Text,mtconfirmation,[mbyes,mbcancel],0)=mryes then begin if CopyFile(PChar(ScrFileName),PChar(DstFileName),false) then showmessage ('OPERATION REUSSIE !') else showmessage (SysErrorMessage(GetLastOSError)); End; end; End.
Une fois compilé et lancé J'ai choisi comme fichier, l'exécutable de ce test. Et le fichier à été parfaitement copié.

Il me semble donc que le problème se trouve du coté de ZEOS et de la commande de déconnection module_bases.ZConnection1.Connected:=false; tu as peut-être besoin de détruire ton objet "module_bases" .La simple déconnexion ne semble pas suffire. Il existe peut-être une autre méthode ou fonction dans ZEOS. Mais je ne peux pas t'aider car je connais que très peu cette suite de composant.

Citation:
Envoyé par BeanzMaster
Question bête, mais quand tu utilises ton TFileNameEdit, tu ouvres donc ta base si je comprend bien et tu déconnecte bien ta base avec module_bases.ZConnection1.Connected:=false; si ça se trouve c'est ZEOS qui ferme mal la connection et non ton filenameedit. En regardant le code de celui-ci je ne comprend pas en quoi et ou le fichier sélectionné peut-être "locker". Mise à part cette histoire de destruction mais je ne pense pas car je viens de faire un test simple
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 Unit Unit1; {$mode objfpc}{$H+} Interface Uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, EditBtn, StdCtrls; Type { TForm1 } TForm1 = Class(TForm) btnCopy: TButton; edtDir: TDirectoryEdit; edtFile: TFileNameEdit; Label1: TLabel; Procedure btnCopyClick(Sender: TObject); Procedure edtDirChange(Sender: TObject); private public End; Var Form1: TForm1; Implementation {$R *.lfm} { TForm1 } Procedure TForm1.btnCopyClick(Sender: TObject); Var ScrFileName, DstFileName : String; Begin ScrFileName := edtFile.FileName; DstFileName := edtDir.Directory + PathDelim + ExtractFileName(edtFile.Text); if messagedlg('CONFIRMEZ-VOUS CETTE OPERATION ? SOURCE '+edtFile.Text +' VERS DESTINATION ' + edtDir.Text,mtconfirmation,[mbyes,mbcancel],0)=mryes then begin if CopyFile(PChar(ScrFileName),PChar(DstFileName),false) then showmessage ('OPERATION REUSSIE !') else showmessage (SysErrorMessage(GetLastOSError)); End; end; End.
Une fois compilé et lancé J'ai choisi comme fichier, l'exécutable de ce test. Et le fichier à été parfaitement copié.

Il me semble donc que le problème se trouve du coté de ZEOS et de la commande de déconnection module_bases.ZConnection1.Connected:=false; tu as peut-être besoin de détruire ton objet "module_bases" .La simple déconnexion ne semble pas suffire. Il existe peut-être une autre méthode ou fonction dans ZEOS. Mais je ne peux pas t'aider car je connais que très peu cette suite de composant.
Merci pour vos réponses

Tout d'abord mon test coté dans mon second message, est improductif. Certes je n'ai pas eu de retour d'erreur de windows, mais il me semble que le transfert ne s'effectue pas.

Ensuite, j'ai essayé de le faire par windows avec mon logiciel ouvert et c'est Firebird qui reste actif, donc la réflexion de BeanzMaster est dans le vrai, je vais donc creuser cette voie!

1 pièce(s) jointe(s)

Je me suis hasardé à utiliser le composant TFBAdmin.

Pour une utilisation en local j'ai écris ce code
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 procedure Backup(Database, Backupfile: string); var Admin: TFBAdmin; begin Admin := TFBAdmin.Create(nil); try Admin.UseExceptions := True; Admin.User := 'SYSDBA'; Admin.Password := '***'; // ( J'ai bien mon mot de passe de connexion) Admin.Port := 3050; admin.connect; Admin.OnOutput := @fich_sauv_rest_base.logadm; Admin.Backup(Database, Backupfile, [IBBkpVerbose]); finally Admin.Free; //disconnects automatically end; end;
Je n'ai testé que que la backup pour l'instant et cela ne se passe pas bien

La backup se lance, mais à un stade se bloque. J'arrive à obtenir un message SQL Error connection Shutdown Error code -902 Can't format message 13:98

J'ai une trace du déroulé jusqu'à ce stade, elle est en document joint

Là je coince

1 pièce(s) jointe(s)

hello,
TFBAdmin est utilisé dans mon exemple image_mushrooms qui se trouve dans le répertoire lazarus\examples\database\image_mushrooms de Lazarus. Dans cet exemple on gère une base de données de champignons mortels en utilisant les composants SQLdb. On utilise comme moteur base de données soit sqlite3 ou soit firebird embedded. Pour pouvoir utiliser ses moteurs bases de données sous windows, il faut que les dll des moteurs soient accessibles pendant l'exécution ( sqlite3.dll pour sqlite, fbembed.dll, icudt30.dll, icuin30.dll et icuuc30.dll pour firebird embedded). Il faut que les dll soient dans la même version que Lazarus (ex : pour Lazarus 1.8.2 32 bits , des dll 32 bits). Dans mon exemple pour forcer l'application à utiliser Firebird embedded , il faut mettre la variable FUsingFirebird à true au début du FormCreate.
Pour limiter la taille des fichiers de l'exemple, la base de données en firebird est livrée dans sa version de backup : ImageTest.fbk.
Au premier lancement de l'application si on est en mode firebird, on va recréer la base de données à partir du backup .fbk :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 begin //Using Firebird try DBFile:=ExtractFilePath(ParamStr(0)) + FirebirdDB; BackupFile:=ChangeFileExt(DBFile,'.fbk'); // First try restoring backup file with full content if fileexists(BackupFile) then begin FBAdmin:=TFBAdmin.Create(nil); try try FBAdmin.UseExceptions:=true; FBAdmin.Host:=''; //embedded FBAdmin.Protocol:=IBSPLOCAL; FBAdmin.User:='SYSDBA'; FBAdmin.Password:=''; //embedded: doesn't matter which password is used FBAdmin.OnOutput := @Form1.logadm; FBAdmin.Connect; // Now run the restore. It will not overwrite an existing file but will // create a new db if FBAdmin.Restore(DBFile,BackupFile,[IBResCreate,IBResVerbose]) then begin sleep(200); //at least needed on Windows: give the filesystem time to update so we don't get failures connecting exit(true) //we're done; exit the function end else result := false; finally FBAdmin.Free; end; except result := false; //we can continue with the next fallback step end; end;
j'obtiens quelque chose de similaire à tes logs dans mes logs :

Citation:

Memo1Restore : gbak:opened file M:\Dev\Lazarus\lazarus1-8-2\examples\database\image_mushrooms\ImageTest.fbk
Restore : gbak:transportable backup -- data in XDR format
Restore : gbak: backup file is compressed
Restore : gbak:created database M:\Dev\Lazarus\lazarus1-8-2\examples\database\image_mushrooms\ImageTest.fdb, page_size 16384 bytes
Restore : gbak:started transaction
Restore : gbak:restoring domain RDB$1
Restore : gbak:restoring domain RDB$2
Restore : gbak:restoring domain RDB$3
Restore : gbak:restoring domain RDB$4
Restore : gbak:restoring domain RDB$5
Restore : gbak:restoring domain RDB$6
Restore : gbak:restoring domain RDB$7
Restore : gbak:restoring domain RDB$8
Restore : gbak: committing metadata
Restore : gbak:restoring table DEADLYMUSHROOMS
Restore : gbak: restoring column NOTES
Restore : gbak: restoring column PICTURE
Restore : gbak: restoring column ID
Restore : gbak: restoring column SCIENTIFIC_NAME
Restore : gbak: restoring column COMMON_NAME
Restore : gbak: restoring column Order
Restore : gbak: restoring column GENUS
Restore : gbak: restoring column IMAGE_LINK
Restore : gbak:restoring generator GEN_DEADLYMUSHROOMS_ID value: 5
Restore : gbak: committing metadata
Restore : gbak: restoring index RDB$PRIMARY1
Restore : gbak:restoring data for table DEADLYMUSHROOMS
Restore : gbak: 5 records restored
Restore : gbak: restoring trigger DEADLYMUSHROOMS_BI
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user PUBLIC
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user PUBLIC
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user PUBLIC
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak: restoring privilege for user SYSDBA
Restore : gbak:creating indexes
Restore : gbak: activating and creating deferred index RDB$PRIMARY1
Restore : gbak: committing metadata
Restore : gbak:finishing, closing, and going home
Restore :

Alors pour tes soucis :
1 - Sous quel O.S es-tu, avec quelle version de Firebird et quelle version de Lazarus ?
2 - Tu n'as pas mis dans les paramètres de FBAdmin le Host et le Protocol :
exemple pour un Firebird non embarqué :
Code:

1 2 FBAdmin.Host:='192.168.1.66'; FBAdmin.Protocol:= IBSPTCPIP;
3 - Tu n'as pas mis de délai (pas sûr que cela soit important) entre la fin du backup et la libération du FBAdmin (correspond à ce code dans mon exemple ) :

Code:

sleep(200); //at least needed on Windows: give the filesystem time to update so we don't get failures connecting

Ami calmant, J.P

25/07/2018, 09h00
JCD59

1 pièce(s) jointe(s)

Bonjour et merci de regarder mon soucis.

J'avais laissé ces deux paramètres à ma première tentative

Citation:

FBAdmin.Host:='192.168.1.66';
FBAdmin.Protocol:= IBSPTCPIP;

Mais à l'exécution j'ai cette erreur.

Pièce jointe 399175

A cette question

Citation:

Sous quel O.S es-tu, avec quelle version de Firebird et quelle version de Lazarus ?

OS : Windows 10 Pro (64bits) version 1803
Firebird : version 3.0.2.32703(x64)
Firebird ODBC Driver vers 2.0.04.155
Lazarus version 1.8.2

Cordialement

hello,
c'est normal que ça ne fonctionne pas, l'ordinateur où se trouve ton serveur firebird a-t-il pour adresse 192.168.1.6 ?
si c'est le même ordinateur que l'endroit où se trouve ton Lazarus il faut mieux mettre localhost pour le paramètre Host.
D'autre part Lazarus n'a pas forcément besoin d'un driver ODBC pour s'interfacer avec un serveur firebird surtout si il se trouve sur le même ordinateur et que l'on utilise les composants SQLdb.
Voici l'essai que je viens de faire sur mon ordinateur en Windows 10 64 bits Lazarus 1.8.2 32 bits.
1 - J'ai installé la dernière version de firebird en version 64 bits : Firebird-3.0.3.32900_0_x64.exe (si il y a déjà une version installée la désinstaller avant)
2 - J'ai laissé les options par défaut.
3 - A savoir : pendant l'installation il y a des dll pour les accès client qui sont installées (fbclient.dll) à la fois pour les programmes 32 bits et les programmes 64 bits. C'est par cette dll que Lazarus communiquera avec le serveur firebird.
Voici ce que j'ai modifié dans mon programme pour maintenant utiliser une base de données du serveur Firebird-3 plutôt qu'une base de données embarquée :
Recréation de la base d'après un backup (la nouvelle base se trouvera dans M:\Test et s'appellera Mushrooms.fdb :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
begin //Using Firebird
      BackupFile:= ExtractFilePath(ParamStr(0)) + 'imagetest.fbk';
      DBFile := 'M:\Test\Mushrooms.fdb';
      // First try restoring backup file with full content
      if fileexists(BackupFile) then
      begin
        FBAdmin:=TFBAdmin.Create(nil);
        try
          try
            FBAdmin.UseExceptions:=true;
            FBAdmin.Host:='localhost';
            FBAdmin.Protocol:=IBSPTCPIP;
            FBAdmin.User:='SYSDBA';
            FBAdmin.Password:='masterkey';
            FBAdmin.Port:= 3050;
            FBAdmin.OnOutput := @Form1.logadm;
            FBAdmin.Connect;
            // Now run the restore. It will not overwrite an existing file but will
            // create a new db
            if FBAdmin.Restore(DBFile,BackupFile,[IBResCreate,IBResVerbose]) then
            begin
              sleep(200); //at least needed on Windows: give the filesystem time to update so we don't get failures connecting
              exit() //we're done; exit the function
            end
            else
              result := false;
          finally
            FBAdmin.Free;
          end;
        except
           //we can continue with the next fallback step
        end;
	  end;
end;

Pour l'accès à la base :

Code:

1
2
3
4
5
6
7
8
9
    IBConnection1.HostName := 'localhost';
    IBConnection1.Password := 'masterkey';
    IBConnection1.UserName:='SYSDBA'; //for embedded, this should be an existing name
    IBConnection1.CharSet:='UTF8';
    IBConnection1.Params.Add('PAGE_SIZE=16384'); //enough space for indexes etc
    IBConnection1.DatabaseName := 'M:\Test\Mushrooms.fdb';
    IBConnection1.Transaction:=SQLTransaction1;
    SQLTransaction1.Database:=IBConnection1;
    SQLQuery1.DataBase:=IBConnection1;

et pour une sauvegarde :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
var DBFile, BackupFile : String;
    FBAdmin: TFBAdmin;
begin
     DBFile := 'M:\Test\Mushrooms.fdb';
     BackupFile:=ChangeFileExt(DBFile,'.fbk');
     FBAdmin:=TFBAdmin.Create(nil);
        try
          try
            FBAdmin.UseExceptions:=true;
            FBAdmin.Host:='localhost';
            FBAdmin.Protocol:=IBSPTCPIP;
            FBAdmin.User:='SYSDBA';
            FBAdmin.Password:='masterkey';
            FBAdmin.Port:= 3050;
            FBAdmin.OnOutput := @Form1.logadm;
            FBAdmin.Connect;
            // Now run the restore. It will not overwrite an existing file but will
            // create a new db
            if FBAdmin.Backup(DBFile,BackupFile,[IBBkpVerbose]) then
            begin
              sleep(200); //at least needed on Windows: give the filesystem time to update so we don't get failures connecting
              exit() //we're done; exit the function
            end
          finally
            FBAdmin.Free;
          end;
        except
           //we can continue with the next fallback step
        end;
end;

Ami calmant, J.P

28/07/2018, 10h49
JCD59

Jurassic pork, merci pour ces explications et exemples.

Je regarde et teste cela tranquillement.

J'indiquerais ensuite le résultat