-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathDeviceInfo.cls
211 lines (189 loc) · 8.43 KB
/
DeviceInfo.cls
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "DeviceInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
#If Win64 Then
Private Declare PtrSafe Function DICreateDeviceInfo Lib "deviceinfo64.dll" () As LongPtr
Private Declare PtrSafe Sub DIDestroyDeviceInfo Lib "deviceinfo64.dll" (ByVal phDevInfo As LongPtr)
Private Declare PtrSafe Function DIQueryDeviceInfo Lib "deviceinfo64.dll" (ByVal phDevInfo As LongPtr, ByVal psDrivePath As LongPtr) As Integer
Private Declare PtrSafe Function DIGetVersion Lib "deviceinfo64.dll" (ByVal phDevInfo As LongPtr) As Long
Private Declare PtrSafe Function DIGetDeviceType Lib "deviceinfo64.dll" (ByVal phDevInfo As LongPtr) As Byte
Private Declare PtrSafe Function DIGetDeviceTypeModifier Lib "deviceinfo64.dll" (ByVal phDevInfo As LongPtr) As Byte
Private Declare PtrSafe Function DIGetRemovableMedia Lib "deviceinfo64.dll" (ByVal phDevInfo As LongPtr) As Byte
Private Declare PtrSafe Function DIGetCommandQueueing Lib "deviceinfo64.dll" (ByVal phDevInfo As LongPtr) As Byte
Private Declare PtrSafe Function DIGetBusType Lib "deviceinfo64.dll" (ByVal phDevInfo As LongPtr) As Byte
Private Declare PtrSafe Function DIGetLastError Lib "deviceinfo64.dll" (ByVal phDevInfo As LongPtr) As Long
Private Declare PtrSafe Function DIGetLastErrorText Lib "deviceinfo64.dll" ( _
ByVal phDevInfo As LongPtr, _
ByVal plRetOutputBuf As LongPtr, _
ByVal piOutputBufLen As Integer) As Long
Private Declare PtrSafe Sub DIGetVendorID Lib "deviceinfo64.dll" ( _
ByVal phDevInfo As LongPtr, _
ByVal plRetOutputBuf As LongPtr, _
ByVal piOutputBufLen As Integer)
Private Declare PtrSafe Sub DIGetProductID Lib "deviceinfo64.dll" ( _
ByVal phDevInfo As LongPtr, _
ByVal plRetOutputBuf As LongPtr, _
ByVal piOutputBufLen As Integer)
Private Declare PtrSafe Sub DIGetProductRevision Lib "deviceinfo64.dll" ( _
ByVal phDevInfo As LongPtr, _
ByVal plRetOutputBuf As LongPtr, _
ByVal piOutputBufLen As Integer)
Private Declare PtrSafe Sub DIGetSerialNumber Lib "deviceinfo64.dll" ( _
ByVal phDevInfo As LongPtr, _
ByVal plRetOutputBuf As LongPtr, _
ByVal piOutputBufLen As Integer)
#Else
Private Declare Function DICreateDeviceInfo Lib "deviceinfo.dll" () As Long
Private Declare Sub DIDestroyDeviceInfo Lib "deviceinfo.dll" (ByVal phDevInfo As Long)
Private Declare Function DIQueryDeviceInfo Lib "deviceinfo.dll" (ByVal phDevInfo As Long, ByVal psDrivePath As Long) As Integer
Private Declare Function DIGetVersion Lib "deviceinfo.dll" (ByVal phDevInfo As Long) As Long
Private Declare Function DIGetDeviceType Lib "deviceinfo.dll" (ByVal phDevInfo As Long) As Byte
Private Declare Function DIGetDeviceTypeModifier Lib "deviceinfo.dll" (ByVal phDevInfo As Long) As Byte
Private Declare Function DIGetRemovableMedia Lib "deviceinfo.dll" (ByVal phDevInfo As Long) As Byte
Private Declare Function DIGetCommandQueueing Lib "deviceinfo.dll" (ByVal phDevInfo As Long) As Byte
Private Declare Function DIGetBusType Lib "deviceinfo.dll" (ByVal phDevInfo As Long) As Byte
Private Declare Function DIGetLastError Lib "deviceinfo.dll" (ByVal phDevInfo As Long) As Long
Private Declare Function DIGetLastErrorText Lib "deviceinfo.dll" ( _
ByVal phDevInfo As Long, _
ByVal plRetOutputBuf As Long, _
ByVal piOutputBufLen As Integer) As Long
Private Declare Sub DIGetVendorID Lib "deviceinfo.dll" ( _
ByVal phDevInfo As Long, _
ByVal plRetOutputBuf As Long, _
ByVal piOutputBufLen As Integer)
Private Declare Sub DIGetProductID Lib "deviceinfo.dll" ( _
ByVal phDevInfo As Long, _
ByVal plRetOutputBuf As Long, _
ByVal piOutputBufLen As Integer)
Private Declare Sub DIGetProductRevision Lib "deviceinfo.dll" ( _
ByVal phDevInfo As Long, _
ByVal plRetOutputBuf As Long, _
ByVal piOutputBufLen As Integer)
Private Declare Sub DIGetSerialNumber Lib "deviceinfo.dll" ( _
ByVal phDevInfo As Long, _
ByVal plRetOutputBuf As Long, _
ByVal piOutputBufLen As Integer)
#End If
Private Const MAX_ERRSTR_LENGTH As Integer = 512
Private Const INFOSTRING_MAX_LENGTH As Integer = 128
Private mlVersion As Long
Private mbDeviceType As Byte
Private mbDeviceTypeModifier As Byte
Private mbRemovableMedia As Byte
Private mbCommandQueueing As Byte
Private mbBusType As Byte
Private msVendorID As String
Private msProductID As String
Private msProductRevision As String
Private msSerialNumber As String
' Class error context
Private mlErr As Long
Private msErr As String
Private msErrCtx As String
Private Sub ClearErr()
mlErr = 0&
msErr = ""
msErrCtx = ""
End Sub
Private Sub SetErr(ByVal psErrCtx As String, ByVal plErr As Long, ByVal psErr As String)
mlErr = plErr
msErr = psErr
msErrCtx = psErrCtx
End Sub
Public Property Get LastErr() As Long
LastErr = mlErr
End Property
Public Property Get LastErrDesc() As String
LastErrDesc = msErr
End Property
Public Property Get LastErrCtx() As String
LastErrCtx = msErrCtx
End Property
'All read only properties
Public Property Get Version() As Long: Version = mlVersion: End Property
Public Property Get DeviceType() As Byte: DeviceType = mbDeviceType: End Property
Public Property Get DeviceTypeModifier() As Byte: DeviceTypeModifier = mbDeviceTypeModifier: End Property
Public Property Get RemovableMedia() As Byte: RemovableMedia = mbRemovableMedia: End Property
Public Property Get CommandQueueing() As Byte: CommandQueueing = mbCommandQueueing: End Property
Public Property Get BusType() As Byte: BusType = mbBusType: End Property
Public Property Get VendorID() As String: VendorID = msVendorID: End Property
Public Property Get ProductID() As String: ProductID = msProductID: End Property
Public Property Get ProductRevision() As String: ProductRevision = msProductRevision: End Property
Public Property Get SerialNumber() As String: SerialNumber = msSerialNumber: End Property
Private Function MakeBufferString(ByVal piBufferSize As Integer) As String
MakeBufferString = Space$(piBufferSize)
End Function
'Cut string before trailing chr$(0)
Private Function CtoVB(ByRef pszString As String) As String
Dim i As Long
i = InStr(pszString, Chr$(0))
If i Then
CtoVB = Left$(pszString, i - 1&)
Else
CtoVB = pszString
End If
End Function
Public Function GetDeviceInformation(ByVal psDriveLetter As String) As Boolean
Const LOCAL_ERR_CTX As String = "GetDeviceInformation"
Const ERR_MEMORY As Long = -1&
On Error GoTo GetDeviceInformation_Err
ClearErr
Dim fOK As Boolean
Dim sDrivePath As String
Dim sErrString As String
Dim lErrCode As Long
Dim sBuffer As String
#If Win64 Then
Dim hDevInfo As LongPtr
#Else
Dim hDevInfo As Long
#End If
sDrivePath = "\\.\" & psDriveLetter & ":" & ChrW$(0)
hDevInfo = DICreateDeviceInfo()
If hDevInfo = 0 Then
SetErr LOCAL_ERR_CTX, ERR_MEMORY, "Couldn't allocate memory to query for device information"
Exit Function
End If
fOK = DIQueryDeviceInfo(hDevInfo, StrPtr(sDrivePath))
If Not fOK Then
sErrString = MakeBufferString(MAX_ERRSTR_LENGTH)
lErrCode = DIGetLastErrorText(hDevInfo, StrPtr(sErrString), MAX_ERRSTR_LENGTH)
SetErr LOCAL_ERR_CTX, lErrCode, Trim$(CtoVB(sErrString))
GoTo GetDeviceInformation_Exit
End If
mlVersion = DIGetVersion(hDevInfo)
mbDeviceType = DIGetDeviceType(hDevInfo)
mbDeviceTypeModifier = DIGetDeviceTypeModifier(hDevInfo)
mbRemovableMedia = DIGetRemovableMedia(hDevInfo)
mbCommandQueueing = DIGetCommandQueueing(hDevInfo)
mbBusType = DIGetBusType(hDevInfo)
'retrieve strings
sBuffer = MakeBufferString(INFOSTRING_MAX_LENGTH)
DIGetVendorID hDevInfo, StrPtr(sBuffer), INFOSTRING_MAX_LENGTH
msVendorID = Trim$(CtoVB(sBuffer))
sBuffer = MakeBufferString(INFOSTRING_MAX_LENGTH)
DIGetProductID hDevInfo, StrPtr(sBuffer), INFOSTRING_MAX_LENGTH
msProductID = Trim$(CtoVB(sBuffer))
sBuffer = MakeBufferString(INFOSTRING_MAX_LENGTH)
DIGetProductRevision hDevInfo, StrPtr(sBuffer), INFOSTRING_MAX_LENGTH
msProductRevision = Trim$(CtoVB(sBuffer))
sBuffer = MakeBufferString(INFOSTRING_MAX_LENGTH)
DIGetSerialNumber hDevInfo, StrPtr(sBuffer), INFOSTRING_MAX_LENGTH
msSerialNumber = Trim$(CtoVB(sBuffer))
GetDeviceInformation = True
GetDeviceInformation_Exit:
If hDevInfo Then
DIDestroyDeviceInfo hDevInfo
End If
Exit Function
GetDeviceInformation_Err:
SetErr LOCAL_ERR_CTX, Err.Number, Err.Description
Resume GetDeviceInformation_Exit
End Function