用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 Long

Public 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 Explicit

Dim cdName As String ’光驱盘符

Dim volName As String ’光盘卷标

Dim Serial As String ’光盘序列号

Private Sub cmdAdd_Click()

’添加光盘

Dim sR As String

On Error GoTo ErrHandle

sR = Dir(cdName & "*.*")

Readcd ’读取光盘信息

Call WriteIni("CDRom", volName, Serial)

Exit Sub

ErrHandle:

Exit Sub

End Sub

Private Sub cmdUnlock_Click()

’保护/解除保护

Select Case cmdUnlock.Caption

Case "解除保护"

tmrCheck.Enabled = False

cmdUnlock.Caption = "保护模式"

Case "保护模式"

tmrCheck.Enabled = True

cmdUnlock.Caption = "解除保护"

End Select

End Sub

Private Sub Form_Load()

Dim DrvN As Integer ’驱动器的ASCII码

Dim DrvType As Integer ’驱动器的类别

Dim n As Integer

tmrCheck.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

Next

If cdName = "" Then ’无光驱则退出

MsgBox "该计算机没有光驱，即将退出。"

End

End If

End Sub

Private 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 Sub

Private Sub tmrCheck_Timer()

Dim sR As String

On Error GoTo ErrHandle

’用Dir函数检测光驱里是否有光盘

sR = Dir(cdName & "*.*") ’若有光盘

tmrCd.Enabled = True ’则tmrCd有效

Exit Sub

ErrHandle: ’若无则tmrCd无效

tmrCd.Enabled = False

End Sub

Private Sub tmrCd_Timer()

Dim MyStr As String, ReStr As Long

Readcd

MyStr = ReadIni("CDRom", volName)

If Serial <> MyStr Then Call mciSendString("set CDAudio door open", ReStr, 127, 0)

Me.Caption = ReStr

tmrCd.Enabled = False

End Sub

四、运行程序

将工程保存在指定目录，即可运行程序。

以上代码在PWin98、VB6.0中文企业版环境下运行通过。当然，为使程序的可操作性更强，还有许多工作要做；如果您使用以上代码编制了一个完美的光驱保镖，请发给土人一个免费的拷贝，谢谢！