Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > Access数据库-模块/函数/VBA

验证U盘的SerialNumber(可以用于登陆,权限控制等操作)

时 间:2017-04-27 09:50:52
作 者:易勋   ID:35404  城市:上海
摘 要:SerialNumber,返回十进制序列号,用于唯一标识一个磁盘卷。
正 文:

函   数:

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

Public Function CheckDrive() As Boolean
    Dim StrDrive As String
    Dim DriveID As String
    Dim i As Integer
    Dim m As Long
    Dim myDrive As Object
    
    CheckDrive = False
    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
            Set myDrive = CreateObject("Scripting.FileSystemObject").GetDrive(DriveID)
            If Not myDrive.IsReady Then Exit Function '如果磁盘不可用,就终止函数
            If myDrive.VolumeName = "RECOVERY" And myDrive.SerialNumber = "-1634556752" Then '“-1634556752”是我的U盘系列码,“RECOVERY”是我的U盘卷标,
                CheckDrive = True
            End If
        End If
    Next i
        
End Function


用   法:

If CheckDrive Then
    MsgBox "验证成功!"
Else
    MsgBox "验证失败!"
End If

预设U盘的SerialNumber和VolumeName,插入U盘后调用函数CheckDrive,返回Ture或者False。


参考文章:

通过FileSystemObject获取驱动器信息[Access软件网]
http://www.accessoft.com/article-show.asp?id=11459



Access软件网QQ交流群 (群号:54525238)       Access源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助