Obtendo atributos de arquivos com o Lazarus

Como saber se um arquivo é oculto, de sistema, somente leitura e tal? Como saber a data de criação e última alteração de um arquivo?

E para saber se é arquivo, diretório ou unidade?

Criamos essa pequena classe no Lazarus (e por extensão Delphi) onde você passa um arquivo qualquer e ela te identifica quais são os atributos e ainda pode mudar alguns dos atributos em runtime.

A classe ainda não está completa, a idéia é expandi-la, mas ela já é bastante funcional. É muito mais fácil e intuitivo usar uma classe do que a API do Windows.

A classe:
unit uLazFile;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, windows;

type

  { TLazFile }

  TLazFile = class
  private
    FFileName: string;
    function Attributes: word;
    procedure Verify;
    //gets
    function GetFileName: string;
    function GetAttributeFile: boolean;
    function GetAttributeHidden: boolean;
    function GetAttributeSystem: boolean;
    function GetAttributeReadOnly: boolean;
    function GetAttributeDirectory: boolean;
    function GetAttributeVolume: boolean;

    function GetFileCreationDate: TDateTime;
    function GetLastFileAccessDate: TDateTime;
    function GetLastWriteFileDate: TDateTime;
    function GetFileSize: int64;
    //sets
    procedure SetFileName(const value: string);
    procedure SetAttributeFile(const value: boolean);
    procedure SetAttributeHidden(const value: boolean);
    procedure SetAttributeSystem(const value: boolean);
    procedure SetAttributeReadOnly(const value: boolean);
  public
    constructor Create(const filename: string);   overload;
    constructor Create; overload;
  published
    property  AttributeFile: boolean read GetAttributeFile write SetAttributeFile;
    property  AttributeHidden: boolean read GetAttributeHidden write SetAttributeHidden;
    property  AttributeSystem: boolean read GetAttributeSystem write SetAttributeSystem;
    property  AttributeReadOnly: boolean read GetAttributeReadOnly write SetAttributeReadOnly;
    property  IsDirectory: boolean read GetAttributeDirectory;
    property  IsVolume: boolean read GetAttributeVolume;
    property  FileName: string read GetFileName write SetFileName;

    property  FileCreationDate: TDateTime read GetFileCreationDate;
    property  LastFileAccessDate: TDateTime read GetLastFileAccessDate;
    property  LastWriteFileDate: TDateTime read GetLastWriteFileDate;
    property  FileSize: int64 read GetFileSize;
  end;


implementation

{ TLazFile }

Function WinToDosTime (Var Wtime : TFileTime;var DTime:longint):longbool;
var
  lft : TFileTime;
begin
  WinToDosTime:=FileTimeToLocalFileTime(WTime,lft) and
                FileTimeToDosDateTime(lft,Longrec(Dtime).Hi,LongRec(DTIME).lo);
end;

function TLazFile.Attributes: word;
begin
     Verify;
     Result := FileGetAttr(FFileName);
end;

procedure TLazFile.Verify;
begin
       if (FFileName = '') then
        raise Exception.Create('File Inexistente.');
end;

function TLazFile.GetFileName: string;
begin
  Result := FFileName;
end;

function TLazFile.GetAttributeFile: boolean;
begin
     Result := (Attributes and faArchive) = faArchive
end;

function TLazFile.GetAttributeHidden: boolean;
begin
     Result := (Attributes and faHidden) = faHidden
end;

function TLazFile.GetAttributeSystem: boolean;
begin
     Result := (Attributes and faSysFile) = faSysFile;
end;

function TLazFile.GetAttributeReadOnly: boolean;
begin
     Result := (Attributes and faReadOnly) = faReadOnly;
end;

function TLazFile.GetAttributeDirectory: boolean;
begin
     Result := (Attributes and faDirectory) = faDirectory;
end;

function TLazFile.GetAttributeVolume: boolean;
begin
     Result := (Attributes and faVolumeId) = faVolumeId;
end;

function TLazFile.GetFileCreationDate: TDateTime;
var
  Handle: THandle;
  FindData: TWin32FindData;
  temp: Longint;
begin
  Handle := FindFirstFile(Pchar(FFileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
    begin
      Windows.FindClose(Handle);
        If WinToDosTime(FindData.ftCreationTime,temp) then
          Result := FileDateToDateTime(temp);
    end
    else
        Result := 0;
end;

function TLazFile.GetLastFileAccessDate: TDateTime;
var
  Handle: THandle;
  FindData: TWin32FindData;
  temp: Longint;
begin
  Handle := FindFirstFile(Pchar(FFileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
    begin
      Windows.FindClose(Handle);
        If WinToDosTime(FindData.ftLastAccessTime,temp) then
          Result := FileDateToDateTime(temp);
    end
    else
        Result := 0;

end;

function TLazFile.GetLastWriteFileDate: TDateTime;
var
  Handle: THandle;
  FindData: TWin32FindData;
  temp: Longint;
begin
  Handle := FindFirstFile(Pchar(FFileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
    begin
      Windows.FindClose(Handle);
        If WinToDosTime(FindData.ftLastWriteTime,temp) then
          Result := FileDateToDateTime(temp);
    end
    else
        Result := 0;

end;



function TLazFile.GetFileSize: int64;
var
  Handle: THandle;
  FindData: TWin32FindData;
begin
  Handle := FindFirstFile(Pchar(FFileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
    begin
      Windows.FindClose(Handle);
      Result := FindData.nFileSizeHigh;
      Result := Result shl 32;
      Result := Result + FindData.nFileSizeLow;
    end;
end;


procedure TLazFile.SetFileName(const value: string);
begin
  FFileName:= value;
end;

procedure TLazFile.SetAttributeFile(const value: boolean);
begin
     Verify;
     if value then
        FileSetAttr(FFileName, Attributes or faArchive)
     else
        FileSetAttr(FFileName, Attributes and not faArchive);
end;

procedure TLazFile.SetAttributeHidden(const value: boolean);
begin
     Verify;
     if value then
        FileSetAttr(FFileName, Attributes or faHidden)
     else
         FileSetAttr(FFileName, Attributes and not faHidden)

end;

procedure TLazFile.SetAttributeSystem(const value: boolean);
begin
     Verify;
     if value then
        FileSetAttr(FFileName, Attributes or faSysFile)
     else
         FileSetAttr(FFileName, Attributes and not faSysFile)
end;

procedure TLazFile.SetAttributeReadOnly(const value: boolean);
begin
     Verify;
     if value then
        FileSetAttr(FFileName, Attributes or faReadOnly)
     else
         FileSetAttr(FFileName, Attributes and not faReadOnly)
end;

constructor TLazFile.Create(const filename: string);
begin

  FFileName:= filename;
end;

constructor TLazFile.Create;
begin

end;

end.



Modo de usar
unit Unit1; 

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, uLazFile;

type

  { TForm1 }

  TForm1 = class(TForm)
    btLeSomenteLeitura: TButton;
    btLeSistema: TButton;
    btLeEscondido: TButton;
    btLeArquivo: TButton;
    btSetaSomenteLeitura: TButton;
    btSetaSistema: TButton;
    btSetaEscondido: TButton;
    btSetaArquivo: TButton;
    btVerificaDiretorio: TButton;
    btVerificaUnidade: TButton;
    btInformacoes: TButton;
    edArquivo: TEdit;
    Label1: TLabel;
    procedure btInformacoesClick(Sender: TObject);
    procedure btLeArquivoClick(Sender: TObject);
    procedure btLeEscondidoClick(Sender: TObject);
    procedure btLeSistemaClick(Sender: TObject);
    procedure btLeSomenteLeituraClick(Sender: TObject);
    procedure btSetaArquivoClick(Sender: TObject);
    procedure btSetaEscondidoClick(Sender: TObject);
    procedure btSetaSistemaClick(Sender: TObject);
    procedure btSetaSomenteLeituraClick(Sender: TObject);
    procedure btVerificaDiretorioClick(Sender: TObject);
    procedure btVerificaUnidadeClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
    Arquivo: TLazFile;
  end; 

var
  Form1: TForm1; 

implementation

{ TForm1 }

procedure TForm1.btLeSomenteLeituraClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  ShowMessage(BoolToStr(Arquivo.AttributeReadOnly));
end;

procedure TForm1.btSetaArquivoClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  Arquivo.AttributeFile:= not Arquivo.AttributeFile;
end;

procedure TForm1.btSetaEscondidoClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  Arquivo.AttributeHidden:= not Arquivo.AttributeHidden;
end;

procedure TForm1.btSetaSistemaClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  Arquivo.AttributeSystem:= not Arquivo.AttributeSystem;
end;

procedure TForm1.btSetaSomenteLeituraClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  Arquivo.AttributeReadOnly:= not Arquivo.AttributeReadOnly;
end;



procedure TForm1.btVerificaDiretorioClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  ShowMessage(BoolToStr(Arquivo.IsDirectory));
end;

procedure TForm1.btVerificaUnidadeClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  ShowMessage(BoolToStr(Arquivo.IsVolume));
end;

procedure TForm1.btLeSistemaClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  ShowMessage(BoolToStr(Arquivo.AttributeSystem));
end;

procedure TForm1.btLeEscondidoClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  ShowMessage(BoolToStr(Arquivo.AttributeHidden));
end;

procedure TForm1.btLeArquivoClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  ShowMessage(BoolToStr(Arquivo.AttributeFile));
end;

procedure TForm1.btInformacoesClick(Sender: TObject);
begin
  Arquivo.FileName := edArquivo.Text;
  ShowMessage(
              'Data Criação ' + DateTimeToStr(Arquivo.FileCreationDate) + #13#10 +
              'Data Modificação ' + DateTimeToStr(Arquivo.LastWriteFileDate) + #13#10 +
              'Data Ultimo Acesso ' + DateTimeToStr(Arquivo.LastFileAccessDate) + #13#10 +
              'Tamanho ' + IntToStr(Arquivo.FileSize) + #13#10
  );

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     Arquivo := TLazFile.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Arquivo.Free;
end;

initialization
  {$I unit1.lrs}

end.




Download

Have fun ;)

Comentários

Postagens mais visitadas deste blog

Detectar o encoding de um arquivo para não corromper ao transformá-lo

erro "ora-12154: tns: não foi possível resolver o identificador de conexão especificado"

Quebras de linha no Delphi 2010