|
|
本帖最后由 hyy514 于 2012-11-5 00:48 编辑
分享个代码，有兴趣的朋友可以改进一下，
类模块代码：
| 代码: | Private Declare Function mciExecute Lib "winmm.dll" ( ByVal lpstrcommand As String ) As Long
Private url As String
Private sRe As String
Private arr() As String
Private MusicDt() As Mdata
Private bAc As Boolean
Public Property Get GetMusicData() As Mdata()
GetMusicData = MusicDt
End Property
Public Sub Play( ByVal url As String )
If Len(GetAct) Then
Stopting
End If
mciExecute "open " & url
mciExecute "play " & url
Application.Names.Add "a", url, False
End Sub
Public Sub Pause()
If Len(GetAct) Then
bAc = IIf(bAc, False, True)
If bAc Then
mciExecute "Pause " & GetAct
Else
mciExecute "play " & GetAct
End If
End If
End Sub
Sub Stopting()
If Len(GetAct) Then
mciExecute "play " & GetAct
mciExecute "close " & GetAct
Application.Names.Add "a", "", False
End If
End Sub
Public Sub InitMusicData(SongName As String )
Dim mDt() As Mdata
Dim sHost As String
Dim i As Integer
Dim n As Integer
sHost = NewHost
url = "http://www.9ku.com/getser.asp?key=" + SongName + "&page=1"
sRe = mGet(url)
arr = Split(sRe, "'")
arr = Split(arr(1), "||")
n = UBound (arr) - 1
ReDim mDt(n)
For i = 0 To n
mDt(i).d = Split(arr(i), "|")
mDt(i).d(4) = sHost + mDt(i).d(4)
Next
MusicDt = mDt
End Sub
Private Function NewHost() As String
url = "http://url.9ku.com/index.asp"
sRe = mGet(url)
arr = Split(sRe, "DzUrl=" + Chr(34))
NewHost = Split(arr(1), Chr(34))(0)
End Function
Private Function mGet(url As String ) As String
Dim Xml As Object
Set Xml = CreateObject("msxml2.xmlhttp")
Xml.Open "GET", url, False
Xml.Send
mGet = StrConv(Xml.ResponseBody, vbUnicode)
End Function
Private Function GetAct() As String
On Error Resume Next
Dim s As String
s = Application.Names("a").Value
If Len(s) Then
GetAct = Split(s, Chr(34))(1)
End If
End Function
Private Sub Class_Terminate()
Stopting
End Sub
|
调用见示例：
Music.rar
(18.26 KB, 下载次数: 270)
|
评分
-
1
查看全部评分
-
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2012-11-5 00:12
