VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - 在Visual Basic 6.0中实现自动播放VCD
发表评论(0)作者:, 平台:, 阅读:10061, 日期:2000-03-12
题目:在Visual Basic 6.0中实现自动播放VCD

subject: Design a program to play VCD automatically

作者:陈沛



《超级解霸》等VCD播放软件一般都有个按钮或菜单选项,叫做“播放VCD”,

单击即可自动播放VCD影片。如果文件路径是固定的, 那只用多媒体控件(

mmcontrol)

即可实现,但对于不同电脑来说,因为硬盘的逻辑分区数量不同,光盘机的路径很

可能是不同的。它到底是怎样实现的呢?下面,请看我详细分析:


用“regedit.exe”查看Windows98的注册表中光盘机的属性项(

hkey_local_machine,

enum, scsi),比较硬盘机的属性项(hkey_local_machine, enum, esdi)和软盘



的属性项(hkey_local_machine, enum, flop),就可发现:不同的盘体,是用

“devicetype”这个参数来区别的,硬盘的devicetype是“0”, 软盘是“0a”,

光盘机是“5”。再用“devicetype”为关键字,查找有关win32 API的编程手册,

就可得到辨别不同盘体的函数“getdevicetype”了。


有了这个函数,使用以下句子,即可得到光盘机盘符:


If GetDriveType("d:\") <> 5 Then

If GetDriveType("e:\") <> 5 Then

If GetDriveType("f:\") <> 5 Then

If GetDriveType("g:\") <> 5 Then

drivecd = "H"

GoTo getcdfiles

End If

drivecd = "G"

GoTo getcdfiles

End If

drivecd = "F"

GoTo getcdfiles

End If

drivecd = "E"

GoTo getcdfiles

Else

drivecd = "D"

End If

getcdfiles:


程序使用穷举法,依次判断D、E、F、G盘的devicetype是否为“5”,都不是

则光盘机

为H(盘符超过H的机器不多,所以穷举到此为止),得到的“drivecd”就是光盘机

盘符。



因为所有VCD影片的路径都是\mpegav\,所以用VB函数"Dir()"便可得到完整的

播放路径:

MMControl1.FileName = drivecd & ":\Mpegav\" & Dir(drivecd & ":\Mpegav\*.

dat")。


以下源程序,具体实现了自动播放VCD。程序窗体中只有一个多媒体控件——

MMcontrol1,

程序一旦运行即从第一个文件开始自动播放,按多媒体控件上的“next”键,播放

下一个文件。


'声明GetDriveType函数

Private Declare Function GetDriveType Lib "kernel32" Alias "

GetDriveTypeA" _

(ByVal nDrive As String) As Long

Dim files() As String

Dim drivecd As String

Dim i As Integer

Dim j As Integer


Private Sub Form_Load()

'判断光盘机盘符

If GetDriveType("d:\") <> 5 Then

If GetDriveType("e:\") <> 5 Then

If GetDriveType("f:\") <> 5 Then

If GetDriveType("g:\") <> 5 Then

drivecd = "H"

GoTo getcdfiles

End If

drivecd = "G"

GoTo getcdfiles

End If

drivecd = "F"

GoTo getcdfiles

End If

drivecd = "E"

GoTo getcdfiles

Else

drivecd = "D"

End If


'将所有VCD文件放入数组files()

getcdfiles:

On Error GoTo cderr:

s = Dir(drivecd & ":\Mpegav\*.dat")

i = 1

While s <> ""

ReDim Preserve files(i) As String

files(i) = s

i = i + 1

s = Dir()

Wend

j = 1

Call vcdplay



On Error GoTo 0

Exit Sub

cderr:

MsgBox "CD is not ready!"

Unload Me

End Sub


'判断是否播放下一个文件

Private Sub MMControl1_StatusUpdate()

If MMControl1.Position = MMControl1.Length Then

j = j + 1

If j > i - 1 Then j = 1

Call vcdplay

End If

End Sub


'播放VCD文件

Private Sub vcdplay()

MMControl1.Command = "stop"

MMControl1.Command = "close"

MMControl1.FileName = drivecd & ":\Mpegav\" & files(j)

MMControl1.Command = "open"

MMControl1.Command = "play"

End Sub


以上程序在中文Windows98,Visual Basic 6.0上通过。