IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Rédacteur

    Avatar de khayyam90
    Homme Profil pro
    Chef de projet NTIC
    Inscrit en
    janvier 2004
    Messages
    10 383
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 35
    Localisation : France, Bas Rhin (Alsace)

    Informations professionnelles :
    Activité : Chef de projet NTIC
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : janvier 2004
    Messages : 10 383
    Points : 43 710
    Points
    43 710
    Par défaut Savoir si un fichier est déjà ouvert par une autre application
    Bonjour,

    Je vous propose un nouvel élément à utiliser : [Delphi]Tester si fichier déjà ouvert

    Tester si un fichier est déjà ouvert par une autre application.



    NOTES : Le principe de détection est basé sur un essai d'ouverture et le test du code d'erreur 32 indiquant une violation de partage.

    Qu'en pensez-vous ?

  2. #2
    Membre émérite
    Avatar de Charly910
    Homme Profil pro
    Ingénieur TP
    Inscrit en
    décembre 2006
    Messages
    1 795
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Ingénieur TP
    Secteur : Bâtiment Travaux Publics

    Informations forums :
    Inscription : décembre 2006
    Messages : 1 795
    Points : 2 618
    Points
    2 618
    Par défaut
    Bonjour,

    Pour ma part, j'utilise cette fonction (qui peut surement être perfectionnée) :

    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
    { ============================================================================== }
    function FichierOuvert(NomFichier : string; CodeRetour:Integer):Boolean;
    //Test si un fichier est ouvert ou indisponible
    // CodeRetour = 0 pas ouvert - 32 : violation de partage - sinon autre erreur
    Var
       F:TextFile;
    begin
      FichierOuvert := True ;
      // Test du fichier
      AssignFile(F,NomFichier);
      {$I-}
      Reset(F);
      {$I+}
      CodeRetour := IOResult ;
      Case IOResult Of
        // Pas d'erreur
        0 :Begin
             CloseFile(F);
             FichierOuvert := False ;
    //         ShowMessage('Le fichier existe et n''est pas ouvert.');
           End;
    //         L'erreur 32 est une violation de partage
        32:
           Begin
    //          ShowMessage('Le fichier est déjà ouvert.');
           End ;
      Else
        // Autre erreur
    //    ShowMessage('Erreur '+IntToStr(IOResult));
      End;
    End;
    A+

    Charly

  3. #3
    Membre éprouvé Avatar de Montor
    Homme Profil pro
    Autre
    Inscrit en
    avril 2008
    Messages
    879
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations professionnelles :
    Activité : Autre

    Informations forums :
    Inscription : avril 2008
    Messages : 879
    Points : 957
    Points
    957
    Par défaut
    Aussi un truc de genre
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    GetFileAttributes(PChar(Filename))<>INVALID_FILE_ATTRIBUTES

  4. #4
    Rédacteur/Modérateur
    Avatar de Andnotor
    Profil pro
    Inscrit en
    septembre 2008
    Messages
    5 048
    Détails du profil
    Informations personnelles :
    Localisation : Suisse

    Informations forums :
    Inscription : septembre 2008
    Messages : 5 048
    Points : 11 016
    Points
    11 016
    Par défaut
    Ce code ne dit pas que le fichier est déjà ouvert, mais qu'il peut l'être en écriture
    Un fichier ouvert en lecture ne sera pas détecté, à moins qu'il l'ait été en mode exclusif (fmShareExclusive).

    A noter aussi que Reset ne renvoi pas d'erreur sur un fichier ouvert en mode fmOpenRead or fmShareDenyWrite (Par contre Write se plante normalement !)

    Enfin une erreur autant dans le code de Nono40 que dans celui de Charly910 (mais en pire puisque le case ne fonctionne plus du tout) : IOResult ne peut être lu qu'une seule fois. Il est reseté après le premier appel !

    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
    var
       F :TextFile;
       IORes :integer;
     
    begin
      AssignFile(F, NomFichier);
      {$I-}
      Reset(F);
      {$I+}
      IORes := IOResult;
     
      case IORes of
        0 :; //Pas ouvert ou en lecture seule
        32:; //Ouvert en écriture ou exclusif
        else ShowMessage('Erreur ' +IntToStr(IORes));
      end;
    end;

  5. #5
    Membre éprouvé
    Avatar de Dr.Who
    Inscrit en
    septembre 2009
    Messages
    980
    Détails du profil
    Informations personnelles :
    Âge : 42

    Informations forums :
    Inscription : septembre 2009
    Messages : 980
    Points : 1 279
    Points
    1 279
    Par défaut
    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
     
     
    type
      foNotFound    = $00;
      foNotReadable = $01;
      foNotWritable = $02;
      foReadable    = $04;
      foWritable    = $08;
     
     
    function isOpenableFile(const aFileName: string): integer;
    var H: integer;
     
    begin
      if not FileExists(aFileName) then
      begin
        result := foNotFound;
        exit;
      end;
     
      H := FileOpen(aFileName, fmOpenRead);
      if H >= 0 then
      begin
        FileClose(H);
        result := result or foReadable;
      end
      else
        result := result or foNotReadable;
     
      H := FileOpen(aFileName, fmOpenWrite);
      if H >= 0 then
      begin
        FileClose(H);
        result := result or foWritable;
      end
      else
        result := result or foNotWritable;
    end;
    [ Sources et programmes de Dr.Who | FAQ Delphi | FAQ Pascal | Règlement | Contactez l'équipe ]
    Ma messagerie n'est pas la succursale du forum... merci!

  6. #6
    Membre éprouvé Avatar de BuzzLeclaire
    Homme Profil pro
    Dev/For/Vte/Ass
    Inscrit en
    août 2008
    Messages
    1 597
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Dev/For/Vte/Ass

    Informations forums :
    Inscription : août 2008
    Messages : 1 597
    Points : 1 109
    Points
    1 109
    Par défaut
    Salut,

    Sur mon programme pour empêcher d'ouvrir 2 fois l'application sur le même poste je fais ceci dans le DPR du programme.

    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
    var
    	H : THandle;
    	Erreur: Integer;
    begin
      SetLastError(NO_ERROR);
      H := CreateMutex(nil, False,'MONAPPLI');
      Erreur := GetLastError;
      if ( Erreur = ERROR_ALREADY_EXISTS ) or ( Erreur = ERROR_ACCESS_DENIED )
        then
        begin
        MessageDlg('MONAPPLI est déjà utilisé sur votre poste.'+#13+
        'Vous ne pouvez pas ouvrir 2 fois l''application.',mtInformation,[mbOK],0);
        CloseHandle(H);
        Exit;
      end;
     
    //...
     
    end;

  7. #7
    Futur Membre du Club
    Inscrit en
    mai 2006
    Messages
    4
    Détails du profil
    Informations forums :
    Inscription : mai 2006
    Messages : 4
    Points : 7
    Points
    7
    Par défaut [Delphi]Tester si fichier déjà ouvert
    Dans la proposition de Dr.Who, je suggère d'initialiser result à 0 lorsque le fichier existe. Sinon, result s'incrémente à chaque appel de la fonction.

  8. #8
    Membre émérite
    Avatar de Charly910
    Homme Profil pro
    Ingénieur TP
    Inscrit en
    décembre 2006
    Messages
    1 795
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France

    Informations professionnelles :
    Activité : Ingénieur TP
    Secteur : Bâtiment Travaux Publics

    Informations forums :
    Inscription : décembre 2006
    Messages : 1 795
    Points : 2 618
    Points
    2 618
    Par défaut
    Bonjour,
    c'est impossible. En voici la preuve :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    procedure TF_Princ.Button3Click(Sender: TObject);
    Var
      I : Integer ;
    begin
      I := isOpenableFile('D:\DESSIN\44304.jpg') ;
      ShowMessage('Result : '+IntToStr(I)) ;
      I := isOpenableFile('D:\DESSIN\6094672.jpg') ;
      ShowMessage('Result : '+IntToStr(I)) ;
      I := isOpenableFile('D:\DESSIN\44304.jpg') ;
      ShowMessage('Result : '+IntToStr(I)) ;
    end;
    I n'est pas incrémenté ..

    A+
    Charly

  9. #9
    Expert éminent sénior
    Avatar de ShaiLeTroll
    Homme Profil pro
    Développeur C++\Delphi
    Inscrit en
    juillet 2006
    Messages
    11 829
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 39
    Localisation : France, Seine Saint Denis (Île de France)

    Informations professionnelles :
    Activité : Développeur C++\Delphi
    Secteur : High Tech - Électronique et micro-électronique

    Informations forums :
    Inscription : juillet 2006
    Messages : 11 829
    Points : 20 635
    Points
    20 635
    Par défaut
    Une exécution en DEBUG ou en RELEASE peut différencier
    Result peut en RELEASE contenir une valeur aléatoire alors que c'est bcp plus rare en DEBUG
    Cela dépend du contexte mémoire et peut-être même d'options du compilateur, le warning n'est pas là pour rien !
    Aide via F1 - FAQ - Guide du développeur Delphi devant un problème - Pensez-y !
    Attention Troll Méchant !
    "Quand un homme a faim, mieux vaut lui apprendre à pêcher que de lui donner un poisson" Confucius
    Mieux vaut se taire et paraître idiot, Que l'ouvrir et de le confirmer !
    L'ignorance n'excuse pas la médiocrité !

    L'expérience, c'est le nom que chacun donne à ses erreurs. (Oscar Wilde)
    Il faut avoir le courage de se tromper et d'apprendre de ses erreurs

  10. #10
    Membre régulier Avatar de oneDev
    Homme Profil pro
    Développeur informatique
    Inscrit en
    mars 2019
    Messages
    84
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 41
    Localisation : France, Seine Maritime (Haute Normandie)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Transports

    Informations forums :
    Inscription : mars 2019
    Messages : 84
    Points : 111
    Points
    111
    Par défaut
    Bonjour,

    J'ai voulu tester le code de Dr Who, avec Delphi 7.
    J'ai une erreur avec le code suivant :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    type
      foNotFound    = $00;
      foNotReadable = $01;
      foNotWritable = $02;
      foReadable    = $04;
      foWritable    = $08;
    J'ai les erreurs suivantes :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    [Erreur] Main.pas(11): '..' attendu(e) mais ';' trouvé(e)
    [Erreur] Main.pas(12): '..' attendu(e) mais ';' trouvé(e)
    [Erreur] Main.pas(13): '..' attendu(e) mais ';' trouvé(e)
    [Erreur] Main.pas(14): '..' attendu(e) mais ';' trouvé(e)
    [Erreur] Main.pas(15): '..' attendu(e) mais ';' trouvé(e)
    Je ne vois pas comment corriger le code.

  11. #11
    Modérateur
    Avatar de tourlourou
    Homme Profil pro
    Biologiste ; Progr(amateur)
    Inscrit en
    mars 2005
    Messages
    3 539
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 57
    Localisation : France, Yvelines (Île de France)

    Informations professionnelles :
    Activité : Biologiste ; Progr(amateur)

    Informations forums :
    Inscription : mars 2005
    Messages : 3 539
    Points : 10 463
    Points
    10 463
    Billets dans le blog
    6
    Par défaut
    essaye const au lieu de type
    Delphi 5 Pro - Delphi 10.3.2 Rio Community Edition - CodeTyphon 6.90 sous Windows 10 ; CT 6.40 sous Ubuntu 18.04 (VM)
    . Ignorer la FAQ Delphi et les Cours et Tutoriels Delphi nuit gravement à notre code !

  12. #12
    Membre régulier Avatar de oneDev
    Homme Profil pro
    Développeur informatique
    Inscrit en
    mars 2019
    Messages
    84
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 41
    Localisation : France, Seine Maritime (Haute Normandie)

    Informations professionnelles :
    Activité : Développeur informatique
    Secteur : Transports

    Informations forums :
    Inscription : mars 2019
    Messages : 84
    Points : 111
    Points
    111
    Par défaut
    Merci, je comprends mieux le code du coup !

Discussions similaires

  1. Réponses: 6
    Dernier message: 07/07/2014, 13h13
  2. Tester si fichier est ouvert
    Par smoes94 dans le forum Qt
    Réponses: 2
    Dernier message: 22/06/2010, 19h23
  3. Tester si 1 fichier est ouvert
    Par Jeanvaljean44 dans le forum Macros et VBA Excel
    Réponses: 8
    Dernier message: 14/08/2008, 10h43
  4. tester si fichier ouvert
    Par nbelg27 dans le forum Access
    Réponses: 6
    Dernier message: 08/09/2005, 11h19
  5. Comment tester si fichier est ouvert ?
    Par fusef dans le forum Langage
    Réponses: 7
    Dernier message: 11/08/2004, 19h51

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo