设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 3972|回复: 8
打印 上一主题 下一主题

[模块/函数] 【转载 / 源码】VBA/VB获取硬盘序列号

[复制链接]
跳转到指定楼层
1#
发表于 2005-9-5 00:09:00 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
看到有过好几个帖子问过这个问题,突然想到这个功能很好,搞不好哪天自己也要用到,就专门开个帖子,从网上淘了个源码,以备用。



Private Declare Function GetVolumeInformation Lib "kernel32.dll" Alias "GetVolumeInformationA"     (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize  As Integer, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags  As Long, ByVal lpFileSystemNameBuffer As String,  ByVal nFileSystemNameSize As Long) As Long



Function GetSerialNumber(sRoot As String) As Long

    Dim lSerialNum As Long

    Dim R As Long

    Dim sTemp1 As String, sTemp2 As String

    strLabel = String$(255, Chr$(0))    '磁盘卷标

    strType = String$(255, Chr$(0))    '文件系统类型 一般为 FAT

    R = GetVolumeInformation(sRoot, strLabel, Len(strLabel), lSerialNum, 0, 0, strType, Len(strType))

    GetSerialNumber = lSerialNum

End Function

[此贴子已经被作者于2005-9-21 22:57:40编辑过]

分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
2#
发表于 2005-9-5 00:38:00 | 只看该作者
收下,謝謝!
3#
发表于 2005-9-5 02:32:00 | 只看该作者
我的文件系统格式均为 NTFS ,结果使用

GetSerialNumber(“c”)=0

GetSerialNumber(“d”)=0

GetSerialNumber(“e”)=0

-------------------------------------------------

这个,是获取 逻辑磁盘 分区信息的吧?NTFS好像不行。



[此贴子已经被作者于2005-9-4 18:32:47编辑过]

4#
发表于 2005-9-5 02:45:00 | 只看该作者
以下是引用wu8313在2005-9-4 18:32:00的发言:



我的文件系统格式均为 NTFS ,结果使用

GetSerialNumber(“c”)=0

GetSerialNumber(“d”)=0

GetSerialNumber(“e”)=0

-------------------------------------------------

这个,是获取 逻辑磁盘 分区信息的吧?NTFS好像不行。



应改为:

      GetSerialNumber (“c:\”)

只有C:\可读取磁盘的系列号
5#
发表于 2005-9-5 03:05:00 | 只看该作者
喔,原来是调用错误。谢谢指正。

现在,可以读取c d e 三个分区的信息了。

----------------------

如果,仅仅需要获取 c:\ 的信息,使用如下 过程 也是可以的,免得又去指定参数。

Sub ShowDriveInfo(drvpath)

    Dim fs, d, s, t

    Set fs = CreateObject("Scripting.FileSystemObject")

    Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(drvpath)))

    Select Case d.DriveType

        Case 0: t = "Unknown"

        Case 1: t = "Removable"

        Case 2: t = "Fixed"

        Case 3: t = "Network"

        Case 4: t = "CD-ROM"

        Case 5: t = "RAM Disk"

    End Select

    s = "Drive " & d.DriveLetter & ": - " & t

    s = s & vbCrLf & "SN: " & d.SerialNumber

    MsgBox s

End Sub

[此贴子已经被作者于2005-9-4 19:07:24编辑过]

6#
发表于 2006-3-18 06:19:00 | 只看该作者
这种方获取的是逻辑序列号,不是物理的,没有用的。每次格式化后这个号会变的,并且可以用软件改变的。
7#
发表于 2006-3-21 21:33:00 | 只看该作者
有获取物理序列号的吗?
8#
发表于 2006-4-3 18:45:00 | 只看该作者
我是小虾米一只。这么好的东东小弟不知道如何使用?咳!郁闷。跪求各位大哥赐教!!!!!!!!
9#
发表于 2009-10-24 11:19:30 | 只看该作者
谢谢分享。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-15 14:33 , Processed in 0.086579 second(s), 32 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表