Publicité
+ Répondre à la discussion
Affichage des résultats 1 à 6 sur 6
  1. #1
    Responsable Portail

    Avatar de khayyam90
    Homme Profil pro
    Ingénieur développement logiciels
    Inscrit en
    janvier 2004
    Messages
    10 097
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 29
    Localisation : France, Bas Rhin (Alsace)

    Informations professionnelles :
    Activité : Ingénieur développement logiciels
    Secteur : High Tech - Éditeur de logiciels

    Informations forums :
    Inscription : janvier 2004
    Messages : 10 097
    Points : 40 495
    Points
    40 495

    Par défaut [Delphi]Tester si fichier déjà ouvert

    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 ?
    Responsable du Portail Developpez.
    Mes tutoriels Algo, Web, C++, PHP - Mon CV

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

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

    Informations forums :
    Inscription : décembre 2006
    Messages : 720
    Points : 819
    Points
    819

    Par défaut

    Bonjour,

    Pour ma part, j'utilise cette fonction (qui peut surement être perfectionné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
    { ============================================================================== }
    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 émérite Avatar de Montor
    Homme Profil pro
    Inscrit en
    avril 2008
    Messages
    863
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Algérie

    Informations forums :
    Inscription : avril 2008
    Messages : 863
    Points : 801
    Points
    801

    Par défaut

    Aussi un truc de genre
    Code :
    GetFileAttributes(PChar(Filename))<>INVALID_FILE_ATTRIBUTES

  4. #4
    Rédacteur/Modérateur
    Avatar de Andnotor
    Inscrit en
    septembre 2008
    Messages
    3 377
    Détails du profil
    Informations forums :
    Inscription : septembre 2008
    Messages : 3 377
    Points : 5 450
    Points
    5 450

    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 :
    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 Expert Avatar de Dr.Who
    Inscrit en
    septembre 2009
    Messages
    980
    Détails du profil
    Informations personnelles :
    Âge : 35

    Informations forums :
    Inscription : septembre 2009
    Messages : 980
    Points : 1 162
    Points
    1 162

    Par défaut

    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
     
     
    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 émérite Avatar de BuzzLeclaire
    Homme Profil pro
    Dev/For/Vte/Ass
    Inscrit en
    août 2008
    Messages
    1 527
    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 527
    Points : 920
    Points
    920

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

Liens sociaux

Règles de messages

  • Vous ne pouvez pas créer de nouvelles discussions
  • Vous ne pouvez pas envoyer des réponses
  • Vous ne pouvez pas envoyer des pièces jointes
  • Vous ne pouvez pas modifier vos messages
  •