自动播放vcd.frm

个人VB学习源码精选,自己学习时的一些编程小程序,希望对大家有帮助

VERSION 5.00
Object = "{22D6F304-B0F6-11D0-94AB-0080C74C7E95}#1.0#0"; "msdxm.ocx"
Begin VB.Form Form1 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   6165
   ClientLeft      =   150
   ClientTop       =   720
   ClientWidth     =   7575
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6165
   ScaleWidth      =   7575
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer Timer1 
      Left            =   3000
      Top             =   2760
   End
   Begin MediaPlayerCtl.MediaPlayer MediaPlayer1 
      Height          =   5895
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   7335
      AudioStream     =   -1
      AutoSize        =   0   'False
      AutoStart       =   -1  'True
      AnimationAtStart=   -1  'True
      AllowScan       =   -1  'True
      AllowChangeDisplaySize=   -1  'True
      AutoRewind      =   0   'False
      Balance         =   0
      BaseURL         =   ""
      BufferingTime   =   5
      CaptioningID    =   ""
      ClickToPlay     =   -1  'True
      CursorType      =   0
      CurrentPosition =   -1
      CurrentMarker   =   0
      DefaultFrame    =   ""
      DisplayBackColor=   0
      DisplayForeColor=   16777215
      DisplayMode     =   0
      DisplaySize     =   4
      Enabled         =   -1  'True
      EnableContextMenu=   -1  'True
      EnablePositionControls=   -1  'True
      EnableFullScreenControls=   0   'False
      EnableTracker   =   -1  'True
      Filename        =   ""
      InvokeURLs      =   -1  'True
      Language        =   -1
      Mute            =   0   'False
      PlayCount       =   1
      PreviewMode     =   0   'False
      Rate            =   1
      SAMILang        =   ""
      SAMIStyle       =   ""
      SAMIFileName    =   ""
      SelectionStart  =   -1
      SelectionEnd    =   -1
      SendOpenStateChangeEvents=   -1  'True
      SendWarningEvents=   -1  'True
      SendErrorEvents =   -1  'True
      SendKeyboardEvents=   0   'False
      SendMouseClickEvents=   0   'False
      SendMouseMoveEvents=   0   'False
      SendPlayStateChangeEvents=   -1  'True
      ShowCaptioning  =   0   'False
      ShowControls    =   -1  'True
      ShowAudioControls=   -1  'True
      ShowDisplay     =   0   'False
      ShowGotoBar     =   0   'False
      ShowPositionControls=   -1  'True
      ShowStatusBar   =   0   'False
      ShowTracker     =   -1  'True
      TransparentAtStart=   0   'False
      VideoBorderWidth=   0
      VideoBorderColor=   0
      VideoBorder3D   =   0   'False
      Volume          =   -600
      WindowlessVideo =   0   'False
   End
   Begin VB.Menu mnuControl 
      Caption         =   "控制(&C)"
      Begin VB.Menu mnuOpen 
         Caption         =   "弹出光驱(&E)"
      End
      Begin VB.Menu mnuClose 
         Caption         =   "关闭光驱(&L)"
      End
      Begin VB.Menu mnuQuit 
         Caption         =   "退出(&Q)"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private 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
Dim Result As Long
Dim ReturnString As String * 128

Private Sub Form_Load()
    Timer1.Enabled = True
    Timer1.Interval = 1000
End Sub

Private Sub mnuClose_Click()
    On Error Resume Next
    Result = mciSendString("set cdaudio door closed", ReturnString, 127, 0)
    Timer1.Interval = 1000
    Timer1.Enabled = True
End Sub

Private Sub mnuOpen_Click()
    On Error Resume Next
    MediaPlayer1.Stop
    MediaPlayer1.FileName = ""
    Result = mciSendString("set cdaudio door open", ReturnString, 127, 0)
End Sub

Private Sub mnuQuit_Click()
    Unload Form1
End Sub

Private Sub Timer1_Timer()
   Dim fs As New FileSystemObject, d, dc, sFile1, sFile2
   
    'Set fs = CreateObject("Scripting.FileSystemObject")
    Set dc = fs.drives
    For Each d In dc
        If d.drivetype = 4 Then
            sFile1 = d.driveletter + ":\mpegav\avseq01.dat"
            sFile2 = d.driveletter + ":\mpegav\music01.dat"
            If d.isready And fs.fileexists(sFile1) Then
                Timer1.Enabled = False
                Form1.Caption = sFile1
                MediaPlayer1.FileName = sFile1
                MediaPlayer1.Play
            End If
            If d.isready And fs.fileexists(sFile2) Then
                Timer1.Enabled = False
                Form1.Caption = sFile2
                MediaPlayer1.FileName = sFile2
                MediaPlayer1.Play
            End If
        End If
    Next
End Sub