📄 uapptools.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 + -