Option Explicit
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType _
As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal _
samDesired As Long, phkResult As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Const WINAMP_REG_KEY = "WinAmp.File\shell\play\command"
Private Const KEY_QUERY_VALUE = &H1
Public Sub LoadPlayList(LB As ListBox, PlayList As String)
Dim WholePlayList As String, Field As String
Dim sLines() As String, sFile() As String
Dim i As Integer
Open PlayList For Input As #1
WholePlayList = Input(LOF(1), 1)
Close #1
WholePlayList = CorrectPlayList(WholePlayList)
LB.Clear
sLines = Split(WholePlayList, vbCrLf)
For i = 0 To UBound(sLines) - 1
sLines(i) = Replace(sLines(i), Chr$(0), "")
sFile = Split(sLines(i), "%%%")
If UBound(sFile) = 0 Then
ReDim Preserve sFile(UBound(sFile) + 1)
sFile(1) = sFile(0)
sFile(0) = ""
End If
With LB
'.AddItem sFile(0)
If Mid$(sFile(1), 2, 1) = ":" Or Left$(sFile(1), 2) = "\\" Then
'it includes the path of the file
.AddItem sFile(1)
Else
If Left$(sFile(1), 1) = "\" Then
'It is on the same drive as the WinAmp
Field = Left$(GetWinampPath, 2)
.AddItem Field & sFile(1)
Else
'It is on the same path as the playlist
.AddItem GetPath(PlayList) & sFile(1)
End If
End If
End With
Next i
End Sub
Private Function GetWinampPath() As String
Dim A As Integer
GetWinampPath = GetWinampPathAndExeFile
A = 1
Do While InStr(A + 1, GetWinampPath, "\")
A = A + 1
Loop
GetWinampPath = Left(GetWinampPath, A)
End Function
Private Function GetWinampPathAndExeFile() As String
'Finds the path of winamp
Dim WinampPath As String
WinampPath = RegGetString(HKEY_CLASSES_ROOT, WINAMP_REG_KEY, "")
If Len(WinampPath) < 8 Then GetWinampPathAndExeFile = "": Exit Function
WinampPath = Mid(WinampPath, 2, Len(WinampPath) - 7)
GetWinampPathAndExeFile = WinampPath
End Function
Private Function CorrectPlayList(All As String) As String
Dim ExtInf As Long, Enter As Long
Dim comma As Double
Dim sLines() As String
Dim i As Long, Last As Long
All = Mid$(All, 10)
sLines = Split(All, vbCrLf)
Last = UBound(sLines) - 1
All = ""
For i = 0 To Last
ExtInf = InStr(sLines(i), "#EXTINF")
If ExtInf Then
comma = InStr(ExtInf, sLines(i), ",")
sLines(i) = Mid$(sLines(i), comma + 1)
sLines(i) = sLines(i) & "%%%" & sLines(i + 1)
All = All & sLines(i) & vbCrLf
i = i + 1
Else
comma = InStr(UCase$(sLines(i)), ".MP")
sLines(i) = Left$(sLines(i), comma - 1) & "%%%" & sLines(i)
All = All & sLines(i) & vbCrLf
End If
Next i
CorrectPlayList = All
End Function
Private Function RegGetString$(hInKey As Long, ByVal subkey$, ByVal valname$)
Dim RetVal$, hSubKey As Long, dwType As Long, SZ As Long, v$, R As Long
RetVal$ = ""
R = RegOpenKeyEx(hInKey, subkey$, 0, KEY_QUERY_VALUE, hSubKey)
If R <> 0 Then Exit Function
SZ = 256
v$ = String$(SZ, 0)
R = RegQueryValueEx(hSubKey, valname$, 0, dwType, ByVal v$, SZ)
If R = 0 And dwType = 1 Then
RetVal$ = Left(v$, SZ - 1)
Else
RetVal$ = ""
End If
If hInKey = 0 Then R = RegCloseKey(hSubKey)
RegGetString$ = RetVal$
End Function
Private Function GetPath(Path As String) As String
Dim i As Integer
For i = Len(Path) To 1 Step -1
If Mid$(Path, i, 1) = "\" Then Exit For
Next i
GetPath = Left$(Path, i)
End Function
Private Sub Form_Load()
LoadPlayList List1, "C:\Downloaded Files\MP3\MP3.m3u"
End Sub
