common.bas

mp3播放器软件

Attribute VB_Name = "common"
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/03/15
'描    述：网页搜索音乐播放器  Ver 1.1.0
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Option Explicit
Public X1, Y1 As Integer  '用于窗体移动
Public Song As Integer  '储存当前 播放的歌曲 位置
Public Songname As String '储存当前 播放的歌曲名称
Public Songpath As String '储存当前 播放的歌曲 路径
Public MOVL(2) As Boolean '储存文件列表窗体是否随主窗体移动
Public Mm As Double   '调整秒钟 用于调整歌词现实速度

Public m_lngSel            As Long      '当前播放的音乐
Public nowTab As Integer                '当前Tab ID

Public firstPlay As Boolean     '开始播放
Public modeType As Integer      '排序方式0、单曲播放。1、单曲循环。2、顺序播放。3、列表循环。4、随机播放

'以下是歌词下载函数
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long _
) As Long

Public Function DownloadFile(ByVal strURL As String, ByVal strFile As String) As Boolean '下载歌词过程
    Dim lngReturn As Long
    lngReturn = URLDownloadToFile(0, strURL, strFile, 0, 0)
    If lngReturn = 0 Then DownloadFile = True
End Function

Public Sub Lrc(Path1 As String, Name As String)   '显示歌词 "模块"
    'On Error GoTo End1
    Dim T As String
    Dim R As String
    Dim h As Integer
    Dim I
    Dim a
    Dim b
    Dim ph(2) As String
up1:
    If Path1 <> "" Then
       ph(0) = Path1 & Name & ".lrc"
    Else
       ph(0) = App.path & "\Lrc\" & Name & ".lrc"
    End If
    
    ph(1) = App.path & "\Lrc\" & Name & ".lrc"
    If Dir(ph(0)) <> "" Then ph(2) = ph(0): GoTo next1
    If Dir(ph(1)) <> "" Then ph(2) = ph(1): GoTo next1    '以上两行 是 播放文件 位置 存在同文件 的歌词文件 则执行下一过程 跳过下载
    If Dir(App.path & "\lrc\" & frmMain.MP.currentMedia.Name & ".lrc") <> "" Then ph(2) = App.path & "\lrc\" & frmMain.MP.currentMedia.Name & ".lrc": GoTo next1
    
    '---------------------------以下是 下载歌词
     If DownloadFile("http://mp3.baidu.com/m?f=ms&rn=10&tn=baidump3lyric&ct=150994944&word=" + Name + " &lm=-1", "c:\LRC.html") = True Then
        Close #1
       Open "c:\lrc.html" For Input As #1
            Do Until EOF(1)
              Line Input #1, T
                If InStrRev(T, "lrc") > 0 Then R = T: Exit Do
            Loop
            Close #1
    End If
    If R = "" Then frmLrc.Text2 = "歌词下载失败": Exit Sub
    If DownloadFile(Mid(R, InStrRev(R, "href=") + 6, InStrRev(R, ".lrc") - InStrRev(R, "href=") - 2), App.path & "\lrc\" & Name & ".lrc") = True Then
       frmLrc.Text2 = "歌词下载成功"
       GoTo up1
    End If   '下载歌词并显示歌词 完成
    
    '--------------------以下是将 歌词 显示出来
next1:
      For a = 1 To 5
      frmMain.List1.AddItem "          "  '歌词隐藏列表前后添加 5 行
      Next a
      Close #1
    Open ph(2) For Input As #1
    Do Until EOF(1)
      Line Input #1, a
      If Len(Trim(a)) > 7 Or InStrRev(a, "[") > 0 Then
      For b = 1 To InStrRev(a, "[")
       If InStr(b, a, "[") = b Then
          frmMain.List1.AddItem Mid(a, InStr(b, a, "[") + 1, 5) & Mid(a, InStrRev(a, "]") + 1, Len(a) - InStrRev(a, "]"))
          frmLrc.L1.Caption = Mid(a, InStrRev(a, "]") + 1, Len(a) - InStrRev(a, "]")) '获取歌词宽度
          If frmLrc.L1.Width > 4000 Then h = frmLrc.L1.Width '比较歌词宽度
       End If
      Next
      End If
    Loop
    Close #1
    If h > 4000 Then          '设置歌词宽度
        frmLrc.Text1.Width = h + 200
        frmLrc.Text2.Width = frmLrc.Text1.Width - 80
        frmLrc.Width = frmLrc.Text1.Width + 300
    Else                                      '根据歌词长度重新排列显示窗体和显示字体位置
        frmLrc.Text1.Width = 3750
        frmLrc.Text2.Width = 3660
        frmLrc.Text1.Left = 120
        frmLrc.Text2.Left = 160
        frmLrc.Width = 4020
    End If
    frmLrc.Text1.Text = ""
     For I = 0 To 9 '显示歌词的 后 5 句
        frmLrc.Text1.Text = frmLrc.Text1.Text & Mid(frmMain.List1.list(I), 6, Len(frmMain.List1.list(I)) - 5) & vbNewLine & vbNewLine & vbNewLine
     Next
      '--------------------------------- 歌词 End
End1:
    Exit Sub
End Sub



'添加文件到播放列表
Public Sub addMusic(ID As Integer, title As String, Artist As String, time As String, FileName As String, toPlay As Boolean)
    Dim lngItem As Long
    With frmList.playlist
        lngItem = .AddItem()
        .ItemText(lngItem, 0) = ID & "."              '歌名
        .ItemText(lngItem, 2) = title              '歌名
        .ItemText(lngItem, 4) = Artist              '歌手
        .ItemText(lngItem, 6) = time              '时间
        .ItemText(lngItem, 7) = FileName              '文件名
        
        '直接播放
        If toPlay Then
            frmMain.Timer1.Enabled = False
            firstPlay = True
            
            frmMain.MP.Controls.stop
            frmMain.MP.url = .ItemText(.itemCount - 1, 7)
            m_lngSel = Song
            
            Song = .itemCount - 1
            frmMain.MP.Controls.play
        End If
        '.ToolTipText = Title
    End With
End Sub

'添加单个文件
Public Sub addSingle(FileName As String)
    Dim musicTag As musicTag
    Dim title As String
    Dim Artist As String
    title = ""
    Artist = ""
    If FileName <> "" Then
        musicTag.FileName = FileName
        If GetMusicInfo(musicTag) Then
            title = musicTag.title
            Artist = musicTag.Artist
        Else
            title = GetFileName(FileName)
        End If
        
        title = Replace(title, """", "")
        
        Artist = Replace(Artist, """", "")
        addMusic frmList.playlist.itemCount + 1, title, Artist, "00:00", FileName, False
    End If
End Sub