Lenguaje de programación Borland Delphi
Os mostramos una función que permite modificar cualquier atributo de un fichero: oculto, sistema, sólo lectura, permitir indexar por Index Server, listo para archivar históricamente, normal, temporal, fuera de línea (offline).
La función para cambiar el atributo de un fichero (activar/desactivar)
function cambiarAtributo (fichero : string; atributo : string;
activar : boolean) : boolean;
var
resultado : boolean;
atributos: Cardinal;
atributoNumero : DWORD;
begin
resultado := false;
atributos := GetFileAttributes(PChar(fichero));
if atributo = 'Oculto' then
atributoNumero := FILE_ATTRIBUTE_HIDDEN;
if atributo = 'Sistema' then
atributoNumero := FILE_ATTRIBUTE_SYSTEM;
if atributo = 'Sólo lectura' then
atributoNumero := FILE_ATTRIBUTE_READONLY;
if atributo = 'Listo para archivar' then
atributoNumero := FILE_ATTRIBUTE_ARCHIVE;
if atributo = 'Fuera de línea' then
atributoNumero := FILE_ATTRIBUTE_OFFLINE;
if atributo = 'Temporal' then
atributoNumero := FILE_ATTRIBUTE_TEMPORARY;
if atributo = 'Normal' then
atributoNumero := FILE_ATTRIBUTE_NORMAL;
if atributo = 'No indexar' then
atributoNumero := $00002000;
if activar then
begin
if (atributos and atributoNumero) > 0 then
Result := false
else
resultado := SetFileAttributes (PChar(fichero), atributos + atributoNumero);
end
else
begin
if (atributos and atributoNumero) > 0 then
resultado := SetFileAttributes (PChar(fichero), atributos - atributoNumero)
else
Result := false;
end;
Result := resultado;
end;
Ejemplo de uso de la función para cambiar los atributos de un fichero
Necesitaremos los siguientes componentes en el formulario:
- TEdit (txtFichero) que contendrá la ruta y nombre del fichero al que se le cambiará el atributo.
- TCheckBox (opActivar) para indicar si activamos o no el atributo.
- TComboBox (lsAtributos): que contendrá la siguiente lista de atributos (propiedad "Items"):
- Sólo lectura.
- Oculto.
- Listo para archivar.
- No indexar.
- Sistema.
- Fuera de línea.
- Temporal.
- Normal.
procedure TformMenuPrincipal.bCambiarClick(Sender: TObject);
begin
if FileExists(txtFichero.Text) then
begin
if cambiarAtributo(txtFichero.Text, lsAtributos.Text, opActivar.Checked) then
MessageDlg('El atributo [' + lsAtributos.Text +
'] ha sido cambiado correctamente para el fichero:' +
chr(13) + txtFichero.Text,
mtInformation, [mbok], 0)
else
MessageDlg('El atributo [' + lsAtributos.Text +
'] no ha podido ser cambiado.',
mtWarning, [mbok], 0);
end
end;
Publicado el: 2009-10-05