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

Version imprimable

04/01/2011, 14h25
khayyam90

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 ?

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

14/01/2011, 20h38
Montor

Aussi un truc de genre

Code:

GetFileAttributes(PChar(Filename))<>INVALID_FILE_ATTRIBUTES

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

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;

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;

03/01/2020, 11h30
Jeffem

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

Bonjour,
c'est impossible. En voici la preuve :

Code:

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

13/01/2020, 11h27
ShaiLeTroll

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 !

Bonjour,

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

Code:

1
2
3
4
5
6
type
  foNotFound    = $00;
  foNotReadable = $01;
  foNotWritable = $02;
  foReadable    = $04;
  foWritable    = $08;

J'ai les erreurs suivantes :

Code:

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.

14/01/2020, 14h16
tourlourou

essaye const au lieu de type
15/01/2020, 12h20
oneDev

Merci, je comprends mieux le code du coup !