一般U盘不具备加密功能，虽然U盘和专业加密狗外形有些相似，但是内部完全不一样，U盘只是一个存储器芯片和简单附属电路，而现在智能卡加密狗都具有一个单独的CPU或者加密芯片，可以执行相当复杂加密算法。
有软件开发商有这样一种需求，就是使用U盘发布软件同时，想要节约成本，防止U盘中软件被复制，但又不想再购买昂贵加密狗，因此想要把软件绑定在U盘上执行，当U盘拔下来的时候，软件就不能正常运行，和我先前介绍的绑定硬件指纹相似，使用绑定U盘的方式加密软件。
在对软件安全不是特别在意的情况下，可以在软件中采用绑定U盘内部ID的方式来实现这种加密，先使用程序将U盘的ID读出来，然后根据这个ID生成License文件，当解密者将U盘内的文件复制到其他电脑的时候，软件执行过程中读取U盘ID失败，因此就无法校验License。
通常情况下两个U盘的ID是不相同的，因此即使将软件复制到另外一个U盘，软件执行的时候，根据U盘ID验证License，也会出现不匹配的现象，这样就实现了软件绑定U盘的加密方式。
需要指出的是，这种U盘加密并不算安全，大多数U盘厂商有内部量产工具，可以修改U盘的内部ID号码，这就存在了复制U盘的可能性，但对于普通用户来说，通常没有修改U盘内部ID的能力，因此也具有一定的加密性。
这个加密方法中，读取U盘ID号的函数的VB源代码如下所示：
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_USBHub")
For Each objItem In colItems
a = objItem.DeviceID
If InStr(a, "VID") Then b = Split(a, "\")
USB_ID = b(UBound(b))
Next
摘自月光博客
二、获取盘符和卷标
Private Sub Command1_Click()
Dim fso As Object, drv As Object
Set fso = CreateObject("Scripting.FileSystemObject")
For Each drv In fso.Drives
If drv.DriveType = 1 Then
Print drv.DriveLetter & ":", drv.VolumeName
Next
End Sub
Private Declare Function GetVolumeInformation Lib "kernel32" _
Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long
Private Function GetSerial(ByVal nDrive As String) As String
Dim aa As Long
Dim VolName As String
Dim fsysName As String
Dim VolSeri As Long
Dim Sysflag As Long, Maxlen As Long
VolName = String(255, 0)
fsysName = String(255, 0)
aa = GetVolumeInformation(nDrive, VolName, 256, VolSeri, Maxlen, Sysflag, fsysName, 256)
GetSerial = Hex(VolSeri)
End Function
If GetDriveType(DriveID) = 2 Then
'取到了U盘
msgbox GetSerial(DriveID) 取到了U盘序列号码
End If
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Sub Command1_Click()
Dim StrDrive As String
Dim DriveID As String
Dim i As Integer
Dim m As Long
StrDrive = String(100, Chr$(0)) '初始化盘符串
m = GetLogicalDriveStrings(100, StrDrive) '返回盘符串
For i = 1 To 100 Step 4 '注意这里是4
DriveID = Mid(StrDrive, i, 3) '枚举盘符
If DriveID = Chr$(0) & Chr(0) & Chr(0) Then Exit For '没有盘符,即时退出循环
If GetDriveType(DriveID) = 2 Then
'取到了U盘
End If
Next i
End Sub
三、取U盘(优盘）硬件序列号（机器码）
Sub aa()
Dim objWMIService As Object
Dim colItems As Object
Dim objitem As Object
Dim a, b, c, d, e, U_Dist
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.InstancesOf("Win32_USBHub") 'ExecQuery("Select * From Win32_USBHub")
I = 1
For Each objitem In colItems
a = objitem.DeviceID
If a Like "*VID*" Then
b = Split(a, "\")
c = Split(b(UBound(b) - 1), "&")
d = Split(c(UBound(c) - 1), "_")
e = Split(c(UBound(c)), "_")
U_Dist = d(UBound(d)) + e(UBound(e)) + b(UBound(b))
ttx = U_Dist
Cells(I, 1) = U_Dist
I = I + 1
End If
Next
End Sub
Sub bb()
Dim WMILocator As New SWbemLocator '定义一个指向WMI的指针
Dim WMIServices As SWbemServices
Dim WMIObjectSet As SWbemObjectSet
Dim WMIObject As SWbemObject
Dim I As Long
'Sheet1.Cells.Clear
Set WMIServices = WMILocator.ConnectServer(".", "root\CIMV2") '可以省略，写上是为了更好理解参数的使用
Set WMIObjectSet = WMIServices.InstancesOf("Win32_USBHub")
I = 1
With Sheet1
For Each WMIObject In WMIObjectSet
.Range("a" & I).value = "U盘" & I
.Range("b" & I).value = WMIObject.DeviceID '物理序列号添加到B列
I = I + 1
Next
End With
Set WMIObject = Nothing
Set WMIObjectSet = Nothing
End Sub
四、取U盘物理序列号核心代码
On Error Resume Next
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colitems = objWMIService.execquery("Select * From Win32_USBHub")
For Each objitem In colitems
a = objitem.deviceID 'U盘识别为:USB\VID_09A6&PID_800\20040418154911-00，故用VID判别
If a Like "输入我的U盘的物理序列号这样可以认到我的U盘" Then b = Split(a, "\")
CC = b(UBound(b)) '上句亦可:If InStr(a, "VID") Then b = Split(a, "\"): MsgBox b(UBound(b))
取U盘盘符
Set colitems = objWMIService.execquery("Select * From Win32_LogicalDiskToPartition")
upanname = objitem.dependent
uname = Split(upanname, "=")
d = uname(UBound(uname))
d = Mid(d, 2, 2)
研究下，现把这两个代码合起来。让他取完了物理序列号然后认出来所在盘符
五、多硬盘中确定某个分区所对应序号
Private Sub Form_Load()
On Error Resume Next
Dim objWMIService As Object
Dim colDevices As Object
Dim objDevice As Object
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colDevices = objWMIService.execquery _
("Select * From Win32_DiskDrive")
For Each objDevice In colDevices
Debug.Print objDevice.Caption '磁盘名称
Debug.Print objDevice.Index '磁盘在系统中的 INDEX
Debug.Print objDevice.INTERFACETYPE '磁盘接口类型
Next objDevice
Set colDevices = objWMIService.execquery _
("Select * From Win32_LogicalDiskToPartition")
For Each objDevice In colDevices
Debug.Print objDevice.Antecedent
Debug.Print objDevice.Dependent
Next
End Sub ''对扩展分区无法判断
六、取U盘的相关硬件信息
'WMI 呀 开篇就说了
Private Sub Form_Load()
On Error Resume Next
Dim objWMIService As Object
Dim colDevices As Object
Dim objDevice As Object
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colDevices = objWMIService.execquery _
("Select * From Win32_DiskDrive")
For Each objDevice In colDevices
Debug.Print objDevice.Caption '磁盘名称
Debug.Print objDevice.Index '磁盘在系统中的 INDEX
Debug.Print objDevice.INTERFACETYPE '磁盘接口类型
Debug.Print objDevice.Partitions '磁盘分区数
Next objDevice
end sub
Option Explicit
Private Declare Function QueryDosDevice Lib "kernel32" Alias "QueryDosDeviceA" (ByVal lpDeviceName As String, ByVal lpTargetPath As String, ByVal ucchMax As Long) As Long
Private Sub Form_Load()
GetDiskPartition "c:"
GetDiskPartition "d:"
GetDiskPartition "e:"
GetDiskPartition "f:"
GetDiskPartition "g:"
GetDiskPartition "h:"
End Sub
Function GetDiskPartition(ByVal DiskStr As String)
On Error Resume Next
Dim lp As String * 255
Dim m As Long, n As Long
m = QueryDosDevice(DiskStr, lp, 255)
n = Val(Mid(lp, 23, m - 23))
If m = 0 Or n = 0 Then Exit Function
Dim objWMIService As Object
Dim colDevices As Object
Dim objDevice As Object
Dim strComputer As String
strComputer = "."
m = 0
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colDevices = objWMIService.execquery _
("Select * From Win32_DiskDrive")
For Each objDevice In colDevices
m = m + objDevice.Partitions '磁盘分区数
If n <= m Then
Debug.Print objDevice.Index + 1 & ":" & n - m + objDevice.Partitions
Exit For
End If
Next objDevice
End Function
七、其它方法 读取优盘(U盘）系列号
Public Function GetUDiskID() As String
'****
'*Function:读取优盘物理序列号
'*Author:张旋(zxsoft)
'****
On Error Resume Next
Dim objWMIService As Object
Dim colDevices As Object
Dim objdevice As Object
Dim UDiskID As String
Dim isUDisk As Boolean
Dim objUsbDevice As Object
Dim colUSBDevices As Object
isUDisk = False
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colDevices = objWMIService.ExecQuery _
("Select * From Win32_USBControllerDevice")
Dim ret
For Each objdevice In colDevices
Set colUSBDevices = objWMIService.ExecQuery _
("Select * From Win32_PnPEntity Where DeviceID = '" & Split(Replace(objdevice.Dependent, Chr(34), ""), "=")(1) & "'")
For Each objUsbDevice In colUSBDevices
If Left(objUsbDevice.DeviceID, 8) = "STORAGE\" Then
GetUDiskID = UDiskID
Exit Function
End If
If Left(objUsbDevice.DeviceID, 8) = "USB\VID_" Then
UDiskID = Split(objUsbDevice.DeviceID, "\")(2)
If InStr(UDiskID, "&") > 0 Then
ret = Split(UDiskID, "&")
UDiskID = ret(UBound(ret) - 2)
End If
End If
Next
Next
GetUDiskID = "U-Disk-Not-Found"
End Function
Sub cc()
On Error Resume Next
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_USBHub")
For Each objItem In colItems
a = objItem.DeviceID 'U盘识别为:USB\VID_09A6&PID_800\20040418154911-00，故用VID判别
If a Like "*VID*" Then b = Split(a, "\"): MsgBox b(UBound(b))
'上句亦可:If InStr(a, "VID") Then b = Split(a, "\"): MsgBox b(UBound(b))
Next
End Sub
判断哪个盘产U盘
Dim S As String, I As Integer, X
I = 67
Do
X = GetDriveType(Chr(I) + ":")
Debug.Print Chr(I)
If X = 2 Then Exit Do
I = I + 1
Loop
Print "U盘盘符是："; Chr(I)
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Sub Command1_Click()
Dim y
Drive1.Refresh
For i = 0 To Drive1.ListCount - 1
If GetDriveType(Drive1.List(i)) = 2 Then
y = Drive1.List(i)
Shell "notepad " & y & "\1.txt", vbNormalFocus
Exit For
End If
Next
End Sub作者: 风中漫步 时间: 2015-9-4 13:11
谢谢分享作者: koutx 时间: 2015-9-4 14:26
谢谢，留下足迹备用。作者: wang1999 时间: 2015-9-5 12:59
收藏了,学习了,简单实用,不复杂.{:soso_e179:}
