quarta-feira, 20 de outubro de 2010

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 ;)

Nenhum comentário:

Postar um comentário

Postagens populares

Marcadores

delphi (60) C# (31) poo (21) Lazarus (19) Site aos Pedaços (15) sql (13) Reflexões (10) .Net (9) Humor (9) javascript (9) ASp.Net (8) api (8) Básico (6) Programação (6) ms sql server (5) Web (4) banco de dados (4) HTML (3) PHP (3) Python (3) design patterns (3) jQuery (3) livros (3) metaprogramação (3) Ajax (2) Debug (2) Dicas Básicas Windows (2) Pascal (2) games (2) linguagem (2) música (2) singleton (2) tecnologia (2) Anime (1) Api do Windows (1) Assembly (1) Eventos (1) Experts (1) GNU (1) Inglês (1) JSON (1) SO (1) datas (1) developers (1) dicas (1) easter egg (1) firebird (1) interfaces (1) introspecção (1) memo (1) oracle (1) reflexão (1)