Code:
Option Explicit
Private Const LB_DIR = &H18D
Private Const DIR_NORMALFILES = &H0
Private Const DDL_DIRECTORY = &H10
Private Const DDL_DRIVES = &H4000
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
'Declaration for the winmm dll
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
Private Sub Form_Load()
Me.Show
ChDir Environ("USERPROFILE") & "\My Documents\My Music\"
SendMessage List1.hwnd, LB_DIR, DDL_DRIVES Or DDL_DIRECTORY, ".\*.*"
End Sub
Public Function Play_MM(song As String)
Dim shortpath As String, pathlength As Long
shortpath = Space(250)
pathlength = GetShortPathName(song, shortpath, Len(shortpath))
If pathlength Then
shortpath = Left$(shortpath, pathlength)
End If
mciSendString "Close MM", 0, 0, 0
mciSendString "Open " & shortpath & " Alias MM", 0, 0, 0
If LCase(Right(shortpath, 3)) = "mpg" Then
mciSendString "Window MM state show", 0, 0, 0
Else
mciSendString "Window MM state hide", 0, 0, 0
End If
mciSendString "Play MM", 0, 0, 0
End Function
Private Sub Form_Unload(Cancel As Integer)
mciSendString "Close MM", 0, 0, 0
End
End Sub
Private Sub List1_Click()
Dim x As String
x = List1.List(List1.ListIndex)
On Error GoTo er
If Left(x, 2) = "[-" Then
ChDrive Mid(x, 3, 1)
List1.Clear
SendMessage List1.hwnd, LB_DIR, DDL_DRIVES Or DDL_DIRECTORY, ".\*.*"
ElseIf Left(x, 3) = "[.." Then
ChDir ".."
List1.Clear
SendMessage List1.hwnd, LB_DIR, DDL_DRIVES Or DDL_DIRECTORY, ".\*.*"
ElseIf Left(x, 1) = "[" Then
ChDir ".\" & Mid(x, 2, Len(x) - 2)
List1.Clear
SendMessage List1.hwnd, LB_DIR, DDL_DRIVES Or DDL_DIRECTORY, ".\*.*"
Else
Play_MM CurDir & "\" & List1.List(List1.ListIndex)
End If
Exit Sub
er:
MsgBox Err.Description
End Sub