uredata.pas

非长好的DELPHI办公系统 直接可以用

unit uRedata;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Buttons, DB, ADODB, XPMenu;

type
  TfrmReData = class(TForm)
    lvReData: TListView;
    Label1: TLabel;
    btnReStore: TBitBtn;
    btnDel: TBitBtn;
    btnTrans: TBitBtn;
    btnClose: TBitBtn;
    xpReData: TXPMenu;
    procedure FormShow(Sender: TObject);
    procedure btnReStoreClick(Sender: TObject);
    procedure btnDelClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure btnTransClick(Sender: TObject);
    procedure lvReDataDblClick(Sender: TObject);
    procedure lvReDataClick(Sender: TObject);
  private
    { Private declarations }
    FhPar: THandle;
    FConn: TADOConnection;
    procedure FillListBox;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent; AHandle: THandle; AConn: TADOConnection); reintroduce;
  end;

var
  frmReData: TfrmReData;

implementation

uses uProgress;

{$R *.dfm}

constructor TfrmReData.Create(AOwner: TComponent; AHandle: THandle; AConn: TADOConnection);
begin
  FhPar := AHandle;
  FConn := AConn;
  inherited Create(AOwner);
end;

procedure TfrmReData.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.WndParent := FhPar;
end;

procedure TfrmReData.FillListBox;
  function GetFileCreationTime(const FileName: String): string;
  var
    FileTime: TFileTime;
    LocalFileTime: TFileTime;
    hFile: THandle;
    SystemTime: TSystemTime;
  begin
    Result := '';
    FileTime.dwLowDateTime := 0;
    FileTime.dwHighDateTime := 0;
    hFile := FileOpen(FileName, fmShareDenyNone);
    try
      if hFile <> 0 then
      begin
        //参数，文件的时间：       创         末访 末改
        Windows.GetFileTime(hFile, @FileTime, nil, nil);
        FileTimeToLocalFileTime(FileTime, LocalFileTime);
        FileTime := LocalFileTime;
      end;
    finally
      FileClose(hFile);
    end;
    if FileTimeToSystemTime(FileTime, SystemTime) then
      Result := DateTimeToStr(SystemTimeToDateTime(SystemTime));
  end;
  
var
  srData: TSearchRec;
  iFound: Integer;
begin
  lvReData.Items.Clear;
  iFound := FindFirst('*.bak', faAnyFile, srData);
  while iFound = 0 do
  begin
    with lvReData.Items.Add do
    begin
      Caption := srData.Name;
      SubItems.Add(GetFileCreationTime(srData.Name));
    end;
    iFound := FindNext(srData);
  end;
  FindClose(srData);

  if (lvReData.Items.Count = 1) and (lvReData.Items[0].Caption = '') then
    lvReData.Items.Clear;
  if lvReData.Items.Count > 0 then
  begin
    lvReData.SetFocus;
    lvReData.ItemIndex := 0;
  end;

  btnReStore.Enabled := lvReData.Items.Count > 0;
  btnDel.Enabled := lvReData.Items.Count > 0;
end;

procedure TfrmReData.FormShow(Sender: TObject);
begin
  FillListBox;
end;

procedure TfrmReData.lvReDataClick(Sender: TObject);
begin
  btnReStore.Enabled := lvReData.Selected <> nil;
  btnDel.Enabled := btnReStore.Enabled;
end;

procedure TfrmReData.lvReDataDblClick(Sender: TObject);
begin
  if lvReData.Selected <> nil then
    btnReStoreClick(Sender);
end;

procedure TfrmReData.btnReStoreClick(Sender: TObject);
var
  sBakName: string;
begin
  if MessageBox(Handle, '确定要还原所选数据文件吗?', '提示', mb_IconQuestion + mb_YesNO) = idYes then
  begin
    if FConn.Connected then FConn.Close;
    sBakName := lvReData.Selected.Caption;
    try
      DeleteFile('permis.mdb');
      CopyFile(PAnsiChar(sBakName), PAnsiChar('permis.mdb'), True);
      ShowProgress(Self);
    finally
      FConn.Connected := True;
    end;
    ModalResult := mrOk;
  end;
end;

procedure TfrmReData.btnDelClick(Sender: TObject);
begin
  if MessageBox(Handle, '确定删除所选备份文件吗?', '提示', mb_IconQuestion + mb_YesNO) = idYes then
  begin
    DeleteFile(lvReData.Selected.Caption);
    lvReData.DeleteSelected;
    if lvReData.Items.Count > 0 then lvReData.ItemIndex := 0;
    lvReDataClick(Sender);
  end;
end;

procedure TfrmReData.btnTransClick(Sender: TObject);
begin
  if btnTrans.Caption = '半透明' then
  begin
    self.AlphaBlend := True;
    self.AlphaBlendValue := 125;
    btnTrans.Caption := '还  原';
  end
  else
  begin
    self.AlphaBlend := false;
    btnTrans.Caption := '半透明';
  end;
end;

procedure TfrmReData.btnCloseClick(Sender: TObject);
begin
  Close();
end;

end.