Effectuer une copie de fichier

Bonjour,
J'ai trouvé dans la FAQ Lazarus un petit programme de WILE 64 qui permet de copier un fichier avec la visualisation de l'avancement par une barre de progression.
Je l'utilise depuis un certain temps sous Linux et tout fonctionne bien. Je n'utilise pas la barre de progression car la copie que je demande pour sauvegarder un fichier est très rapide.
Mais pour une petite application qui doit tourner sous XP j'ai compilé mon appli sous lazarus 09.28.2 sous XP, tout fonctionne à l'adaptation des chemins d'accès aux fichiers, sauf la copie de sauvegarde. Quelqu'un pourrait-il m'aider ?
Précision la copie concerne une petite base SQLITE.
Le message d'erreur aussi Unable to open file suivi du chemin et nom du fichier à copier.
Merci d'avance

et le code ?

Voici le code brut car pour essayer de comprendre j'ai écris une petit module

la partie préparation et l'appel à la procédure issue de la FAQ

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

procedure TFsauve.Prepare; begin MFUTURE:=MDESTINATION; Edit5.Text:=MFUTURE; MCHEMIN:=divers.FieldByName('REPERTOIRE').AsString; Edit1.Text:=MCHEMIN; MBASE:='BIBLIO.sdb'; Edit4.Text:=MBASE; MSOURCE:=MCHEMIN+'tables/'+MBASE; Edit2.Text:=MSOURCE; MDESTINATION:=MCHEMIN+MFUTURE+MBASE; Edit3.Text:=MDESTINATION; Edit6.Text:=MSAUVE_X; Update; end;   procedure TFsauve.BCopieClick(Sender: TObject); begin MMODIFICATION:='OUI'; if MMODIFICATION='OUI' then begin Q1:=quotedstr(MSAUVE_X); MQ:='update divers set SAUVE_X='+Q1+' where K_DIVERS=1'; divers.SQL:=MQ; divers.ExecSQL; divers.ApplyUpdates; CopierFichier (MSOURCE,MDESTINATION); divers.Close; MQ:='select * from divers'; divers.SQL:=MQ; divers.Open; divers.ExecSQL; MSAUVE_X:=divers.FieldByName('SAUVE_X').AsString; Edit6.Text:=MSAUVE_X; Edit6.Update; end else Close; end;

---

et maintenant la procédure légèrement modifiée

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

Procedure CopierFichier (Source, Destination : String); Var Src, Dst : TStream; i, Count : Int64; buffer : Array [0..1023] of Byte; Begin // Ouvrir le fichier source Src := TFileStream.Create(Source,fmOpenRead); // Ouvrir le fichier destination Dst := TFileStream.Create(Destination,fmcreate or fmOpenWrite); // Source au début de fichier Src.Position := 0; // Taille du fichier Count := Src.Size; // Début de la copie while Count > 0 do begin // On suit la progression de 0 à 100 % //ProgressBar1.Position := trunc(100.0 * (Src.position / Src.size)); // Traitement des messages pour ne pas bloquer tout le système //Application.ProcessMessages; // Si count + grand que buffer on lit la taille du buffer if (Count > sizeof(buffer)) then i := sizeof(Buffer) else i:=Count; // On lit i bits i := Src.Read(buffer,i); // On écrit i bits i := Dst.Write(buffer,i); // Si i = 0 plus rien à copier ou erreur if i = 0 then break; dec(count,i); end; // Libération des streams Src.Free; Dst.Free; //Close; end;

---

Je le répète elle fonctionne sous linux (fedore) avec lazarus 0.9.29 du 16/12/2009 et pour XP c'est la version 0.9.28.2

Petite précision, le message indique sauf mauvaise traduction de ma part que la base ne peut être ouverte pourtant j'affiche correctement les données dans des DBGrid.
A+

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

function StreamCopyFile(const SrcFile, DestFile : String; const CopySize: LongInt= 65535): boolean; var Src, Dst : TFileStream; W : Int64; begin result := false;   assert(fileExists(SrcFile), 'Source file not exists'); assert(SrcFile <> DestFile, 'Source and destination file must be different!'); assert(not fileExists(DestFile), 'Destination file already exists!');   Src := TFileStream.Create(SrcFile, fmOpenRead); try Dst := TFileStream.Create(DestFile, fmCreate); try repeat W := Dst.CopyFrom(Src, CopySize); until W < CopySize; result := Src.Size = Dst.Size; finally Dst.Free; end; finally Src.Free; end; end;

---

sinon il y à la fonction CopyFile qui existe sur Windows et Linux.

Merci Dr.Who

pour ta réponse mais comme j'aime comprendre, j'ai refait d'autres essais et je me suis aperçu qu'à la compilation sous XP j'avais une message d'anomalie non bloquant.
Le message 'Hint : local variable "buffer" does not seem to be initialised'
Chose étrange puisque cette variable est déclarée en début de procédure, peut-être faut-il sous windows ajouter une unité dans la déclaration pour prendre en compte les "tableaux" mais je ne sais pas laquelle si c'est le problème.
A suivre ?

la méthode que tu utilise est déjà mauvaise dans l'ensemble.
alors ... à toi de voir ...

en plus je pense que :

Code:

---

1 2 3

divers.ApplyUpdates; CopierFichier (MSOURCE,MDESTINATION); divers.Close;

---

vus que la base n'est pas fermée, le fichier pourrait être "occupé" et donc si l'ouverture est bloquante (not shared read), on ne pourra pas ouvrir de stream dessus.

Code:

---

Src, Dst : TStream;

---

TFileStream! pourquoi utiliser l'ancêtre ? c'est du n'importe quoi, ça bloque l'autocompletion et l'aide, bref à part embetter le developpeur ça sert à rien, surtout dans ce genre d'utilisation.
et aux gens qui dirons que c'est mieux comme ça je repond, autant faire :

Code:

---

Src, Dst : pointer;

---

et encore mieux :

Code:

---

Src, Dst : integer;

---

donc, merci bien :

Code:

---

Src, Dst : TFileStream;

---

Code:

---

1 2	buffer : Array [0..1023] of Byte;

---

ouai pourquoi pas ... tant qu'on as pas plus de 100Mo à copier.
mais bon, copyFrom c'est pas fait que pour les VBistes, de plus avec CopyFrom, pas besoin de buffer.

Code:

---

1 2	// Ouvrir le fichier destination Dst := TFileStream.Create(Destination,fmcreate or fmOpenWrite);

---

fmOpenWrite inutile, on fait une copie 1:1 du fichier source donc fmCreate paf.

Code:

---

1 2	// Source au début de fichier Src.Position := 0;

---

on etait déjà au début du flux ...

Code:

---

1 2	// Taille du fichier Count := Src.Size;

---

ça par contre un grand OUI! toujours mettre en cache les propriétés qui appelent souvent des fonctions longue d'execution et ralentisse les boucles.

Code:

---

1 2 3

// Début de la copie while Count > 0 do begin

---

dés qu'on parle de Stream, si un while apparait, à tout coups la méthode est mauvaise.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

// Si count + grand que buffer on lit la taille du buffer if (Count > sizeof(buffer)) then i := sizeof(Buffer) else i:=Count; // On lit i bits i := Src.Read(buffer,i); // On écrit i bits i := Dst.Write(buffer,i); // Si i = 0 plus rien à copier ou erreur if i = 0 then break; dec(count,i); // Libération des streams Src.Free; Dst.Free; //Close; end;

---

la c'est du grand n'importe quoi.
méthode compliqué et lourde pour une simple copie de flux à flux.
pas de try finally pour s'assurer que les flux soit bien fermés et que l'accés aux fichiers ne soient pas bloqués.
bef du début à la fin ... c'est tout bidon... :aie:


bon, c'est bien de vouloir comprendre ... mais vouloir comprendre une méthode qui n'est pas bonne ... c'est une perte de temps.

utilise ma correction ou la fonction CopyFile.

Merci pour tes recherches et remarque, petit bidouilleur dans le développement je vais essayer de comprendre toutes remarques et comprendre aussi tes propositions. Je te ferais part de mes réflexions et résultat dans les jours prochains. Mon objectif étant d'avoir mes petites applications écrites sous lazarus et linux transposable simplement sous XP au chemin près.
Bonnes fêtes et encore merci.

Après de nombreux essais car la function proposée me donnait un résultat identique message Unable to open file et le chemin concerné.
Alors j'ai essayé de copier un fichier texte ordinaire issu d'openoffice et là pas de problème. Nouvel essai avec le fichier de ma base Sqlite terminaison sdb et cela en direct sans ouverture de la base par mon application, juste une copie de fichiers d'un répertoire à l'autre et toujours pas de problème, nouvel essai en ayant recopié le fichier de ma base mais en changeant la terminaison mais avec toujours le fichier *.sbd utilisé par mon application pas de problème non plus, mais aussitôt que le fichier à copier est le même que celui utilisé par Slite dans mon application j'ai le défaut même si je change la terminaison.
Donc mon problème est en liaison avec sqlite.
J'ai désactivé toutes les tables mais c'est pareil, quand à fermer la base je ne sais pas encore le faire.
Mais je vais chercher.
Voila où j'en suis, mais c'est étrange que sous linux et fedora 10 je n'ai pas ce problème.

oui il faut désactiver la base avant.

si tu utilise des composants, essaye avec des fonctions du genre :

Close, Deactivate, CloseBase, ...

ou propriété Active/Enabled

Oui c'est bien avec un base Sqlite que le système se bloque, j'ai fait l'essai avec une table dbase et là pas de problème. Je vais essayer de trouver la commande qui retire une base Sqlite de la mémoire.
Donc A+

pense à regarder au niveau de la connexion, parfois en cas de connexion persistante, le fichier de base n'est libéré réellement qu'en redémarrant le système.

dans les composants, l'ouverture du fichier peut se faire à la simple assignation du "filename" dans le composant de BDD.

donc tu peux aussi tester en vidant le nom de fichier dans le composant de connexion.

J'ai trouvé une solution et un nouveau problème.
La solution, en cherchant quelle fonction pouvait être associée à ma base qui se trouve dans un datamodule du nom de data j'ai trouvé la function free
Donc avant de passer la commande de copie j'ai inscrit la commande data.free.

Mais j'ai trouvé un autre problème facile à contourné mais que j'ai déjà trouvé dans le passé avec delphi 4 c'est que dans certains cas l'exécution depuis l'IDE ne se passe pas bien, comme sous ce delphi la commande qui vide une table et là même problème avec la copie si lazarus.exe est chargé l'exécution de la copie se termine toujours par le même message. En exécution depuis le programme compilé pas de problème.
Donc sauf si ma commande n'est pas correcte ou peut créer d'autres problèmes on peut considérer l'affaire close en dehors de l'exécution depuis l'EDI.
Merci encore A+