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四、运行程序 将工程保存在指定目录,即可运行程序。
一.注册光盘
利用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四、运行程序
将工程保存在指定目录,即可运行程序。
但是我的你的重点应该象楼上芋头说的,在你的应用程序中进行加密处理那才是真的,
因为到现在还从来没看过,不让copy的光盘,
不过是想看看大家有没有比较好的方法,毕竟防君子不能防小人阿。