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

📄 uapptools.pas

📁 实现U盘或移动硬盘插入和退出时得到事件响应
💻 PAS
字号:
unit UAppTools;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  ShellAPI, ShlObj, SetupApi, StrUtils, DateUtils, UAppCommonType;

type
  TAppTools = class(TObject)
  private
    function GetDeviceNumberByHandle(const ADeviceHandle: THandle): Integer;
  protected
    constructor CreateInstance;
    class function AccessInstance(Request: Integer): TAppTools;
  public
    constructor Create;
    destructor Destroy; override;
    function CTL_CODE(const ADeviceType, AFunc, AMeth, AAccess: Integer): DWORD;
    function GetDiskNumber(const ADeviceName: string): Integer;
    function GetProperty(const deviceInfoSet: HDEVINFO; const devData:
            TSPDevInfoData; const property1, defaultValue: Integer): Integer;
            overload;
    function GetProperty(const deviceInfoSet: HDEVINFO; const devData:
            TSPDevInfoData; const property1: Integer; const defaultValue:
            string): string; overload;
    function GetProperty(const deviceInfoSet: HDEVINFO; const devData:
            TSPDevInfoData; const property1: Integer; const defaultValue:
            TGUID): TGUID; overload;
    class function Instance: TAppTools;
    class procedure ReleaseInstance;
  end;
  
implementation

{
********************************** TAppTools ***********************************
}
constructor TAppTools.Create;
begin
  inherited Create;
  raise Exception.CreateFmt('Access class %s through Instance only',
    [ClassName]);
end;

constructor TAppTools.CreateInstance;
begin
  inherited Create;
end;

destructor TAppTools.Destroy;
begin
  if AccessInstance(0) = Self then AccessInstance(2);
  inherited Destroy;
end;

class function TAppTools.AccessInstance(Request: Integer): TAppTools;
  
  {$WRITEABLECONST ON}
  const
    FInstance: TAppTools = nil;
    {$WRITEABLECONST OFF}
  
begin
  case Request of
    0: ;
    1:
      if not Assigned(FInstance) then FInstance := CreateInstance;
    2: FInstance := nil;
  else
    raise Exception.CreateFmt('Illegal request %d in AccessInstance',
      [Request]);
  end;
  Result := FInstance;
end;

function TAppTools.CTL_CODE(const ADeviceType, AFunc, AMeth, AAccess: Integer):
        DWORD;
begin
  Result := (ADeviceType shl 16) or (AAccess shl 14) or (AFunc shl 2) or
    (AMeth);
end;

function TAppTools.GetDeviceNumberByHandle(const ADeviceHandle: THandle):
        Integer;
var
  StorageDeviceNumber: TStorageDeviceNumber;
  RetBytes: Cardinal;
begin
  Result := -1;
  if DeviceIoControl(ADeviceHandle, IOCTL_STORAGE_GET_DEVICE_NUMBER, nil, 0,
    @StorageDeviceNumber, SizeOf(TStorageDeviceNumber), RetBytes, nil) then
  begin
    Result := StorageDeviceNumber.DeviceNumber;
  end;
end;

function TAppTools.GetDiskNumber(const ADeviceName: string): Integer;
var
  hFile: THandle;
  szBuf: string;
  size: Integer;
  bytesReturned: Cardinal;
  numberOfDiskExtents: Integer;
  sb: array[0..INTERFACE_DETAIL_SIZE - 1] of Char;
  sb1: PChar;
  i: Integer;
  VolumeDiskExtents: PVolumeDiskExtents;
  DiskExtent: PDiskExtent;
begin
  Result := -1;
  szBuf := ADeviceName;
  hFile := CreateFile(PChar(szBuf), GENERIC_READ, FILE_SHARE_READ or
    FILE_SHARE_WRITE,
    nil, OPEN_EXISTING, 0, 0);
  if (hFile <> INVALID_HANDLE_VALUE) then
  begin
    i := GetDeviceNumberByHandle(hFile);
    if i > -1 then
    begin
      Result := i;
      CloseHandle(hFile);
      Exit;
    end;
    size := INTERFACE_DETAIL_SIZE; // some big size
    bytesReturned := 0;
    try
      sb1 := sb;
      if (not DeviceIoControl(hFile, IOCTL_VOLUME_GET_VOLUME_DISK_EXTENTS, nil,
        0, sb1, size, bytesReturned, nil)) then
      begin
        // do nothing here on purpose
      end;
  
    finally
      CloseHandle(hFile);
    end;
  
    if (bytesReturned > 0) then
    begin
      VolumeDiskExtents := PVolumeDiskExtents(sb1);
      numberOfDiskExtents := VolumeDiskExtents.NumberOfDiskExtents;
      for i := 0 to numberOfDiskExtents - 1 do
      begin
        DiskExtent := PDiskExtent(sb1 + 8 + i *
          SizeOf(TDiskExtent));
        Result := DiskExtent.DiskNumber;
        Break;
      end;
    end;
  end;
end;


function TAppTools.GetProperty(const deviceInfoSet: HDEVINFO; const devData:
        TSPDevInfoData; const property1, defaultValue: Integer): Integer;
var
  propertyRegDataType: Cardinal;
  requiredSize: Cardinal;
  propertyBufferSize: Cardinal;
  propertyBuffer: array[0..SizeOf(Integer) - 1] of Byte;
begin
  propertyRegDataType := 0;
  requiredSize := 0;
  propertyBufferSize := SizeOf(Integer);
  Result := defaultValue;
  FillChar(propertyBuffer, SizeOf(Integer) - 1, 0);
  if (SetupDiGetDeviceRegistryProperty(deviceInfoSet, devData, property1,
    propertyRegDataType, PByte(@propertyBuffer), propertyBufferSize,
    requiredSize)) then
  begin
    Result := (PInteger(@propertyBuffer))^;
  end;
end;

function TAppTools.GetProperty(const deviceInfoSet: HDEVINFO; const devData:
        TSPDevInfoData; const property1: Integer; const defaultValue: string):
        string;
var
  propertyRegDataType: Cardinal;
  requiredSize: Cardinal;
  propertyBufferSize: Cardinal;
  propertyBuffer: array[0..INTERFACE_DETAIL_SIZE - 1] of Char;
  tmp: PByte;
begin
  propertyRegDataType := 0;
  requiredSize := 0;
  propertyBufferSize := INTERFACE_DETAIL_SIZE;
  Result := defaultValue;
  FillChar(propertyBuffer, INTERFACE_DETAIL_SIZE, 0);
  Tmp := @propertyBuffer[0];
  if (SetupDiGetDeviceRegistryProperty(deviceInfoSet, devData, property1,
    propertyRegDataType, Tmp, propertyBufferSize, requiredSize)) then
  begin
    Result := StrPas(propertyBuffer);
  end;
end;

function TAppTools.GetProperty(const deviceInfoSet: HDEVINFO; const devData:
        TSPDevInfoData; const property1: Integer; const defaultValue: TGUID):
        TGUID;
var
  propertyRegDataType: Cardinal;
  requiredSize: Cardinal;
  propertyBufferSize: Cardinal;
  propertyBuffer: array[0..SizeOf(TGUID) - 1] of Char;
  tmp: PByte;
begin
  propertyRegDataType := 0;
  requiredSize := 0;
  propertyBufferSize := SizeOf(TGUID);
  Result := defaultValue;
  FillChar(propertyBuffer, SizeOf(TGUID) - 1, 0);
  Tmp := @propertyBuffer[0];
  if (SetupDiGetDeviceRegistryProperty(deviceInfoSet, devData, property1,
    propertyRegDataType, tmp, propertyBufferSize, requiredSize)) then
  begin
    CopyMemory(@Result, PChar(@propertyBuffer[0]), SizeOf(TGUID));
  end;
end;

class function TAppTools.Instance: TAppTools;
begin
  Result := AccessInstance(1);
end;

class procedure TAppTools.ReleaseInstance;
begin
  AccessInstance(0).Free;
end;

initialization

finalization
  TAppTools.ReleaseInstance;

end.

⌨️ 快捷键说明

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