用VB編寫一個光驅(qū)保鏢

2019-11-18 17:29:53

字體：大中小

供稿：網(wǎng)友

編程思路：當(dāng)光驅(qū)里有光盤，立即檢測此光盤是否已經(jīng)注冊，如不是，則彈出光驅(qū)，從而達(dá)到保護(hù)光驅(qū)的作用。

實(shí)現(xiàn)方法：
一.注冊光盤
利用INI配置文件記錄光盤的卷標(biāo)號和序列號，比如一張卷標(biāo)號為Sys、序列號為38972126的光盤，可在INI文件中在[CDRom]下按如下格式記錄：ys=38972126。
二.檢測光盤是否已經(jīng)注冊
用一個Timer控件監(jiān)視光驅(qū)里是否有光盤，若有，則激活另一個Timer控件，由它來檢測光驅(qū)里的光盤是否已經(jīng)注冊，然后進(jìn)行相關(guān)操作。
三.獲取光盤卷標(biāo)和序列號
用GetDriveType判斷光驅(qū)盤符、用GetVolumeInformation讀取光盤的卷標(biāo)和序列號。
四.彈出光驅(qū)
用mciSendString可對光驅(qū)的開、關(guān)進(jìn)行操作，格式如下：
CallmciSendString("setCDAudiodooropen",returnstring,127,0)

具體步驟：
一.新建標(biāo)準(zhǔn)EXE工程，給窗體繪制如下控件：

控件NameCaption
TimertmrCheck
TimertmrCd
命令按鈕cmdAdd注冊光盤
命令按鈕cmdUnlock解除保護(hù)

二、缺省添加一個標(biāo)準(zhǔn)模塊

三、編寫代碼如下——

'*******模塊代碼：******

OptionExplicit

'獲取磁盤類型的API
PublicDeclareFunctionGetDriveTypeLib"kernel32"Alias"GetDriveTypeA"_
(ByValnDriveAsString)AsLong
'獲取磁盤信息的API
PublicDeclareFunctionGetVolumeInformationLib"kernel32"Alias_
"GetVolumeInformationA"(ByVall(ByVallp applicationNameAsString,ByVallpKeyName_
AsAny,ByVallpStringAsAny,ByVallpFileNameAs_
String)AsLong
PublicDeclareFunctionGetPrivateProfileStringLib_
"kernel32"Alias"GetPrivateProfileStringA"(ByVal_
lpApplicationNameAsString,ByVallpKeyNameAsAny,_
ByVallpDefaultAsString,ByVallpReturnedStringAs_
String,ByValnSizeAsLong,ByVallpFileNameAsString)_
AsLong

PublicConstDRIVE_CDROM=5'磁盤類型常量--光驅(qū)為5

'寫INI函數(shù)
PublicFunctionWriteIni(ByValsectionAsString,ByValkeyAsString,_
ByValvalueAsString)AsBoolean
DimxAsLong,BuffAsString*128,IAsInteger
Buff=value Chr(0)
x=WritePrivateProfileString(section,key,Buff,App.Path "/cd.ini")
WriteIni=x
EndFunction

'讀INI函數(shù)
PublicFunctionReadIni(ByValsectionAsString,ByValkeyAsString)AsString
DimxAsLong,BuffAsString*128,IAsInteger
x=GetPrivateProfileString(section,key,"",Buff,128,App.Path "/cd.ini")
I=InStr(Buff,Chr(0))
ReadIni=Trim(Left(Buff,I-1))
EndFunction

'******窗體代碼：******

OptionExplicit

DimcdNameAsString'光驅(qū)盤符
DimvolNameAsString'光盤卷標(biāo)
DimSerialAsString'光盤序列號

PrivateSubcmdAdd_Click()

'添加光盤
DimsRAsString

OnErrorGoToErrHandle
sR=Dir(cdName&"*.*")
Readcd'讀取光盤信息
CallWriteIni("CDRom",volName,Serial)
ExitSub
ErrHandle:
ExitSub

EndSub

PrivateSubcmdUnlock_Click()

'保護(hù)/解除保護(hù)
SelectCasecmdUnlock.Caption
Case"解除保護(hù)"
tmrCheck.Enabled=False
cmdUnlock.Caption="保護(hù)模式"
Case"保護(hù)模式"
tmrCheck.Enabled=True
cmdUnlock.Caption="解除保護(hù)"
EndSelect

EndSub

PrivateSubForm_Load()

DimDrvNAsInteger'驅(qū)動器的ASCII碼
DimDrvTypeAsInteger'驅(qū)動器的類別
DimnAsInteger

tmrCheck.Enabled=True
tmrCheck.Interval=1000
tmrCd.Enabled=False
tmrCd.Interval=1

'獲取光驅(qū)盤符
DrvN=Asc("c")
Forn=0To10
DrvN=DrvN 1
DrvType=GetDriveType(Chr(DrvN)&":/")
IfDrvType=5Then
cdName=Chr(DrvN)&":/"
EndIf
Next

IfcdName=""Then'無光驅(qū)則退出
MsgBox"該計算機(jī)沒有光驅(qū)，即將退出。"
End
EndIf

EndSub

PrivateSubReadcd()'讀取cd信息

DimVolAsString*256'卷標(biāo)
DimFatTypeAsString*256'fat格式
DimGetValAsLong'序列號
DimTempLon1AsLong
DimTempLon2AsLong
CallGetVolumeInformation(cdName,Vol,256,_
GetVal,TempLon1,TempLon2,FatType,256)

volName=Vol:Serial=GetVal'給卷標(biāo)、序列號賦值

EndSub

PrivateSubtmrCheck_Timer()

DimsRAsString

OnErrorGoToErrHandle
'用Dir函數(shù)檢測光驅(qū)里是否有光盤
sR=Dir(cdName&"*.*")'若有光盤
tmrCd.Enabled=True'則tmrCd有效
ExitSub
ErrHandle:'若無則tmrCd無效
tmrCd.Enabled=False

EndSub

PrivateSubtmrCd_Timer()

DimMyStrAsString,ReStrAsLong

Readcd
MyStr=ReadIni("CDRom",volName)
IfSerial<>MyStrThenCallmciSendString("setCDAudiodooropen",ReStr,127,0)
Me.Caption=ReStr
tmrCd.Enabled=False

EndSub

四、運(yùn)行程序
將工程保存在指定目錄，即可運(yùn)行程序。

以上代碼在PWin98、VB6.0中文企業(yè)版環(huán)境下運(yùn)行通過。當(dāng)然，為使程序的可操作性更強(qiáng)，還有許多工作要做；如果您使用以上代碼編制了一個完美的光驅(qū)保鏢，請發(fā)給土人一個免費(fèi)的拷貝，謝謝！->

上一篇：趣味撞球--VB5應(yīng)用程序一例

下一篇：用VisualBasic與MS-Draw開發(fā)通用作圖軟件