Discussion :

[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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[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.

[BeanzMaster]

Bonsoir

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

voici comment procéder

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[JCD59]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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!

[JCD59]

Je me suis hasardé à utiliser le composant TFBAdmin.

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[jurassic pork]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Ami calmant, J.P

[JCD59]

Bonjour et merci de regarder mon soucis.

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

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

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



A cette question

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

[jurassic pork]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[JCD59]

Jurassic pork, merci pour ces explications et exemples.

Je regarde et teste cela tranquillement.

J'indiquerais ensuite le résultat