Keskustelu: Ohjelmointikysymykset: VB.NET: Musiikkitiedostojen tietojen muokkaus

' Projektiin referenssi:
' Guitar Tab Grabber Library
' (C:\WINDOWS\System32\NeoGTGrabber.Tlb)

'Formille nappi & 3 textbox'ia (song, artist & txtTab)
'txtTab: MultiLine = True; ScrollBars = ScrollBarsVertical
Private Sub Command1_Click()

    txtTab = ""

    If song = "" Then
        song.SetFocus: Exit Sub
    End If

    If artist = "" Then
        artist.SetFocus: Exit Sub
    End If

    Dim TabGrabber As New NeoGTGrabber.GTClass
    txtTab = TabGrabber.GetTab(song, artist)

End Sub

Private strFile As String

Private Sub CommandButton1_Click()

   If WindowsMediaPlayer1.Status <> "" Then
      WindowsMediaPlayer1.Close
      song = ""
      artist = ""
      TextBox1.Text = ""
   End If

   Dim filename As Variant

   filename = Application.GetOpenFilename( _
   "Windows Media Audio (*.wma), *.wma")

   If filename = "False" Then
      Exit Sub
   End If

   If Dir(filename) = "" Then
      Exit Sub
   End If

   Open filename For Binary As 1#
   strFile = Space(LOF(1))
   Get #1, , strFile: Close #1
   strFile = FixStrFile(strFile)
   WindowsMediaPlayer1.URL = filename


End Sub

Private Function FixStrFile(ByVal fstr As String) As String

   Dim bstr(0) As String

   For i = 1 To LenB(fstr)

      Select Case Asc(Chr(AscB(MidB(strFile, i, 1))))
      Case 64
         Exit For
      Case 32, 34, 40 To 41, 44 To 46, _
      48 To 58, 65 To 90, 97 To 122
         bstr(0) = _
         bstr(0) + Chr(AscB(MidB(fstr, i, 1)))
      End Select

   Next i

   FixStrFile = bstr(0): Erase bstr

End Function


Private Sub UserForm_QueryClose( _
Cancel As Integer, CloseMode As Integer)

   If WindowsMediaPlayer1.Status <> "" Then
      WindowsMediaPlayer1.Close
   End If

   Application.Quit

End Sub

Private Sub WindowsMediaPlayer1_StatusChange()

   If InStr(WindowsMediaPlayer1.Status, "Toistetaan") > 0 Then

      Static cnt As Integer
      cnt = cnt + 1

      If cnt < 2 Then

         Dim strStatus As String

         strStatus = WindowsMediaPlayer1.Status
         strStatus = Replace(strStatus, "Toistetaan ", "")

         If InStr(strStatus, ":") Then
            strStatus = Left(strStatus, _
            InStr(strStatus, ":") - 1)
         End If

         strStatus = Trim(strStatus)

         Dim strArray() As String

         If InStr(strFile, strStaus) > 0 Then

            strArray() = Split(strFile, strStatus)
            strFile = strArray(UBound(strArray))
            Erase strArray
            If InStr(strFile, ", composer") > 0 Then
               strArray = Split(strFile, ", composer")
               strFile = Trim(strArray(LBound(strArray)))
               Erase strArray
            End If
         End If

         artist = strFile

         song = strStatus
         song = Replace(song, "Toistetaan ", "")
         song = Replace(song, ":", "")
         song = Replace(song, "'", "")


         If InStr(song, "(") Then
            song = Left(song, InStr(song, "(") - 1)
            song = Trim(song)
         End If

         If InStr(song, """") Then
            song = Left(song, InStrRev(song, """"))
            song = Replace(song, """", "")
            song = Trim(song)
         End If

         Dim TabGrabber As New Class1
         TextBox1.Text = TabGrabber.GetTab(song, artist)

      Else
         cnt = 0
      End If

   End If

End Sub

Public Function GetTab(ByVal song As String, _
ByVal artist As String) As String

   Dim baseURL As String
   Dim the_Artist As String
   Dim the_Song As String
   Dim the_First_chr

   baseURL = "http://www.ultimate-guitar.com/tabs/"

   the_Song = LCase(Replace(song, " ", "_"))
   the_Artist = LCase(Replace(artist, " ", "_"))
   the_First_chr = Left(the_Artist, 1)

   Dim theUrl As String
   theUrl = baseURL & the_First_chr & _
   "/" & the_Artist & "/" & the_Song & "_tab.htm"

   Dim xhttp As WinHttp.WinHttpRequest
   Set xhttp = New WinHttp.WinHttpRequest

   On Error Resume Next
   xhttp.Open "GET", theUrl, False
   xhttp.SetRequestHeader "USER_AGENT", _
   "Mozilla/5.0 (Windows; U; Windows NT 5.1; " & _
   "fi; rv:1.9.0.13) Gecko/2009073022 " & _
   "Firefox/3.0.13 (.NET CLR 3.5.30729)"
   xhttp.Send
   xhttp.GetAllResponseHeaders
   Dim strResponse As String
   strResponse = xhttp.ResponseText
   Set xhttp = Nothing

   If InStr(strResponse, "Tabbed by:") > 0 Then

      Dim tab_beg As Long
      Dim tab_end As Long
      Dim tab_len As Long

      If InStr(strResponse, "<xmp>") > 0 Then
        tab_beg = InStr(strResponse, "<xmp>") + 5
      End If

      If InStr(strResponse, "</xmp>") > tab_beg Then
         tab_end = InStr(strResponse, "</xmp>")
      End If
      tab_len = tab_end - tab_beg

      If Err <> 0 Then
          GoTo Handler
      Else
         GetTab = Mid(strResponse, tab_beg, tab_len)
         Exit Function
      End If
   End If

Handler:
   Err.Clear
   On Error GoTo 0
   GetTab = _
   "No tab has been found for " & song & " / " & artist & "..."

End Function