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