| |
|
|
| | Добрый день. вопрос.
Я хочу что бы программу можно было запускать с моей флешки. Для этого необходимо во время запуска программы проверять ID устройства. Как это сделать.
Спасибо! | |
| |
| |
| |
|
|
| | FSO:
Private Sub GetInfoAboutDrive()
Dim NewFSO As New FileSystemObject, Driver As Drive 'создать объект системы FSO можно обьявлением переменной типа FSO
Dim sInfoDrv(1 To 5) As String, sSayAboutInfo As String
Set Driver = NewFSO.GetDrive(NewFSO.GetDriveName(drvSelectDrive.Drive))
If Driver.IsReady = True Then 'проверяем готовность устройства к работе
sInfoDrv(1) = Driver.SerialNumber 'возвращает числовой индификатор тома дика
sInfoDrv(2) = Driver.TotalSize / 1048576 'общее пространство переводим из байт в Мбайты
sInfoDrv(3) = Driver.FreeSpace / 1048576 'свободное пространство, можно использовать Driver. AvailableSpace
sInfoDrv(4) = Driver.FileSystem 'тип файловой системы(FAT, NTFS, CDFS)
'формируем сообщение
sSayAboutInfo = "№ " & sInfoDrv(1) & Chr(10)
sSayAboutInfo = sSayAboutInfo & "Всего :" & sInfoDrv(2) & " Мбайт" & Chr(10)
sSayAboutInfo = sSayAboutInfo & "Свободно :" & sInfoDrv(3) & " Mбайт" & Chr(10)
sSayAboutInfo = sSayAboutInfo & " Файловая система : " & sInfoDrv(4) & Chr(10)
Else
'еслиDriver.IsReady = False
sSayAboutInfo = " Устройство не готово !" & Chr(10)
End If
MsgBox sSayAboutInfo, vbOKOnly, " Сведения об устройстве"
End Sub
|
API
http://hiprog.com/index.php?option=com_content&task=view&id=483
http://hiprog.com/index.php?option=com_content&task=view&id=277 | |
| |
| |
| |
|
|
| | + проверимся, что файл выполняется с нашей флешки:
Public Function funCheckFlach() As Boolean
Const MY_FLACH_SN As Long = 2086390852 'Это серийник флешки, в данном случае моей
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
funCheckFlach = objFSO.Drives(Left(CurrentProject.Path, 2)).SerialNumber = MY_FLACH_SN
Set objFSO = Nothing
'Выходим, если проверка не пройдена
' If Not funCheckFlach Then Quit
End Function
|
| |
| |
| |
| |
|
|
| | Спасибо конечно! Но уменя ни то и не другое не работает. Если можно исходник пожалуйста скиньте
uem@mail.ru
Спасибо! | |
| |
| |
| |
|
|
| | можно попробовать в референсах подключить
Microsoft Scripting Runtime | |
| |
| |
| |
 53 Кб. |
|
| | вот гляньте пример. Непомню где нарыл | |
| |
| |
| |
|
|
| | Исчо вариант:
Public Function funPrintIDUSBDevice()
Dim objWMIService As Object
Dim colItems As Object
Dim objItem As Object
Set objWMIService = GetObject("winmgmts:\\.\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_DiskDrive", , 48)
For Each objItem In colItems
If objItem.InterfaceType = "USB" Then
Debug.Print "ID: " & Split(objItem.PNPDeviceID, "\")(2)
End If
Next
Set objItem = Nothing
Set colItems = Nothing
Set objWMIService = Nothing
End Function
|
| |
| |
| |
