unit1.pas

在delphi中实现windows核心编程.原书光盘代码核心编程.原书光盘代码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus, ComCtrls, unit2, ImgList, ToolWin,FileCtrl;


const SHERB_NOCONFIRMATION = $1;
const SHERB_NOPROGRESSUI = $2;
const SHERB_NOSOUND = $4;

type TWinBool = (winFalse, winTrue);

type
  THead = packed record
    Version:integer; //04时,RecordSize=$0118,采用TInfo4
                     //05时,RecordSize=$0320,采用TInfo5
    FilesCount:integer;
    NextSequenceNumber:integer;
    RecordSize:integer;
    TotalDeletedFilesSize:integer;
  end;
  TInfo4 = packed record   //共$0118(280)字节
    FileName: array[0..259] of char; //文件名,如果第0字节是#0,则表示当前记录无效
    SequenceNumber: integer;
    Drive:integer;  //0:A,1:B,2:C
    DeletedTime:FILETIME;
    DeletedFilesSize:integer; //注意:保留至“簇”，单位：字节
  end;
  TInfo5 = packed record  //共$0320(800)字节
    DosFileName: array[0..259] of char; //DOS短文件名,如果第0字节是#0,则表示当前记录无效
    SequenceNumber: integer;
    Drive:integer;  //0:A,1:B,2:C
    DeletedTime:FILETIME;
    DeletedFilesSize:integer;  //注意:保留至“簇”，单位：字节
    FullFileName:array[0..519] of char; //长文件名,UNICODE文本
  end;

  {回收站信息记录}
type
  SHQUERYRBINFO = packed record
    cbSize: integer; {记录大小}
    i64Size: int64; {回收站大小}
    i64NumItems: int64; {回收站项数}
  end;
  pshqueryrbinfo = ^SHQUERYRBINFO;
  {检索回收站信息}
  function SHQueryRecycleBinA(pszrtootpath: pchar; QUERYRBINFO: pshqueryrbinfo): integer; stdcall; external 'shell32';
  {更新回收站}
  function SHUpdateRecycleBinIcon: integer; stdcall; external 'shell32.dll';
  {清空回收站}
  function SHEmptyRecycleBinA(hwnd: thandle; pszRootPath: pchar; dwFlags: integer): integer; stdcall; external 'shell32.dll';

type
  TForm1 = class(TForm)
    BinList: TListView;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Refresh11: TMenuItem;
    SelectAll11: TMenuItem;
    Restore1: TMenuItem;
    Delete1: TMenuItem;
    Close11: TMenuItem;
    N2: TMenuItem;
    InvertSelection11: TMenuItem;
    N3: TMenuItem;
    N1: TMenuItem;
    ToolBar1: TToolBar;
    ComboBox1: TComboBox;
    Label1: TLabel;
    ImageList1: TImageList;
    PopupMenu1: TPopupMenu;
    N4: TMenuItem;
    N5: TMenuItem;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Refresh11Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure SelectAll11Click(Sender: TObject);
    procedure InvertSelection11Click(Sender: TObject);
    procedure Restore1Click(Sender: TObject);
    procedure Close11Click(Sender: TObject);
    procedure Delete1Click(Sender: TObject);
    procedure File1Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
  private
    { Private declarations }
    filename:string;
  public
    { Public declarations }
    procedure refreshlist;
    function updateinfo(index:integer): boolean;
    procedure Restorefiles;
    procedure Deletefiles;
  end;

var
  Form1: TForm1;
  monitorthread: TFileChangeNotify;

implementation

uses shellapi;

{$R *.DFM}

function Deltree(Path:string):boolean;
var
   r:integer;
   sr:TSearchRec;
begin
   result:=true;
   if (path='')then
   begin
      result:=false;
      exit;
   end;
   if path[length(path)]<>'\' then path:=path+'\';
   R:= FindFirst(Path+'*.*',faAnyFile and not fadirectory,SR);
   WHILE (R=0) DO
   begin
      result:=result and deletefile(path+sr.name);
      r:=findnext(sr);
   end;
   R:= FindFirst(Path+'*.*',faAnyFile,SR);
   WHILE (R=0) DO
   begin
      if(sr.name[1]<>'.')AND (SR.Attr AND faDirectory <> 0)then
         result:=result and DelTree(path+sr.name);
      r:=findnext(sr);
   end;
   findclose(sr);
   result:=result and removedir(path);
end;

{恢复回收站中的文件}
procedure tform1.Restorefiles;
var
  i: integer;
  sname: string;
  dname: string;
begin
  monitorthread.Suspend;
  for i:=0 to binlist.Items.Count-1 do
  begin
    if binlist.Items[i].Selected = true then
    begin
      sname := binlist.Items[i].SubItems[2];
      dname := binlist.Items[i].SubItems[0] + binlist.Items[i].caption;
      if binlist.Items[i].ImageIndex=0 then//目录
      begin
         if not Directoryexists(sname) then
            showmessage('不能删除.'#13+sname+'没找到!')
         else if Directoryexists(dname) then
            showmessage('不能恢复.'#13+dname+'已存在!')
         else if MoveFile(pchar(sname), pchar(dname)) then
            {把该文件从info2中的清除}
            Updateinfo(strtoint(binlist.Items[i].SubItems[1]));
      end
      else begin
         if not fileexists(sname) then
            showmessage('不能删除.'#13+sname+'没找到!')
         else if fileexists(dname) then
            showmessage('不能恢复.'#13+dname+'已存在!')
         else if MoveFile(pchar(sname), pchar(dname)) then
            {把该文件从info2中的清除}
            Updateinfo(strtoint(binlist.Items[i].SubItems[1]));
      end;
    end;
  end;
  monitorthread.Resume;
end;

procedure TForm1.DeleteFiles;
var
  i: integer;
  sname: string;
  dname: string;
begin
  monitorthread.Suspend;
  for i:=0 to binlist.Items.Count-1 do
  begin
    if binlist.Items[i].Selected = true then
    begin
      sname := binlist.Items[i].SubItems[2];
      dname := binlist.Items[i].SubItems[0] + binlist.Items[i].caption;
      if binlist.Items[i].ImageIndex=0 then
      begin
         if (Directoryexists(sname)) then
            deltree(sname);
         Updateinfo(strtoint(binlist.Items[i].SubItems[1]));
      end
      else begin
         if (not fileexists(sname)) or deleteFile(sname) then
            Updateinfo(strtoint(binlist.Items[i].SubItems[1]));
      end;
    end;
  end;
  monitorthread.Resume;
end;

function TForm1.updateinfo(index:integer): boolean;
var
  head: THead;
  info4: TInfo4;
  info5: TInfo5;
  fread: integer;
  tsize: integer;
  ch: char;
  fhandle: integer;
begin
  result := false;
  ch := #0;
  fhandle := FileOpen(filename, fmOpenReadWrite or fmShareDenyNone);
  if fhandle > 0 then
  begin
    tsize := GetFileSize(fhandle, nil);
    fread:=fileread(fhandle,head,sizeof(THead));
    while fread < tsize do
    begin
      case head.Version of
      4:begin
          fread := fread + fileread(fhandle, info4, sizeof(Tinfo4));
          if info4.FileName[0]<>#0 then
          begin
             if info4.SequenceNumber=index then
             begin
               SetFilePointer(fhandle, -sizeof(Tinfo4), nil, FILE_CURRENT);
               Filewrite(fhandle, ch, 1);
               result := true;
               break;
             end;
          end;
        end;
      5:begin
          fread := fread + fileread(fhandle, info5, sizeof(TInfo5));
          if info5.DOSFileName[0]<>#0 then
          begin
             if info5.SequenceNumber=index then
             begin
               SetFilePointer(fhandle, -sizeof(TInfo5), nil, FILE_CURRENT);
               Filewrite(fhandle, ch, 1);
               result := true;
               break;
              end;
           end;
        end;
      else
         raise exception.create('错误！发现新版本的回收站结构。请到作者主页下载升级包或在DOS下拷贝'+filename+'发给作者分析。');
      end;
    end;
    fileclose(fhandle);
  end;
end;

procedure TForm1.RefreshList;
var
  head: THead;
  info4: Tinfo4;
  info5: TInfo5;
  fread: integer;
  tsize: integer;
  fitem: tlistitem;
  dname: pchar;
  iconid: integer;
  rbinfo: SHQUERYRBINFO;
  fhandle: integer;
  bak:string;
  SystemTime:TSystemTime;
begin
  monitorthread.Suspend;
  binlist.Items.Clear;
  fhandle := FileOpen(filename, fmOpenRead);
  if fhandle > 0 then
  begin
    tsize := GetFileSize(fhandle, nil);
    fread:=fileread(fhandle,head,sizeof(THead));
    while (fread < tsize) do
    begin
      case head.Version of
      4:begin
          fread := fread + fileread(fhandle, info4, sizeof(Tinfo4));
          if info4.FileName[0] <> #0 then
          begin
            dname := pchar((ExtractFileDrive(info4.FileName) + '\Recycled\D'+chr($41+info4.drive) + inttostr
               (info4.SequenceNumber) + extractfileext(info4.FileName)));
            if DirectoryExists(dname) then iconid:=0
            else if fileexists(dname) then iconid:=1
            else continue;
            fitem := binlist.Items.add;
            fitem.ImageIndex := iconid;
            fitem.Caption := ExtractFileName(info4.FileName);
            fitem.SubItems.Add(ExtractFilePath(info4.FileName));
            fitem.SubItems.add(inttostr(info4.SequenceNumber));
            fitem.SubItems.add(dname);
            FileTimeToLocalFileTime(info4.DeletedTime,info4.DeletedTime);
            FileTimeToSystemTime(info4.DeletedTime,SystemTime);
            fitem.SubItems.Add(DatetimeToStr(SystemTimeToDateTime(SystemTime)));
          end;
        end;
      5:begin
          fread := fread + fileread(fhandle, info5, sizeof(Tinfo5));
          if info5.DOSFileName[0] <> #0 then
          begin
            bak:=WideCharToString(@info5.FullFileName);
            dname := pchar((ExtractFileDrive(bak) + '\Recycled\D'+chr($41+info5.drive) + inttostr
              (info5.SequenceNumber) + extractfileext(bak)));
            if DirectoryExists(dname) then iconid:=0
            else if fileexists(dname) then iconid:=1
            else continue;
            fitem := binlist.Items.add;
            fitem.ImageIndex := iconid;
            fitem.Caption := ExtractFilename(bak);
            fitem.SubItems.Add(ExtractFilePath(bak));
            fitem.SubItems.add(inttostr(info5.SequenceNumber));
            fitem.SubItems.add(dname);
            FileTimeToLocalFileTime(info5.DeletedTime,info5.DeletedTime);
            FileTimeToSystemTime(info5.DeletedTime,SystemTime);
            fitem.SubItems.Add(DatetimeToStr(SystemTimeToDateTime(SystemTime)));
          end;
        end;
      else
         raise exception.create('错误！发现新版本的回收站结构。请到作者主页下载升级包或在DOS下拷贝'+filename+'发给作者分析。');
      end;
    end;
    fileclose(fhandle);
  end;
  rbinfo.cbSize := sizeof(rbinfo);
  rbinfo.i64NumItems := 0;
  rbinfo.i64Size := 0;
  SHQueryRecycleBinA(pchar(combobox1.items[combobox1.itemindex]), @rbinfo);
  if (binlist.items.count = 0) and (rbinfo.i64Size <> 0) then
    SHEmptyRecycleBinA(form1.handle, pchar(combobox1.items[combobox1.itemindex]), SHERB_NOCONFIRMATION or SHERB_NOPROGRESSUI);
  monitorthread.resume;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  monitorthread.Terminate;
end;

procedure TForm1.Refresh11Click(Sender: TObject);
begin
  RefreshList;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  binlist.width := width - 8;
  binlist.height := height - 48;
end;

procedure TForm1.SelectAll11Click(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to binlist.Items.Count - 1 do
    binlist.Items[i].Selected := true;
end;

procedure TForm1.InvertSelection11Click(Sender: TObject);
var
  i: integer;
begin
  for i := 0 to binlist.Items.Count - 1 do
    binlist.Items[i].Selected := not (binlist.Items[i].Selected);
end;

procedure TForm1.Restore1Click(Sender: TObject);
begin
  RestoreFiles;
end;

procedure TForm1.Close11Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.Delete1Click(Sender: TObject);
begin
  deletefiles;
end;

procedure TForm1.File1Click(Sender: TObject);
begin
  if binlist.SelCount > 0 then
  begin
    restore1.enabled := true;
    Delete1.enabled := true;
  end else begin
    restore1.enabled := false;
    Delete1.enabled := false;
  end;
end;

procedure TForm1.ComboBox1Change(Sender: TObject);
begin
  if monitorthread<>nil then monitorthread.Terminate;
  monitorthread:=TFileChangeNotify.Create(false);
  filename:=combobox1.items[combobox1.itemindex]+'recycled\info2';
  RefreshList;
end;

procedure TForm1.FormShow(Sender: TObject);
var
  DriveNum: Integer;
  DriveChar: Char;
  DriveType: TDriveType;
  DriveBits: set of 0..25;
begin
  monitorthread := nil;
  combobox1.clear;
  Integer(DriveBits) := GetLogicalDrives;
  for DriveNum := 0 to 25 do
  begin
    if not (DriveNum in DriveBits) then Continue;
    DriveChar := Char(DriveNum + Ord('A'));//从a---z
    DriveType := TDriveType(GetDriveType(PChar(DriveChar + ':\')));
    case DriveType of
      dtFixed:    combobox1.Items.Add(DriveChar+':\');
    end;
  end;
  combobox1.itemindex:=0;
  ComboBox1Change(Sender);
end;

procedure TForm1.N4Click(Sender: TObject);
begin
   Restore1Click(Sender);
end;

procedure TForm1.N5Click(Sender: TObject);
begin
   Delete1Click(Sender);
end;

end.