1. Accueil
  2. Delphi / Pascal
  3. Sources Delphi / Pascal
  4. Sources Fichier / Disque
  5. Ficlock : lockez les fichiers

Ficlock : lockez les fichiers

0/5 (7 avis)

Vue 6 017 fois - Téléchargée 1 014 fois

Télécharger le projet
Commenter

Description

Hello
Petite contribution avec cet exe capable de "locker/prendre la main" sur des fichier.
Je m'en sert pour faire des tests d'écriture.

Source / Exemple : 


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls, ExtCtrls, ComCtrls, Tabs, ShellCtrls,
  CheckLst, CheckListBoxWST, ShellApi, Menus;

type
  TFormMain = class(TForm)
    OpenDialog: TOpenDialog;
    ChkLock1: TCheckBox;
    btBrowse: TBitBtn;
    ListFiles: TCheckListBox;
    StatusBar: TStatusBar;
    PopupMenu: TPopupMenu;
    Toutsupprimer: TMenuItem;
    Supprimerlescochs1: TMenuItem;
    Supprimerlesnoncochs1: TMenuItem;
    procedure btBrowseClick(Sender: TObject);
    procedure ListFilesClickCheck(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ChkLock1Click(Sender: TObject);
    procedure ListFilesKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure TraiteMessage(var Msg: TMsg; var Handled: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ToutsupprimerClick(Sender: TObject);
  private
    { Déclarations privées }
    procedure MajStatusBar;
  public
    { Déclarations publiques }
  end;

var
  FormMain: TFormMain;
  F: array of HFILE;
  LblCoche: array[boolean] of string = ('Cocher tout', 'Décocher tout');

implementation

{$R *.dfm}

procedure TFormMain.btBrowseClick(Sender: TObject);
begin
  if OpenDialog.Execute then
  if ListFiles.Items.IndexOf(OpenDialog.FileName)=-1 then
    ListFiles.Items.Add(OpenDialog.FileName);
  MajStatusBar;
end;

procedure TFormMain.ListFilesClickCheck(Sender: TObject);
var X: Integer;
    Tmp: OFSTRUCT;
begin
  SetLength(F, 0);
  for X:=0 to ListFiles.Count-1 do
  if ListFiles.Checked[X] then
  begin
    SetLength(F, Length(F)+1);
    try
      F[X]:= OpenFile(PChar(ListFiles.Items.Strings[X]), Tmp, OF_READWRITE);
    except
      on E:Exception do
      begin
        MessageDlg('Impossible d''ouvrir le fichier '+ListFiles.Items.Strings[X], mtError, [mbOK], 0);
        ListFiles.Checked[X]:= False;
      end;
    end;
  end
  else
  begin
    try
      if F[X] <> 0 then
        CloseHandle(F[X]);
    except
    //
    end;
  end;
  MajStatusBar;
end;

procedure TFormMain.TraiteMessage(var Msg: TMsg; var Handled: Boolean);
var
  NombreDeFichiers, Size, i:integer;
  NomDuFichierStr:string;
  NomDuFichier:array[0..255] of char;
begin
  if Msg.message=WM_DROPFILES then
  begin
    NombreDeFichiers:= DragQueryFile(Msg.wParam, $FFFFFFFF, NomDuFichier, SizeOf(NomDuFichier));
    for i:=0 to NombreDeFichiers-1 do
    begin
      Size:= DragQueryFile(Msg.wParam, i, NomDuFichier, SizeOf(NomDuFichier));
      NomDuFichierStr:=NomDuFichier;
      if ListFiles.Items.IndexOf(NomDuFichierStr)=-1 then
        ListFiles.Items.Add(NomDuFichierstr);
    end;
  end;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  FillChar(F, SizeOf(F), 0);
  DragAcceptFiles(ListFiles.handle, True);
  Application.OnMessage := TraiteMessage;
  if FileExists(ChangeFileExt(Application.ExeName, '.lst')) then
    ListFiles.Items.LoadFromFile(ChangeFileExt(Application.ExeName, '.lst'));
end;

procedure TFormMain.ChkLock1Click(Sender: TObject);
var X: Integer;
begin
  ChkLock1.Caption:= LblCoche[ChkLock1.Checked];
  for X:=0 to ListFiles.Count-1 do
    ListFiles.Checked[X]:= ChkLock1.Checked;
  ListFilesClickCheck(nil);
end;

procedure TFormMain.ListFilesKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key=46) and (ListFiles.ItemIndex>-1) then
  begin
    try
      if ListFiles.Checked[ListFiles.ItemIndex] then
        CloseHandle(F[ListFiles.ItemIndex]);
      ListFiles.Items.Delete(ListFiles.ItemIndex);
      MajStatusBar;
    except
      on E:Exception do MessageDlg('Impossible de libérer le fichier '+ListFiles.Items[ListFiles.ItemIndex], mtError, [mbOK], 0);
    end;
  end;
end;

procedure TFormMain.MajStatusBar;
var X, Nb: Integer;
begin
  Nb:= 0;
  for X:=0 to ListFiles.Count-1 do
  if ListFiles.Checked[X] then
    Inc(Nb);
  if ListFiles.Count>0 then
       StatusBar.SimpleText:= ' '+IntToStr(Nb)+' fichier(s) locké(s) sur '+IntToStr(ListFiles.Count)+' fichier(s)'
  else StatusBar.SimpleText:= StatusBar.Hint;
end;

procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SetLength(F, 0);
  ListFiles.Items.SaveToFile(ChangeFileExt(Application.ExeName, '.lst'));
end;

procedure TFormMain.ToutsupprimerClick(Sender: TObject);
var X: Integer;
begin
  ListFiles.Items.BeginUpdate;
  for X:= ListFiles.Count-1 downto 0 do
  begin
    try
      case TMenuItem(Sender).Tag of
      1: begin // tout
        if ListFiles.Checked[X] then
          CloseHandle(F[X]);
        ListFiles.Items.Delete(X);
      end;
      2: begin // coche
        if ListFiles.Checked[X] then
        begin
          CloseHandle(F[X]);
          ListFiles.Items.Delete(X);
        end;
      end;
      3: begin // non coche
        if not ListFiles.Checked[X] then
          ListFiles.Items.Delete(X);
      end;
      end;
    except
      on E:Exception do MessageDlg('Impossible de libérer le fichier '+ListFiles.Items[X], mtError, [mbOK], 0);
    end;
  end;
  ListFiles.Items.EndUpdate;
  MajStatusBar;
end;

end.

Conclusion :


Ouvert à vos critiques :)
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire Commentaires
JulioDelphi
Messages postés
2226
Date d'inscription
dimanche 5 octobre 2003
Statut
Modérateur
Dernière intervention
18 novembre 2010
 14
22 déc. 2009 à 09:05
Il est vrai, merci, là j'ai fait "comme le soft du boulot" (ho lala le boulot) puisque son but est de "faire comme le soft du boulot sans le lancer" ^^
Mais merci !
Bacterius
Messages postés
3792
Date d'inscription
samedi 22 décembre 2007
Statut
Membre
Dernière intervention
3 juin 2016
 9
22 déc. 2009 à 01:26
Sinon il y a aussi la fonction LockFile. C'est le même principe mais en moins contraignant que de passer par OpenFile (c'est une API spécialisée).
http://msdn.microsoft.com/en-us/library/aa365202(VS.85).aspx

Cordialement, Bacterius !
JulioDelphi
Messages postés
2226
Date d'inscription
dimanche 5 octobre 2003
Statut
Modérateur
Dernière intervention
18 novembre 2010
 14
14 déc. 2009 à 16:14
"Il existe une clé pour toute serrure" : Oui je sais :)
Le but ici n'est pas de locker à vie un fichier, mais déjà pour savoir un minimum utiliser OpenFile/CloseFile, savoir à quoi ça sert de locker puis de mon côté au boulot, le soft principal fait des accès à des .ini qui peuvent être lockés et posent donc problème. Avec cet utilitaire, je simule le lockage par le soft X ou Y ou Z.
Bien sur, ma porte fermée peut être ouverte :)
Nassmaster
Messages postés
9
Date d'inscription
jeudi 3 janvier 2008
Statut
Membre
Dernière intervention
12 novembre 2009
14 déc. 2009 à 15:53
Bonjour,
merci ton code est intéressant mais malheureusement il existe pas mal d'utilitaires capable de déverrouiller les fichier ...

Cordialement,
cs_Slander
Messages postés
26
Date d'inscription
lundi 19 janvier 2004
Statut
Membre
Dernière intervention
14 décembre 2009
14 déc. 2009 à 14:00
Bonjour à toutes et à tous,

@JulioDelphi: Ahh ! ok je vois maintenant... Merci de cette précision.

Bonne journée

Slander
Afficher les 7 commentaires
S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (JulioDelphi)