-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathForm1.twin
414 lines (383 loc) · 14.2 KB
/
Form1.twin
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
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
[ Description ("") ]
[ FormDesignerId ("7BF96825-2F2F-4C2D-886B-5CEFDA6C3F3E") ]
[ PredeclaredId ]
Class Form1
Private pWW As WwanRadioManager
Private pInstWW As IRadioInstance
Private pColWW As IRadioInstanceCollection
Private nWW As Long
Private pWL As WlanRadioManager
Private pInstWL As IRadioInstance
Private pColWL As IRadioInstanceCollection
Private nWL As Long
Private pBT As BluetoothRadioManager
Private pInstBT As IRadioInstance
Private pColBT As IRadioInstanceCollection
Private nBT As Long
Private pRM As RadioManagementAPI
Private Sub EnumRadios()
Dim i As Long
Dim sBuff As String, sBuffId As String
Dim priid As UUID
nWW = 0: nWL = 0: nBT = 0
On Error Resume Next 'handle creation errors manually
Set pWW = New WwanRadioManager
If pWW IsNot Nothing Then
pWW.GetRadioInstances(pColWW)
If (pColWW IsNot Nothing) Then
pColWW.GetCount(nWW)
If nWW Then
For i = 0 To nWW - 1
pColWW.GetAt(i, pInstWW)
Debug.Print "Add WW radio 0"
pInstWW.GetFriendlyName(GetUserDefaultLCID(), sBuff)
pInstWW.GetInstanceSignature(sBuffId)
pInstWW.GetRadioManagerSignature(priid)
List1.AddItem(sBuff & " (InstId=" & sBuffId & ", RmSig=" & GUIDToString(priid))
Set pInstWW = Nothing
Next
End If
Text1.Text = CStr(nWW) & " WWAN " & IIf(nWW = 1, "radio", "radios") & " found."
Else
Text1.Text = "Failed to get WWAN radio collection object."
End If
Else
Text1.Text = "Could not create WwanRadioManager."
End If
Set pWL = New WlanRadioManager
If pWL IsNot Nothing Then
pWL.GetRadioInstances(pColWL)
If (pColWL IsNot Nothing) Then
pColWL.GetCount(nWL)
If nWL Then
For i = 0 To nWL - 1
pColWL.GetAt(i, pInstWL)
Debug.Print "Add WL radio 0"
pInstWL.GetFriendlyName(GetUserDefaultLCID(), sBuff)
pInstWL.GetInstanceSignature(sBuffId)
pInstWL.GetRadioManagerSignature(priid)
List2.AddItem(sBuff & " (InstId=" & sBuffId & ", RmSig=" & GUIDToString(priid))
Set pInstWL = Nothing
Next
End If
Text2.Text = CStr(nWL) & " WLAN " & IIf(nWL = 1, "radio", "radios") & " found."
Else
Text2.Text = "Failed to get WLAN radio collection object."
End If
Else
Text2.Text = "Could not create WlanRadioManager."
End If
Set pBT = New BluetoothRadioManager
If pBT IsNot Nothing Then
pBT.GetRadioInstances(pColBT)
If (pColBT IsNot Nothing) Then
pColBT.GetCount(nBT)
If nBT Then
For i = 0 To nBT - 1
pColBT.GetAt(i, pInstBT)
Debug.Print "Add BT radio 0"
pInstBT.GetFriendlyName(GetUserDefaultLCID(), sBuff)
pInstBT.GetInstanceSignature(sBuffId)
pInstBT.GetRadioManagerSignature(priid)
List3.AddItem(sBuff & " (InstId=" & sBuffId & ", RmSig=" & GUIDToString(priid))
Set pInstBT = Nothing
Next
End If
Text3.Text = CStr(nBT) & " Bluetooth " & IIf(nBT = 1, "radio", "radios") & " found."
Else
Text3.Text = "Failed to get Bluetooth radio collection object."
End If
Else
Text3.Text = "Could not create BluetoothRadioManager."
End If
End Sub
Private Function RadioFromIndex(nIdx As Long, nType As Long) As IRadioInstance
Dim pColCur As IRadioInstanceCollection
Dim pInstCur As IRadioInstance
Dim sID As String
Select Case nType
Case 1
If pColWW IsNot Nothing Then Set pColCur = pColWW
sID = List1.List(List1.ListIndex)
Case 2
If pColWL IsNot Nothing Then Set pColCur = pColWL
sID = List2.List(List2.ListIndex)
Case 3
If pColBT IsNot Nothing Then Set pColCur = pColBT
sID = List3.List(List3.ListIndex)
End Select
sID = Mid$(sID, InStr(sID, "InstId=") + 7)
sID = Left$(sID, InStr(sID, ", RmSig=") - 1)
If pColCur IsNot Nothing Then
Dim n As Long, i As Long
Dim sBuffId As String
pColCur.GetCount(n)
If n Then
For i = 0 To n - 1
pColCur.GetAt(i, pInstCur)
pInstCur.GetInstanceSignature(sBuffId)
If sID = sBuffId Then
Debug.Print "Matched"
Set RadioFromIndex = pInstCur
Exit Function
End If
Next
End If
End If
Debug.Print "No match"
End Function
Private Function GUIDToString(tg As UUID, Optional bBrack As Boolean = True) As String
'StringFromGUID2 never works, even "working" code from vbaccelerator AND MSDN
GUIDToString = Right$("00000000" & Hex$(tg.Data1), 8) & "-" & Right$("0000" & Hex$(tg.Data2), 4) & "-" & Right$("0000" & Hex$(tg.Data3), 4) & _
"-" & Right$("00" & Hex$(CLng(tg.Data4(0))), 2) & Right$("00" & Hex$(CLng(tg.Data4(1))), 2) & "-" & Right$("00" & Hex$(CLng(tg.Data4(2))), 2) & _
Right$("00" & Hex$(CLng(tg.Data4(3))), 2) & Right$("00" & Hex$(CLng(tg.Data4(4))), 2) & Right$("00" & Hex$(CLng(tg.Data4(5))), 2) & _
Right$("00" & Hex$(CLng(tg.Data4(6))), 2) & Right$("00" & Hex$(CLng(tg.Data4(7))), 2)
If bBrack Then GUIDToString = "{" & GUIDToString & "}"
End Function
Private Sub Command3_Click() Handles Command3.Click
If List1.ListIndex = -1 Then
Label2.Caption = "No radio selected."
Exit Sub
End If
Dim pInst As IRadioInstance = RadioFromIndex(List1.ListIndex, 1)
Dim pState As DEVICE_RADIO_STATE
If pInst IsNot Nothing Then
pInst.GetRadioState(pState)
Dim hr As Long = Err.LastHresult
If hr = S_OK Then
Label2.Caption = GetRadioStateStr(pState)
Text1.Text = "Successfully queried radio state."
Else
Label2.Caption = "(Error)"
Text1.Text = "Error setting radio state, Error " & PrintError(hr)
End If
End If
End Sub
Private Sub Command4_Click() Handles Command4.Click
If List2.ListIndex = -1 Then
Label4.Caption = "No radio selected."
Exit Sub
End If
Dim pInst As IRadioInstance = RadioFromIndex(List2.ListIndex, 2)
Dim pState As DEVICE_RADIO_STATE
If pInst IsNot Nothing Then
pInst.GetRadioState(pState)
Dim hr As Long = Err.LastHresult
If hr = S_OK Then
Label4.Caption = GetRadioStateStr(pState)
Text2.Text = "Successfully queried radio state."
Else
Label4.Caption = "(Error)"
Text2.Text = "Error setting radio state, Error " & PrintError(hr)
End If
End If
End Sub
Private Sub Command7_Click() Handles Command7.Click
If List3.ListIndex = -1 Then
Label6.Caption = "No radio selected."
Exit Sub
End If
Dim pInst As IRadioInstance = RadioFromIndex(List3.ListIndex, 3)
Dim pState As DEVICE_RADIO_STATE
If pInst IsNot Nothing Then
pInst.GetRadioState(pState)
Dim hr As Long = Err.LastHresult
If hr = S_OK Then
Label6.Caption = GetRadioStateStr(pState)
Text3.Text = "Successfully queried radio state."
Else
Label6.Caption = "(Error)"
Text3.Text = "Error setting radio state, Error " & PrintError(hr)
End If
End If
End Sub
Public Function GetRadioStateStr(lVal As Long) As String
If lVal = DRS_RADIO_ON Then Return "DRS_RADIO_ON"
If lVal = DRS_SW_RADIO_OFF Then Return "DRS_SW_RADIO_OFF"
If lVal = DRS_HW_RADIO_OFF Then Return "DRS_HW_RADIO_OFF"
If lVal = DRS_SW_HW_RADIO_OFF Then Return "DRS_SW_HW_RADIO_OFF"
If lVal = DRS_HW_RADIO_ON_UNCONTROLLABLE Then Return "DRS_HW_RADIO_ON_UNCONTROLLABLE"
If lVal = DRS_RADIO_INVALID Then Return "DRS_RADIO_INVALID"
If lVal = DRS_HW_RADIO_OFF_UNCONTROLLABLE Then Return "DRS_HW_RADIO_OFF_UNCONTROLLABLE"
Return "(unknown)"
End Function
Private Sub Command1_Click() Handles Command1.Click
If List1.ListIndex = -1 Then
Text1.Text = "No radio selected."
Exit Sub
End If
Dim pInst As IRadioInstance = RadioFromIndex(List1.ListIndex, 1)
Dim pState As DEVICE_RADIO_STATE
If pInst IsNot Nothing Then
pInst.SetRadioState(DRS_RADIO_ON, 5)
Dim hr As Long = Err.LastHresult
If hr = S_OK Then
Text1.Text = "Successfully set radio state."
Else
Text1.Text = "Error setting radio state, Error " & PrintError(hr)
End If
End If
End Sub
Private Function PrintError(ByVal hr As Long) As String
Dim lSize As Long
PrintError = Space$(2000)
lSize = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0&, hr, 0&, PrintError, Len(PrintError), 0&)
If lSize > 2 Then
If Mid$(PrintError, lSize - 1, 2) = vbCrLf Then
lSize = lSize - 2
End If
End If
PrintError = "Error " & hr & ", " & Left$(PrintError, lSize)
End Function
Private Sub Command2_Click() Handles Command2.Click
If List1.ListIndex = -1 Then
Text1.Text = "No radio selected."
Exit Sub
End If
Dim pInst As IRadioInstance = RadioFromIndex(List1.ListIndex, 1)
Dim pState As DEVICE_RADIO_STATE
If pInst IsNot Nothing Then
pInst.SetRadioState(DRS_SW_RADIO_OFF, 5)
Dim hr As Long = Err.LastHresult
If hr = S_OK Then
Text1.Text = "Successfully set radio state."
Else
Text1.Text = "Error setting radio state, Error " & PrintError(hr)
End If
End If
End Sub
Private Sub Command6_Click() Handles Command6.Click
If List2.ListIndex = -1 Then
Text2.Text = "No radio selected."
Exit Sub
End If
Dim pInst As IRadioInstance = RadioFromIndex(List2.ListIndex, 2)
Dim pState As DEVICE_RADIO_STATE
If pInst IsNot Nothing Then
pInst.SetRadioState(DRS_RADIO_ON, 5)
Dim hr As Long = Err.LastHresult
If hr = S_OK Then
Text2.Text = "Successfully set radio state."
Else
Text2.Text = "Error setting radio state, Error " & PrintError(hr)
End If
End If
End Sub
Private Sub Command5_Click() Handles Command5.Click
If List2.ListIndex = -1 Then
Text2.Text = "No radio selected."
Exit Sub
End If
Dim pInst As IRadioInstance = RadioFromIndex(List2.ListIndex, 2)
Dim pState As DEVICE_RADIO_STATE
If pInst IsNot Nothing Then
pInst.SetRadioState(DRS_SW_RADIO_OFF, 5)
Dim hr As Long = Err.LastHresult
If hr = S_OK Then
Text2.Text = "Successfully set radio state."
Else
Text2.Text = "Error setting radio state, Error " & PrintError(hr)
End If
End If
End Sub
Private Sub Command9_Click() Handles Command9.Click
If List3.ListIndex = -1 Then
Text3.Text = "No radio selected."
Exit Sub
End If
Dim pInst As IRadioInstance = RadioFromIndex(List3.ListIndex, 3)
Dim pState As DEVICE_RADIO_STATE
If pInst IsNot Nothing Then
pInst.SetRadioState(DRS_RADIO_ON, 5)
Dim hr As Long = Err.LastHresult
If hr = S_OK Then
Text3.Text = "Successfully set radio state."
Else
Text3.Text = "Error setting radio state, Error " & PrintError(hr)
End If
End If
End Sub
Private Sub Command8_Click() Handles Command8.Click
If List3.ListIndex = -1 Then
Text3.Text = "No radio selected."
Exit Sub
End If
Dim pInst As IRadioInstance = RadioFromIndex(List3.ListIndex, 3)
Dim pState As DEVICE_RADIO_STATE
If pInst IsNot Nothing Then
pInst.SetRadioState(DRS_SW_RADIO_OFF, 5)
Dim hr As Long = Err.LastHresult
If hr = S_OK Then
Text3.Text = "Successfully set radio state."
Else
Text3.Text = "Error setting radio state, Error " & PrintError(hr)
End If
End If
End Sub
Private Sub Form_Load() Handles Form.Load
On Error Resume Next
Set pRM = New RadioManagementAPI
If pRM IsNot Nothing Then
Text4.Text = "Sucessfully created Radio Manager Object"
Else
Text4.Text = "Failed to create Radio Manager Object, err=" & PrintError(Err.LastHresult)
End If
On Error GoTo 0
EnumRadios
End Sub
Private Sub Command10_Click() Handles Command10.Click
Set pWW = Nothing
Set pWL = Nothing
Set pBT = Nothing
Set pColWW = Nothing
Set pColWL = Nothing
Set pColBT = Nothing
Set pInstWW = Nothing
Set pInstWL = Nothing
Set pInstBT = Nothing
nWW = 0
nWL = 0
nBT = 0
List1.Clear()
List2.Clear()
List3.Clear()
EnumRadios
End Sub
Private Sub Command14_Click() Handles Command14.Click
Unload Me
End Sub
Private Sub Command11_Click() Handles Command11.Click
If pRM IsNot Nothing Then
Dim fState As Long
Dim arg2 As Long, arg3 As Long
pRM.GetSystemRadioState(fState, arg2, arg3)
If fState Then
Text4.Text = "Airplane mode is disabled."
Else
Text4.Text = "Airplane mode is enabled."
End If
End If
End Sub
Private Sub Command12_Click() Handles Command12.Click
If pRM IsNot Nothing Then
pRM.SetSystemRadioState(CFALSE)
Dim hr As Long = Err.LastHresult
If hr = S_OK Then
Text4.Text = "Airplane mode enabled."
Else
Text4.Text = "HRESULT was not S_OK; hr=" & Err.LastHresult
End If
End If
End Sub
Private Sub Command13_Click() Handles Command13.Click
If pRM IsNot Nothing Then
pRM.SetSystemRadioState(CTRUE)
Dim hr As Long = Err.LastHresult
If hr = S_OK Then
Text4.Text = "Airplane mode disabled."
Else
Text4.Text = "HRESULT was not S_OK; hr=" & Err.LastHresult
End If
End If
End Sub
End Class