Utilizamos cookies propias y de terceros. [Más información sobre las cookies].
Política de cookies
Proyecto AjpdSoft

· Inicio
· Buscar
· Contactar
· Cookies
· Descargas
· Foros
· Historia
· Nosotros
· Temas
· Top 10
· Trucos
· Tutoriales
· Wiki
Comprobar si un fichero está siendo usado por una aplicación (Delphi)
Lenguaje de programación Borland Delphi

Os mostramos el código fuente completo en Borland (ahora Codegear) Delphi 6 para comprobar si un fichero está siendo ejecutado (abierto en modo exclusivo) por otra aplicación. La función ficheroEnUso devolverá True si el fichero pasado como parámetro está abierto actualmente. Esta función funcionará con ficheros de bases de datos (mdb de Access), ficheros ejecutables que estén abiertos, ficheros del sistema en uso (pagefile.sys, ntdetect.com, etc.) y cualquier fichero que sea abierto en modo exclusivo. Por supuesto, esta función no funcionará con ficheros de texto abiertos por el bloc de notas (u otro editor) pues estas aplicaciones no suelen abrir los ficheros en modo exclusivo. En cambio, si abrimos un fichero de este tipo (de texto) con Microsoft Office Word si que lo detectará como en uso. Con lo cual hay que tener en cuenta que dependiendo de la aplicación que abra un fichero éste quedará en uso o no.


unit UnidadFicheroUso;

interface

uses
  Windows, Messages, SysUtils, Variants,
  Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, StrUtils;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    txtFichero: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function ficheroEnUso (fichero : string) : boolean;
var
  HFileRes : HFILE;
  Res : string[6];
begin
  Result := False;

  HFileRes := CreateFile (pchar (fichero),
      GENERIC_READ or GENERIC_WRITE, 0,
      nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  Result := (HFileRes = INVALID_HANDLE_VALUE);
  if not Result then
    CloseHandle (HFileRes);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if FileExists(txtFichero.Text) then
  begin
    if ficheroEnUso (txtFichero.Text) then
      ShowMessage('El fichero ESTÁ en uso.')
    else
      ShowMessage ('El fichero NO está en uso.');
  end
  else
    ShowMessage('El fichero indicado no existe.');
end;

end.
Para que este código funcione se necesitará en el formulario un TEdit llamado "txtFichero" y un TButton llamado "Button1". En el evento "OnClick" del TButton pondremos el código que se indica en:

procedure TForm1.Button1Click(Sender: TObject);




Publicado el: 2009-10-23

Visita nuestro nuevo sitio web con programas y contenidos actualizados: Proyecto A