unit1.pas

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

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, FileCtrl, Buttons, ExtCtrls;

const
// Access modes 
  OPEN_ACCESS_READONLY          =$0000;
  OPEN_ACCESS_WRITEONLY         =$0001;
  OPEN_ACCESS_READWRITE         =$0002;
  OPEN_ACCESS_RO_NOMODLASTACCESS=$0004;
// Share modes
  OPEN_SHARE_COMPATIBLE         =$0000;
  OPEN_SHARE_DENYREADWRITE      =$0010;
  OPEN_SHARE_DENYWRITE          =$0020;
  OPEN_SHARE_DENYREAD           =$0030;
  OPEN_SHARE_DENYNONE           =$0040;
// Open flags
  OPEN_FLAGS_NOINHERIT          =$0080;
  OPEN_FLAGS_NO_BUFFERING       =$0100;
  OPEN_FLAGS_NO_COMPRESS        =$0200;
  OPEN_FLAGS_ALIAS_HINT         =$0400;
  OPEN_FLAGS_NOCRITERR          =$2000;
  OPEN_FLAGS_COMMIT             =$4000;
// File types
  FILENORMAL                    =$0000;
  MEMORYMAPPED                  =$0001;
  DLLOREXECUTABLE               =$0002;
  SWAPFILE                      =$0004;
type
  P32Regs = ^T32Regs;//32位寄存器结构
  T32Regs = record
    EBX: Longint;
    EDX: Longint;
    ECX: Longint;
    EAX: Longint;
    EDI: Longint;
    ESI: Longint;
    Flags: Longint;
  end;
  TOpenFileinfo = record//已打开文件的结构
    openflag: integer;
    filetype: integer;
    filename: array[0..256] of char;
  end;
  POpenFileinfo = ^TOpenFileinfo;
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Panel1: TPanel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    ComboBox1: TComboBox;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
     FHandle: Thandle;
  public
     function EnumOpenFile(volume: byte; index: integer; var
         Fileinfo: TOpenFileinfo; Enumtype: integer = 0): boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

const
  VWIN32_DIOC_DOS_IOCTL = 1; {MS-DOS Int21h 44xxh functions call}


function Tform1.EnumOpenFile(volume: byte; index: integer; var Fileinfo:
   TOpenFileinfo; Enumtype: integer = 0):boolean;
   //枚举磁盘正在使用的文件
var
  R: T32Regs;
  cb: DWord;
begin
  fillchar(r, sizeof(r), 0);
  R.EAX := $440D;
  R.EBX := Volume;
  R.ECX := $086D;
  R.EDX := integer(@fileinfo.filename);
  R.ESI := index;
  R.EDI := Enumtype;
  //列举全部正在运行的文件
  DeviceiOControl(FHandle, VWIN32_DIOC_DOS_IOCTL, @R, SizeOf(R), @R,
    SizeOf(R), cb, nil);
  fileinfo.openflag := r.EAX;
  fileinfo.filetype := r.ECX;
  Result := (R.Flags and 1) = 0;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  DriveNum: byte;
  DriveChar: Char;
  DriveType: TDriveType;
  DriveBits: set of 0..25;
  FileInfo:TOpenFileinfo;
  k:integer;
  FileType,FileOpenFlags:string;
begin
  Listbox1.items.clear;
  Try
    Integer(DriveBits) := GetLogicalDrives;//获取逻辑盘
    for DriveNum := 0 to 25 do  //检索所有的盘
    begin
      if not (DriveNum in DriveBits) then Continue;
      DriveChar := Char(DriveNum + Ord('A'));
      if (Combobox1.items[Combobox1.itemindex]<>'全部')and(Combobox1.items[Combobox1.itemindex][1]<>DriveChar)then continue;
      DriveType := TDriveType(GetDriveType(PChar(DriveChar + ':\')));
      case DriveType of
      dtFixed: //如果是硬盘
         begin
            k:=0;
            while EnumOpenFile(DriveNum+1,k , Fileinfo, 0) do //循环列举所有已打开的文件
            begin
               case LoWord(FileInfo.filetype) of
	       FILENORMAL:     FileType:='普通';
	       MEMORYMAPPED:   FileType:='内存映象';
	       DLLOREXECUTABLE:FileType:='可执行模块';
	       SWAPFILE:       FileType:='交换文件';
	       else	       FileType:='未知';
               end;

               FileOpenFlags:='';
 	       if (LOWORD(FileInfo.openflag) and OPEN_ACCESS_RO_NOMODLASTACCESS)<>0 then
  		  FileOpenFlags:=FileOpenFlags+'未知,'
	       else if (LOWORD(FileInfo.openflag) and OPEN_ACCESS_READWRITE)<>0 then
		  FileOpenFlags:=FileOpenFlags+'读写,'
	       else if (LOWORD(FileInfo.openflag) and OPEN_ACCESS_WRITEONLY)<>0 then
		  FileOpenFlags:=FileOpenFlags+'只写,'
	       else FileOpenFlags:=FileOpenFlags+'只读,';

	       if (LOWORD(FileInfo.openflag) and OPEN_SHARE_DENYNONE)<>0 then
	          FileOpenFlags:=FileOpenFlags+'不屏蔽,'
	       else if (LOWORD(FileInfo.openflag) and OPEN_SHARE_DENYWRITE)<>0 then
		  FileOpenFlags:=FileOpenFlags+'屏蔽写,'
	       else if (LOWORD(FileInfo.openflag) and OPEN_SHARE_DENYREAD)<>0 then
	       	  FileOpenFlags:=FileOpenFlags+'屏蔽读,'
	       else if (LOWORD(FileInfo.openflag) and OPEN_SHARE_DENYREADWRITE)<>0 then
		  FileOpenFlags:=FileOpenFlags+'屏蔽读写,'
	       else FileOpenFlags:=FileOpenFlags+'兼容,';

               if (LOWORD(FileInfo.openflag) and OPEN_FLAGS_COMMIT)<>0 then
	       	  FileOpenFlags:=FileOpenFlags+'提交'
	       else if (LOWORD(FileInfo.openflag) and OPEN_FLAGS_NOCRITERR)<>0 then
		  FileOpenFlags:=FileOpenFlags+'非临界'
	       else if (LOWORD(FileInfo.openflag) and OPEN_FLAGS_ALIAS_HINT)<>0 then
		  FileOpenFlags:=FileOpenFlags+'别名'
	       else if (LOWORD(FileInfo.openflag) and OPEN_FLAGS_NO_COMPRESS)<>0 then
		  FileOpenFlags:=FileOpenFlags+'不压缩'
	       else if (LOWORD(FileInfo.openflag) and OPEN_FLAGS_NO_BUFFERING)<>0 then
		  FileOpenFlags:=FileOpenFlags+'没有缓冲区'
	       else if (LOWORD(FileInfo.openflag) and OPEN_FLAGS_NOINHERIT)<>0 then
		  FileOpenFlags:=FileOpenFlags+'不继承'
	       else FileOpenFlags:=FileOpenFlags+'-';

               Listbox1.items.Add(format('%-10s %-28s%s',[FileType,FileOpenFlags,fileinfo.filename]));
               k:=k+1;
            end;
         end;
      end;
    end;
  except
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  DriveNum: Integer;
  DriveChar: Char;
  DriveType: TDriveType;
  DriveBits: set of 0..25;
begin
  SendMessage(ListBox1.Handle,LB_SetHorizontalExtent,700,longint(0));
  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.Items.Add('全部');
  Combobox1.itemindex:=Combobox1.Items.count-1;

  FHandle := CreateFile('\\.\VWIN32', GENERIC_READ or GENERIC_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if FHandle = INVALID_HANDLE_VALUE then halt;
end;

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

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if FHandle <> 0 then
    CloseHandle(Fhandle);
end;

end.