⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 filepropfrm.pas

📁 MiniHex 1.1 源程序说明 “MiniHex11SrcSource”目录中的所有文件是MiniHex 1.1的主程序; “MiniHex11SrcControls”目录中的是该软件
💻 PAS
字号:
unit FilePropFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, ComCtrls, StdCtrls, Misc;

type
  TFileProp = record
    FileName: string;
    Size: Integer;
    DOSFileName: string;
    CreationTime: TSystemTime;
    LastWriteTime: TSystemTime;
    LastAccessTime: TSystemTime;
    Attr: Integer;
  end;

  TFilePropForm = class(TForm)
    PageControl1: TPageControl;
    NormalTabSheet: TTabSheet;
    FileIconImage: TImage;
    FileNameLabel: TLabel;
    Bevel1: TBevel;
    Label2: TLabel;
    Label3: TLabel;
    Bevel2: TBevel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Bevel3: TBevel;
    Label8: TLabel;
    ReadOnlyCheckBox: TCheckBox;
    HiddenCheckBox: TCheckBox;
    ArchiveCheckBox: TCheckBox;
    SystemCheckBox: TCheckBox;
    OkButton: TButton;
    CancelButton: TButton;
    ApplyButton: TButton;
    PathLabel: TLabel;
    SizeLabel: TLabel;
    DOSNameLabel: TLabel;
    CreationYearEdit: TEdit;
    CreationMonthEdit: TEdit;
    CreationDayEdit: TEdit;
    CreationHourEdit: TEdit;
    CreationMinEdit: TEdit;
    CreationSecEdit: TEdit;
    Label1: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    LastWriteYearEdit: TEdit;
    LastWriteMonthEdit: TEdit;
    LastWriteDayEdit: TEdit;
    LastWriteHourEdit: TEdit;
    LastWriteMinEdit: TEdit;
    LastWriteSecEdit: TEdit;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    LastAccYearEdit: TEdit;
    LastAccMonthEdit: TEdit;
    LastAccDayEdit: TEdit;
    LastAccHourEdit: TEdit;
    LastAccMinEdit: TEdit;
    LastAccSecEdit: TEdit;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    procedure OkButtonClick(Sender: TObject);
    procedure CancelButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ReadOnlyCheckBoxClick(Sender: TObject);
    procedure HiddenCheckBoxClick(Sender: TObject);
    procedure ArchiveCheckBoxClick(Sender: TObject);
    procedure SystemCheckBoxClick(Sender: TObject);
    procedure ApplyButtonClick(Sender: TObject);
    procedure CreationYearEditChange(Sender: TObject);
  private
    { Private declarations }
    FFileName: string;
    FModify: Boolean;

    function GetFileProp(FileName: string): TFileProp;
    function SetFileProp(FileName: string; FileProp: TFileProp): Boolean;

    procedure SetFileName(Value: string);
    procedure SetFilePropFromCtrl;
  public
    { Public declarations }
    property FileName: string read FFileName write SetFileName;
  end;

var
  FilePropForm: TFilePropForm;

function ShowFilePropForm(FileName: string): Boolean;

implementation

{$R *.DFM}

function ShowFilePropForm(FileName: string): Boolean;
var
  Frm: TFilePropForm;
begin
  if not FileExists(FileName) then
  begin
    MessageBox(Application.Handle, PChar('文件 ' + FileName + ' 不存在。'), '提示', 48);
    Result := False;
    Exit;
  end;
  Frm := TFilePropForm.Create(Application);
  Frm.SetFileName(FileName);
  Result := (Frm.ShowModal = mrOk);
  Frm.Free;
end;

function TFilePropForm.GetFileProp(FileName: string): TFileProp;
var
  SR: TSearchRec;
begin
  if FindFirst(FileName, faAnyFile, SR) = 0 then
  begin
    Result.FileName := FileName;
    Result.Size := SR.Size;
    Result.Attr := SR.Attr;
    Result.DOSFileName := SR.FindData.cAlternateFileName;
    Result.CreationTime := FileTimeToLocalSystemTime(SR.FindData.ftCreationTime);
    Result.LastWriteTime := FileTimeToLocalSystemTime(SR.FindData.ftLastWriteTime);
    Result.LastAccessTime := FileTimeToLocalSystemTime(SR.FindData.ftLastAccessTime);
    FindClose(SR);
  end;
end;

function TFilePropForm.SetFileProp(FileName: string; FileProp: TFileProp): Boolean;
var
  CreationFileTime, LastWriteFileTime, LastAccessFileTime: TFileTime;
begin
  FileSetAttr(FileName, FileProp.Attr);
  CreationFileTime := LocalSystemTimeToFileTime(FileProp.CreationTime);
  LastWriteFileTime := LocalSystemTimeToFileTime(FileProp.LastWriteTime);
  LastAccessFileTime := LocalSystemTimeToFileTime(FileProp.LastAccessTime);
  SetFileDate(FileName, CreationFileTime, LastWriteFileTime, LastAccessFileTime);
  Result := True;
end;

procedure TFilePropForm.SetFileName(Value: string);
var
  t: TSystemTime;
  Icon: TIcon;
  FileProp: TFileProp;
begin
  try
    FFileName := Value;
    FileProp := GetFileProp(FFileName);
    Icon := TIcon.Create;
    if GetFileIcon(FFileName, Icon) then
       FileIconImage.Picture.Icon.Assign(Icon);
    Icon.Free;
    FileNameLabel.Caption := ExtractFileName(FFileName);
    PathLabel.Caption := ExtractFilePath(FFileName);
    SizeLabel.Caption := AddThoundandFlag(FileProp.Size)+' 字节';
    DOSNameLabel.Caption := FileProp.DOSFileName;
    t := FileProp.CreationTime;
    CreationYearEdit.Text := IntToStr(t.wYear);
    CreationMonthEdit.Text := IntToStr(t.wMonth);
    CreationDayEdit.Text := IntToStr(t.wDay);
    CreationHourEdit.Text := IntToStr(t.wHour);
    CreationMinEdit.Text := IntToStr(t.wMinute);
    CreationSecEdit.Text := IntToStr(t.wSecond);

    t := FileProp.LastWriteTime;
    LastWriteYearEdit.Text := IntToStr(t.wYear);
    LastWriteMonthEdit.Text := IntToStr(t.wMonth);
    LastWriteDayEdit.Text := IntToStr(t.wDay);
    LastWriteHourEdit.Text := IntToStr(t.wHour);
    LastWriteMinEdit.Text := IntToStr(t.wMinute);
    LastWriteSecEdit.Text := IntToStr(t.wSecond);

    t := FileProp.LastAccessTime;
    LastAccYearEdit.Text := IntToStr(t.wYear);
    LastAccMonthEdit.Text := IntToStr(t.wMonth);
    LastAccDayEdit.Text := IntToStr(t.wDay);
    LastAccHourEdit.Text := IntToStr(t.wHour);
    LastAccMinEdit.Text := IntToStr(t.wMinute);
    LastAccSecEdit.Text := IntToStr(t.wSecond);

    ReadOnlyCheckBox.Checked := (FileProp.Attr and faReadOnly)>0;
    HiddenCheckBox.Checked := (FileProp.Attr and faHidden)>0;
    ArchiveCheckBox.Checked := (FileProp.Attr and faArchive)>0;
    SystemCheckBox.Checked := (FileProp.Attr and faSysFile)>0;
  except
  end;
  FModify := False;
end;

procedure TFilePropForm.SetFilePropFromCtrl;
var
  Attr: integer;
  t: TSystemTime;
  FileProp: TFileProp;
begin
  Attr := 0;
  if ReadOnlyCheckBox.Checked then Attr := Attr or faReadOnly;
  if HiddenCheckBox.Checked then Attr := Attr or faHidden;
  if ArchiveCheckBox.Checked then Attr := Attr or faArchive;
  if SystemCheckBox.Checked then Attr := Attr or faSysFile;
  FileProp.Attr := Attr;

  t.wYear := StrToInt(CreationYearEdit.Text);
  t.wMonth := StrToInt(CreationMonthEdit.Text);
  t.wDay := StrToInt(CreationDayEdit.Text);
  t.wHour := StrToInt(CreationHourEdit.Text);
  t.wMinute := StrToInt(CreationMinEdit.Text);
  t.wSecond := StrToInt(CreationSecEdit.Text);
  FileProp.CreationTime := t;
  t.wYear := StrToInt(LastWriteYearEdit.Text);
  t.wMonth := StrToInt(LastWriteMonthEdit.Text);
  t.wDay := StrToInt(LastWriteDayEdit.Text);
  t.wHour := StrToInt(LastWriteHourEdit.Text);
  t.wMinute := StrToInt(LastWriteMinEdit.Text);
  t.wSecond := StrToInt(LastWriteSecEdit.Text);
  FileProp.LastWriteTime := t;
  t.wYear := StrToInt(LastAccYearEdit.Text);
  t.wMonth := StrToInt(LastAccMonthEdit.Text);
  t.wDay := StrToInt(LastAccDayEdit.Text);
  t.wHour := StrToInt(LastAccHourEdit.Text);
  t.wMinute := StrToInt(LastAccMinEdit.Text);
  t.wSecond := StrToInt(LastAccSecEdit.Text);
  FileProp.LastAccessTime := t;

  SetFileProp(FFileName, FileProp);
end;

procedure TFilePropForm.OkButtonClick(Sender: TObject);
begin
  ApplyButtonClick(Sender);
  ModalResult := mrOK;
end;

procedure TFilePropForm.CancelButtonClick(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TFilePropForm.FormCreate(Sender: TObject);
begin
  FModify := false;
end;

procedure TFilePropForm.ReadOnlyCheckBoxClick(Sender: TObject);
begin
  FModify := true;
end;

procedure TFilePropForm.HiddenCheckBoxClick(Sender: TObject);
begin
  FModify := true;
end;

procedure TFilePropForm.ArchiveCheckBoxClick(Sender: TObject);
begin
  FModify := true;
end;

procedure TFilePropForm.CreationYearEditChange(Sender: TObject);
begin
  FModify := True;
end;

procedure TFilePropForm.SystemCheckBoxClick(Sender: TObject);
begin
  FModify := true;
end;

procedure TFilePropForm.ApplyButtonClick(Sender: TObject);
begin
  if FModify then
  begin
    SetFilePropFromCtrl;
    FModify := false;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -