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中文企业版环境下运行通过。当然，为使程序的可操作性更强，还有许多工作要做；如果您使用以上代码编制了一个完美的光驱保镖，请发给土人一个免费的拷贝，谢谢！
本文章更多内容：<<上一页 - 1 - 2 |
您的位置：逆风者
→ VB
→ 正文
本文章所属分类：首页
→ VB