一、用U盘加密你的软件：    一般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        NextEnd SubPrivate 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 LongPrivate Function GetSerial(ByVal nDrive As String) As StringDim aa As LongDim VolName As StringDim fsysName As StringDim VolSeri As LongDim Sysflag As Long, Maxlen As LongVolName = String(255, 0)fsysName = String(255, 0)aa = GetVolumeInformation(nDrive, VolName, 256, VolSeri, Maxlen, Sysflag, fsysName, 256)GetSerial = Hex(VolSeri)End FunctionIf GetDriveType(DriveID) = 2 Then        '取到了U盘    msgbox GetSerial(DriveID)     取到了U盘序列号码End IfPrivate Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As LongPrivate Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As LongPrivate Sub Command1_Click()Dim StrDrive As StringDim DriveID As StringDim i As IntegerDim m As LongStrDrive = 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 IfNext iEnd 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 SubSub bb()Dim WMILocator As New SWbemLocator '定义一个指向WMI的指针Dim WMIServices As SWbemServicesDim WMIObjectSet As SWbemObjectSetDim WMIObject As SWbemObjectDim I As Long'Sheet1.Cells.ClearSet WMIServices = WMILocator.ConnectServer(".", "root\CIMV2") '可以省略，写上是为了更好理解参数的使用Set WMIObjectSet = WMIServices.InstancesOf("Win32_USBHub")I = 1With Sheet1    For Each WMIObject In WMIObjectSet        .Range("a" & I).value = "U盘" & I        .Range("b" & I).value = WMIObject.DeviceID '物理序列号添加到B列        I = I + 1    NextEnd WithSet WMIObject = NothingSet WMIObjectSet = NothingEnd Sub

四、取U盘物理序列号核心代码On Error Resume NextSet objWMIService = GetObject("winmgmts:\\.\root\cimv2")Set colitems = objWMIService.execquery("Select * From Win32_USBHub")For Each objitem In colitemsa = 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.dependentuname = 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 objDeviceend subOption ExplicitPrivate Declare Function QueryDosDevice Lib "kernel32" Alias "QueryDosDeviceA" (ByVal lpDeviceName As String, ByVal lpTargetPath As String, ByVal ucchMax As Long) As LongPrivate Sub Form_Load()  GetDiskPartition "c:"  GetDiskPartition "d:"  GetDiskPartition "e:"  GetDiskPartition "f:"  GetDiskPartition "g:"  GetDiskPartition "h:"End SubFunction 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 objDeviceEnd 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八、更专业access加密狗 保护你的软件版权： 请联系 Office中国