如何读取刻录碟的产品信息？？？光碟的生产商，容量等

Question

有些软件可以检测出光碟的生产商，容量等，用VB怎么实现这种功能呢？
或者其他的什么信息，最好要是刻录时无法改变的信息。

Answer 1

Option Explicit
Private Type LARGE_INTEGER
  lowpart As Long
  highpart As Long
End Type
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As LongPrivate Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" _
(ByVal lpRootPathName As String, lpFreeBytesAvailableToCaller As LARGE_INTEGER, _
lpTotalNumberOfBytes As LARGE_INTEGER, lpTotalNumberOfFreeBytes _
As LARGE_INTEGER) As LongPrivate Sub Command1_Click()
'用GetDiskFreeSpaceEx得到正确的容量
  Dim lngFreeCaller As LARGE_INTEGER
  Dim lngTotal As LARGE_INTEGER
  Dim lngTotalFree As LARGE_INTEGER
  Dim sngSize#  GetDiskFreeSpaceEx "e:\", lngFreeCaller, lngTotal, lngTotalFree
'以下用来显示出分区总容量(以G为单位)
  MsgBox GetSize(lngTotal) / 2 ^ 30
End SubPrivate Function GetSize(lngSize As LARGE_INTEGER) As Single'用来从LARGE_INTEGER型变量中换算出实际的大小
With lngSize
  If .highpart < 0 Then
    GetSize = (2 ^ 32 - 1 - .highpart) * (2 ^ 32 - 1)
  Else
    GetSize = .highpart * (2 ^ 32 - 1)
  End If
  If .lowpart < 0 Then
    GetSize = GetSize + (2 ^ 32 - 1 - .lowpart)
  Else
    GetSize = GetSize + .lowpart
  End If
End With
End Function

Answer 2

VB编写一个光驱保镖 编程思路：当光驱里有光盘，立即检测此光盘是否已经注册，如不是，则弹出光驱，从而达到保护光驱的作用。实现方法：
一.注册光盘
利用INI配置文件记录光盘的卷标号和序列号，比如一张卷标号为Sys、序列号为38972126的光盘，可在INI文件中在[CDRom]下按如下格式记录：ys=38972126。
二.检测光盘是否已经注册
用一个Timer控件监视光驱里是否有光盘，若有，则激活另一个Timer控件，由它来检测光驱里的光盘是否已经注册，然后进行相关操作。
三.获取光盘卷标和序列号
用GetDriveType判断光驱盘符、用GetVolumeInformation读取光盘的卷标和序列号。
四.弹出光驱
用mciSendString可对光驱的开、关进行操作，格式如下：
Call mciSendString("set CDAudio door open", returnstring, 127, 0)具体步骤：
一.新建标准EXE工程，给窗体绘制如下控件：控件 Name Caption
Timer tmrCheck
Timer tmrCd
命令按钮 cmdAdd 注册光盘
命令按钮 cmdUnlock 解除保护二、缺省添加一个标准模块三、编写代码如下——'******* 模块代码：******Option Explicit'获取磁盘类型的API
Public Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
'获取磁盘信息的API
Public 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'用于操作光驱的API
Public Declare Function mciSendString Lib "winmm.dll" Alias _
"mciSendStringA" (ByVal lpstrCommand As String, ByVal _
lpstrReturnString As String, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long'读写INI的API
Public Declare Function WritePrivateProfileString Lib _
"kernel32" Alias "WritePrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal lpKeyName _
As Any, ByVal lpString As Any, ByVal lpFileName As _
String) As Long
Public Declare Function GetPrivateProfileString Lib _
"kernel32" Alias "GetPrivateProfileStringA" (ByVal _
lpApplicationName As String, ByVal lpKeyName As Any, _
ByVal lpDefault As String, ByVal lpReturnedString As _
String, ByVal nSize As Long, ByVal lpFileName As String) _
As LongPublic Const DRIVE_CDROM = 5 '磁盘类型常量--光驱为5'写INI函数
Public Function WriteIni(ByVal section As String, ByVal key As String, _
ByVal value As String) As Boolean
Dim x As Long, Buff As String * 128, I As Integer
Buff = value + Chr(0)
x = WritePrivateProfileString(section, key, Buff, App.Path + "\cd.ini")
WriteIni = x
End Function'读INI函数
Public Function ReadIni(ByVal section As String, ByVal key As String) As String
Dim x As Long, Buff As String * 128, I As Integer
x = GetPrivateProfileString(section, key, "", Buff, 128, App.Path + "\cd.ini")
I = InStr(Buff, Chr(0))
ReadIni = Trim(Left(Buff, I - 1))
End Function'****** 窗体代码：******Option ExplicitDim cdName As String '光驱盘符
Dim volName As String '光盘卷标
Dim Serial As String '光盘序列号Private Sub cmdAdd_Click()'添加光盘
Dim sR As StringOn Error GoTo ErrHandle
sR = Dir(cdName & "*.*")
Readcd '读取光盘信息
Call WriteIni("CDRom", volName, Serial)
Exit Sub
ErrHandle:
Exit SubEnd SubPrivate Sub cmdUnlock_Click()'保护/解除保护
Select Case cmdUnlock.Caption
Case "解除保护"
tmrCheck.Enabled = False
cmdUnlock.Caption = "保护模式"
Case "保护模式"
tmrCheck.Enabled = True
cmdUnlock.Caption = "解除保护"
End SelectEnd SubPrivate Sub Form_Load()Dim DrvN As Integer '驱动器的ASCII码
Dim DrvType As Integer '驱动器的类别
Dim n As IntegertmrCheck.Enabled = True
tmrCheck.Interval = 1000
tmrCd.Enabled = False
tmrCd.Interval = 1'获取光驱盘符
DrvN = Asc("c")
For n = 0 To 10
DrvN = DrvN + 1
DrvType = GetDriveType(Chr(DrvN) & ":\")
If DrvType = 5 Then
cdName = Chr(DrvN) & ":\"
End If
NextIf cdName = "" Then '无光驱则退出
MsgBox "该计算机没有光驱，即将退出。"
End
End IfEnd SubPrivate Sub Readcd() '读取cd信息Dim Vol As String * 256 '卷标
Dim FatType As String * 256 'fat格式
Dim GetVal As Long '序列号
Dim TempLon1 As Long
Dim TempLon2 As Long
Call GetVolumeInformation(cdName, Vol, 256, _
GetVal, TempLon1, TempLon2, FatType, 256)volName = Vol: Serial = GetVal '给卷标、序列号赋值End SubPrivate Sub tmrCheck_Timer()Dim sR As StringOn Error GoTo ErrHandle
'用Dir函数检测光驱里是否有光盘
sR = Dir(cdName & "*.*") '若有光盘 
 
tmrCd.Enabled = True '则tmrCd有效
Exit Sub
ErrHandle: '若无则tmrCd无效
tmrCd.Enabled = FalseEnd SubPrivate Sub tmrCd_Timer()Dim MyStr As String, ReStr As LongReadcd
MyStr = ReadIni("CDRom", volName)
If Serial <> MyStr Then Call mciSendString("set CDAudio door open", ReStr, 127, 0)
Me.Caption = ReStr
tmrCd.Enabled = FalseEnd Sub四、运行程序
将工程保存在指定目录，即可运行程序。