attrpas.pas

特别方便的工具程序

unit AttrPas;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  ComOBJ, Dialogs, ExtCtrls, ComCtrls, ShellCtrls, DB, ADODB, Grids,
  DBGridEh, ActnList;

type
  TAttrForm = class(TForm)
    File1: TShellTreeView;
    Splitter1: TSplitter;
    SB: TStatusBar;
    ToolBase: TADOConnection;
    MYFile: TADOQuery;
    DBGridEh1: TDBGridEh;
    MYFileS: TDataSource;
    ActionList1: TActionList;
    Action1: TAction;
    procedure File1Change(Sender: TObject; Node: TTreeNode);
    procedure File1KeyPress(Sender: TObject; var Key: Char);
    procedure File1Editing(Sender: TObject; Node: TTreeNode;
      var AllowEdit: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Action1Execute(Sender: TObject);
  private
    { Private declarations }
    procedure CompressData(S: string);
    procedure LoadFile(D: string);
  public
    { Public declarations }
  end;

var
  AttrForm: TAttrForm;

implementation

uses Xeduser;

{$R *.dfm}

procedure TAttrForm.CompressData(S: string);
var
  DAO: OLEVariant;
  T: string;
begin
  Screen.Cursor := crHourGlass;
  ToolBase.Close;
  DAO := CreateOleObject('DAO.DBEngine.36');
  T := ExePath + 'TempFile.MDB';
  S := ExePath + S;
  try
    DAO.CompactDatabase(S, T, '', 0, '');
    //DAO.RepairDataBase(S); 修复数据库
    DeleteFile(S);
    RenameFile(T, S);
  except
    on E: Exception do begin
      Screen.Cursor := crDefault;
      ShowMessage(E.Message);
    end;
  end;
  Screen.Cursor := crDefault;
end;

function CovTime(FD: _FileTime): TDateTime;
var
  TCT: _SystemTime;
  Tmp: _FileTime;
begin
  FileTimeToLocalFileTime(FD, Tmp);
  FileTimeToSystemTime(Tmp, TCT);
  Result := SystemTimeToDateTime(TCT);
end;

procedure TAttrForm.LoadFile(D: string);
var
  FF: TSearchRec;
  RR: integer;
  Item: TListItem;
  FT: TDateTime;
  FS: string;
  HH: integer;
begin
  ToolBase.Execute('DElete From MYFile');
  CompressData('FileBase');
  MYFile.Open;
  MYFile.DisableControls;
  if D[Length(D)] <> '\' then D := D + '\';
  RR := FindFirst(D + '*.*', faAnyFile, FF);
  while RR = 0 do begin
    if (FF.Name[1] <> '.') then begin
        HH := FF.Attr;
{
        faReadOnly  = $00000001 platform;
        faHidden    = $00000002 platform;
        faSysFile   = $00000004 platform;
        faVolumeID  = $00000008 platform;
        faDirectory = $00000010;
        faArchive   = $00000020 platform;
        faAnyFile   = $0000003F;
}
        FS := '';
        if HH and $01 > 0 then FS := FS + 'R';
        if HH and $02 > 0 then FS := FS + 'H';
        if HH and $04 > 0 then FS := FS + 'S';
        if HH and $08 > 0 then FS := FS + 'V';
        if HH and $10 > 0 then FS := FS + 'D';
        if HH and $20 > 0 then FS := FS + 'A';
        FT := CovTime(FF.FindData.ftCreationTime);
        MYFile.Append;
        MYFile['文件名称'] := FF.Name;
        MYFile['文件大小'] := IntToStr(FF.Size);
        MYFile['文件属性'] := FS;
        MYFile['文件日期'] := DateTimeToStr(FT);
        MYFile.Post;
      end;
    RR := FindNext(FF);
  end;
  MYFile.First;
  MYFile.EnableControls;
  SB.Panels[1].Text := '文件数：' + IntToStr(MYFile.RecordCount);
  FindClose(FF);
end;
{
  Result := 0;
  Path := ExtractFilePath(ADirectory);
  Ret := Sysutils.FindFirst(ADirectory, faAnyFile, Dir);

  if Ret ?? NO_ERROR then
  exit;
  try
  while ret=NO_ERROR do
  begin
  inc(Result, Dir.Size);
  if (Dir.Attr in [faDirectory]) and (Dir.Name[1] ?? '.') then
  Inc(Result, GetDirectorySize(Path + Dir.Name + '\*.*'));
  Ret := Sysutils.FindNext(Dir);
  end;
  finally
  Sysutils.FindClose(Dir);
  end;
end;
}

procedure TAttrForm.File1Change(Sender: TObject; Node: TTreeNode);
var
  N: integer;
  P: string;
begin
  P := File1.Path;
  if DirectoryExists(P) then begin
    SB.Panels[0].Text := P;
    LoadFile(P);
  end else begin
    SB.Panels[0].Text := '';
  end;
end;

procedure TAttrForm.File1KeyPress(Sender: TObject; var Key: Char);
begin
  Key := #0;
end;

procedure TAttrForm.File1Editing(Sender: TObject; Node: TTreeNode;
  var AllowEdit: Boolean);
begin
  AllowEdit := False;
end;

procedure TAttrForm.FormCreate(Sender: TObject);
begin
  LoadSite(Self, '文件属性');
end;

procedure TAttrForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  MYFile.Close;
  SaveSite(Self, '文件属性');
end;

procedure TAttrForm.Action1Execute(Sender: TObject);
begin
  Close;
end;

end.