Private Type tOptions
bPlayMp3 As Boolean
bDeleteId3v1 As Boolean
bDeleteId3v2 As Boolean
lStyles As eStyleGui
lIconSize As Boolean
End Type
Private Enum eLvSelectedItems
[eErrorItem] = 0
[eAll] = 1
End Enum
' \\ - Colecciones, clases
' -----------------------------------------------------------------------------------------------------
Private mColUrlsError As Collection
Private WithEvents mcFind As cFind
Private WithEvents mcSCLvFind As cSubclassListView
Private mcDownloads As cDownload
Private mcscLvDownload As cSubclassListView
Private mcscLvFiles As cSubclassListView
Private mcStyles As cStyles
Private mcToolTip As cToolTip
Private mcDlgs As cDlgs
Private mcMCI As cMCI
Private mcIcon As cIcon
Private mcIni As Cini
Private mcTimer As cTimer
Private mcSCToolBar As cSubclassToolBar
Implements WinSubHook2.iTimer
' \\ - Variables, arrays
' -----------------------------------------------------------------------------------------------------
Private mbKeyBack As Boolean
Private mTimerStatus As Boolean
Private mOptions As tOptions
Private mIniPath As String
Private mSelCurrentFileName As String
Private mTagsEdit As Boolean
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Carga de formulario
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub Form_Load()
Call mInitObjects ' Inicar clases y colecciones
Call mInitConfigPaths ' establecer rutas
Call mSetMenuValues ' establecer valores de menu
Call mSetStyle ' Configurar estilo del frm
Call mLoadIcons ' cargar iconos
Call mSetControlsValues ' establecer valores de controles y propiedades varias
Call mSetCtrlCaptions
Call mLoadUrlError ' cargar lista de url con errores
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Instanciar objetos
' ----------------------------------------------------------------------------------------------------------------------------------
Sub mInitObjects()
' Inicializar clases
Set mcFind = New cFind ' Para buscar y obtener las Urls
Set mcDownloads = New cDownload ' Colección con los archivos de descargas
Set mcStyles = New cStyles
Set mcToolTip = New cToolTip ' ToolTip
Set mcDlgs = New cDlgs ' Cuadros de diálogo
Set mcTimer = New cTimer ' Para el timer que actualiza los datos para las descargas
Set mcMCI = New cMCI
Set mcIni = New Cini
Set mcIcon = New cIcon
Set mcSCLvFind = New cSubclassListView ' para el Skin del Listview de resultados
Set mcscLvDownload = New cSubclassListView ' para el Skin del Listview de descargas
Set mcscLvFiles = New cSubclassListView ' para el Skin del Listview con descargas finalizadas
Set mcSCToolBar = New cSubclassToolBar
Set mColUrlsError = New Collection ' Almacenar direcciones urls con error
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Asignar los paths y leer valores del config.ini
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mInitConfigPaths()
mIniPath = App.Path & "\config.ini"
' definir paths para archivo temporal Html, y para guardar y escribir los mp3 en el disco
With mcFind
.TempPath = App.Path & "\data"
.HtmlPath = .TempPath & "temp.html"
.DownloadFolder = App.Path & "\download"
End With
' Cargar valores de configuración desde el archivo Ini
With mOptions
.bPlayMp3 = mcIni.getValue(mIniPath, "Reproducción", "PlayMp3", False)
.bDeleteId3v1 = mcIni.getValue(mIniPath, "Tags", "EliminarID3v1", False)
.bDeleteId3v2 = mcIni.getValue(mIniPath, "Tags", "EliminarID3v2", False)
.lIconSize = mcIni.getValue(mIniPath, "Iconos", "Tamaño", 0)
.lStyles = mcIni.getValue(mIniPath, "Estilo", "Estilo", 0)
' setear menus
' Alto y ancho de los íconos de los listview
If mOptions.lIconSize = True Then
mcIcon.HeightImage = 32
mcIcon.WidthImage = 32
End If
If mOptions.lIconSize = False Then
mcIcon.HeightImage = 16
mcIcon.WidthImage = 16
End If
End With
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Configurar valores checked para los menu
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mSetMenuValues()
With mOptions
' setear menus
mnuPlayOpt.Checked = .bPlayMp3
mnuSettingsTags(0).Checked = .bDeleteId3v1
mnuSettingsTags(1).Checked = .bDeleteId3v2
' Alto y ancho de los íconos de los listview
If mOptions.lIconSize = True Then mnuSizeIcons(1).Checked = True
If mOptions.lIconSize = False Then mnuSizeIcons(0).Checked = True
End With
' setear menus de estilos
Dim xMenu As Menu
For Each xMenu In mnuStyles
xMenu.Checked = False
Next
mnuStyles(CInt(mOptions.lStyles)).Checked = True
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Estilo de lfrm
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mSetStyle()
' Colección con las clases para subclasificar los Listview (para los Skin de los ColumnHeaders )
Dim ColSClassLv As New Collection
With ColSClassLv
.Add mcSCLvFind
.Add mcscLvDownload
.Add mcscLvFiles
End With
' Establecer estilo y esquema de colores
Call mcStyles.ChangeStyle(Me, ColSClassLv, cmdSearch, mcSCToolBar, CLng(mOptions.lStyles))
Set ColSClassLv = Nothing
' Subclasificar los listview
Call mcSCLvFind.SubClassListView(lvFind.hwnd)
Call mcscLvDownload.SubClassListView(lvDownloads.hwnd)
Call mcscLvFiles.SubClassListView(lvFiles.hwnd)
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Cargar los iconos de los lv en el imglist, y el de las pantallas
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mLoadIcons()
' setear el imagelist para los iconos de los listview
With imgList
.ImageHeight = mcIcon.HeightImage
.ImageWidth = mcIcon.WidthImage
.BackColor = lvFind.BackColor
' pic temporal para dibujar el ícono que luego se guarda en el imgList
picTemp.Width = .ImageWidth * 15
picTemp.Height = .ImageHeight * 15
Dim f As Integer
f = FreeFile
Dim sTempMp3 As String
sTempMp3 = mcFind.TempPath & "temp.mp3"
Open sTempMp3 For Output As f
Dim mMp3Icon As StdPicture
' Obtener el ícono Mp3 como un StdPicture
If mcIcon.HeightImage = 16 Then
Set mMp3Icon = mcIcon.GetFileIcon(sTempMp3, eSmall)
ElseIf mcIcon.HeightImage = 32 Then
Set mMp3Icon = mcIcon.GetFileIcon(sTempMp3, enormal)
End If
' agregarlo al control imgList
.ListImages.Add , "mp3", mMp3Icon
Set mMp3Icon = Nothing
' Cargar los otros íconos ( para descarga, error etc ..)
Call mFillImageList(App.Path & "\img\error.ico", mcDownloads.GetStatusText(eError))
Call mFillImageList(App.Path & "\img\Listo.ico", mcDownloads.GetStatusText(eFinished))
Call mFillImageList(App.Path & "\img\descargando.ico", mcDownloads.GetStatusText(eDownloading))
Call mFillImageList(App.Path & "\img\espera.ico", mcDownloads.GetStatusText(eNew))
End With
' Dibujar en los picbox los íconos de las pantallas ( Buscar y descargar )
With mcIcon
Call .DrawBitmapDC(App.Path & "\img\buscar.ico", picFind.hdc, 0, 0, 48, 48, picFind.Container.BackColor)
Call .DrawBitmapDC(App.Path & "\img\descargas.ico", picDown.hdc, 0, 0, 48, 48, picDown.Container.BackColor)
End With
Close f
If mcFind.CheckFileExists(sTempMp3) Then
On Local Error Resume Next
Kill sTempMp3
On Error GoTo 0
End If
Set mcIcon = Nothing
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Inicio de Propiedades varias de controles
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mSetControlsValues()
' deshabilitar txt de tags
Call mEnabledControls(False, "txtid3v1")
Call mEnabledControls(False, "txtid3v2")
Call mEnabledControls(False, "cboGen")
' Opciones de descarga asincrónica ( forzar actualización )
ucDownloadMp3.AsyncOptionDownload = vbAsyncReadResynchronize
ucDownHtml.AsyncOptionDownload = vbAsyncReadForceUpdate
' seleccionar la primer pantalla, y activar el primer botón del toolbar
With tbMain
.Buttons(1).Value = tbrPressed
Call tbMain_ButtonClick(.Buttons(1))
End With
Dim i As Integer
' cargar letras en el combo ( desde la A - Z )
With cboArtista
.AddItem "#"
For i = 97 To 122
.AddItem UCase(Chr(i))
Next
End With
' seleccionar el combo de directorios de Mp3
'lstDirectory.ListIndex = 0
Dim sGen As String
For i = 0 To 200
sGen = modInfoMp3.GetGenreName(i)
If sGen = vbNullString Then
Exit For
Else
cboGen(0).AddItem sGen
cboGen(1).AddItem sGen
End If
Next
cboGen(0).ListIndex = 0
cboGen(1).ListIndex = 1
lstDirectory.ListIndex = 0
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Sub para actualizar los datos en el Listview de transferencias de acuerdo al estado actual de cada archivo mp3
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mUpdateLvItems(sKey As String)
Dim xLvItem As ListItem
Dim xDownItem As cDownloadItem
' Referencia al item actual de la colección de archivos mp3
Set xDownItem = mcDownloads.Item(sKey)
' Comprobar que el item existe en la colección
If Not xDownItem Is Nothing Then
With xDownItem
Select Case .Status
' ----------------------------------------------------------------------------------------------------------------------------------
' Nueva descarga ( Agregar el lvItem en espera )
' ----------------------------------------------------------------------------------------------------------------------------------
Case eNew
' verificar que el item existe .. por las dudas
If mCheckExistLvItem(sKey, lvDownloads) Then
Set xLvItem = lvDownloads.ListItems(sKey)
xLvItem.Text = .Title
xLvItem.SubItems(1) = mcDownloads.GetStatusText(eNew)
End If
' ----------------------------------------------------------------------------------------------------------------------------------
' Finalizado
' ----------------------------------------------------------------------------------------------------------------------------------
Case eFinished
' verificar que el item No existe .. por las dudas ( Para agregarlo al listview de terminados )
If Not mCheckExistLvItem(.Key, lvFiles) Then
' agregar el item finalizado en el primer lugar
Set xLvItem = lvFiles.ListItems.Add(1, .Key, .Title)
' leer info mp3
Dim bRet As Boolean
tInfoMpg = tInfoMpg_c
bRet = modInfoMp3.ReadMPEGInfo(.FileName, tInfoMpg)
Else ' error ..salir y eliminarlo
If mCheckExistLvItem(.Key, lvDownloads) Then
lvDownloads.ListItems.Remove .Key
End If
Exit Sub
End If
' Ignorar archivos menores a 500 K
If bRet And (tInfoMpg.FileSize > 500000) Then
' verificar si hay que borrar los tags autmáticamente al descargar
If mOptions.bDeleteId3v1 Then
Call modInfoMp3.DeleteID3v1(.FileName)
End If
If mOptions.bDeleteId3v2 Then
Call modInfoMp3.DeleteID3v2(.FileName)
End If
' Agregar los datos del archivo finalizado
xLvItem.SubItems(1) = mcDownloads.GetStatusText(eFinished)
xLvItem.SubItems(2) = mcDownloads.GetFileSize(tInfoMpg.FileSize)
xLvItem.SubItems(3) = mcDownloads.GetFormatLenght(tInfoMpg.Length)
mcDownloads.Item(.Key).Status = eFinished
Else
mcDownloads.Item(.Key).Status = eError
xLvItem.SubItems(1) = mcDownloads.GetStatusText(eError)
If mcFind.CheckFileExists(.FileName) Then
On Error Resume Next
Kill .FileName
On Error GoTo 0
End If
'Agregar url con error
Call mAddUrlError(.Key)
End If
' eliminar el LvItem
If mCheckExistLvItem(.Key, lvDownloads) Then
lvDownloads.ListItems.Remove .Key
End If
' ----------------------------------------------------------------------------------------------------------------------------------
' Con error
' ----------------------------------------------------------------------------------------------------------------------------------
Case eError
' Eliminarlo del lv de transferencias
If mCheckExistLvItem(.Key, lvDownloads) Then
lvDownloads.ListItems.Remove .Key
End If
' Agregar mp3 con error ... en el Lv de finalizados
If Not mCheckExistLvItem(.Key, lvFiles) Then
Set xLvItem = lvFiles.ListItems.Add(1, .Key, .Title)
End If
'Agregar url con error
Call mAddUrlError(.Key)
' ----------------------------------------------------------------------------------------------------------------------------------
' Descargando
' ----------------------------------------------------------------------------------------------------------------------------------
Case eDownloading
If mCheckExistLvItem(.Key, lvDownloads) Then
Set xLvItem = lvDownloads.ListItems(.Key)
xLvItem.SubItems(1) = mcDownloads.GetStatusText(eDownloading)
xLvItem.SubItems(2) = .Percent
xLvItem.SubItems(3) = mcDownloads.GetFileSize(.FileSize)
End If
End Select
End With
End If
' Actualizar el ícono
If Not xLvItem Is Nothing Then
Call mUpdateSmallIcons(xLvItem)
End If
' Actualizar barra de estado
Call mUpdateStatusBar
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Asignar Caption de los controles (UcBtn) por que al compilar o por otro error vb en algún caso puede eliminar la propiedad Caption y otras. (Creo que si el Uc se compila en ves de usarlo como privado, no ocurre esto)
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mSetCtrlCaptions()
cmdSearch.Caption = "Buscar >>"
cmdPages(0).Caption = "<"
cmdPages(1).Caption = ">"
cmdDownloads(0).Caption = "Opciones >>"
cmdDownloads(1).Caption = "Opciones >>"
cmdTags.Caption = "Opciones >>"
cmdPrevMp3(0).Caption = "Play"
cmdPrevMp3(1).Caption = "Stop"
End Sub
Private Sub lvFiles_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
If Button <> vbLeftButton Then Exit Sub
Dim Item As ListItem
Set Item = lvFiles.HitTest(x, Y)
If Item Is Nothing Then Exit Sub
' si se editó algún campo, preguntar si se quiere guardar los cambios
If Me.TagsEdit Then
If MsgBox("Se han modificado los tags del archivo: " & mSelCurrentFileName & " . ¿ Guardar los cambios ?", vbQuestion + vbYesNo) = vbYes Then
Call mnuTags_Click(0)
End If
End If
' Leer los tags
If Item.SmallIcon = mcDownloads.GetStatusText(eError) Then
Call mClearInfoMp3
Call mEnabledControls(False, "txtId3v1")
Call mEnabledControls(False, "txtId3v2")
Call mEnabledControls(False, "cboGen")
mSelCurrentFileName = ""
Me.TagsEdit = False
Else
mSelCurrentFileName = mcFind.DownloadFolder & Item.Text
Call mClearInfoMp3
Call mEnabledControls(True, "txtId3v1")
Call mEnabledControls(True, "txtId3v2")
Call mEnabledControls(True, "cboGen")
Call mLoadInfoMp3(Item)
Call mShowTagInfo
Me.TagsEdit = False
End If
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Evento cuando se termina de obtener las Urls
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mCFind_EndGetUrlsMp3()
On Error GoTo err_handler
Dim xLvItem As ListItem
Dim i As Long
Dim J As Integer
' Limpiar listview
lvFind.ListItems.Clear
' REcorrer la colección de Urls
For i = 1 To mcFind.Count
' Agregar al listview de resultados
With mcFind.Item(i)
Set xLvItem = lvFind.ListItems.Add(, .Url, .Title, , "mp3")
xLvItem.SubItems(1) = .Url
End With
Next
' Eliminar items con error
On Error Resume Next
Dim sKey As String
For i = 1 To mColUrlsError.Count
sKey = mColUrlsError.Item(i).Key
Call mcFind.Delete(sKey)
lvFind.ListItems.Remove sKey
Next
On Error GoTo 0
' No hubo resultados
With mcFind
If .Count = 0 Then
MsgBox "No se encontraron archivos para el término: " & txtSearch.Text, vbInformation, "Resultado de búsqueda"
lblNumPage.Caption = "1"
lblResult.Caption = vbNullString
lblCurrentFile.Caption = ""
Else ' mostrar resultados
lblResult.Caption = "Archivos encontrados: " & "( " & CStr(.Count) & " )"
lblCurrentFile.Caption = " > Búsqueda actual: " & txtSearch.Text
End If
End With
Me.MousePointer = 0
Exit Sub
err_handler:
Me.MousePointer = 0
MsgBox Err.Description, vbCritical, "Error en EndGetUrls"
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Evento - Antes de obtener las Urls
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mCFind_StartSearchMp3s(ByVal sUrl As String)
Me.MousePointer = vbHourglass
With lvFind
.ListItems.Clear
End With
' Cancelar la descarga previa de otra búsqueda
With ucDownHtml
Call .CancelAllDownload
' descargar Html
Call .Download(sUrl) ' Sigue en ucDownHtml_Finished
End With
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Sub para agregar los íconos al imgList
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mFillImageList(sFileName As String, sKey As String)
With imgList
mcIcon.DrawBitmapDC sFileName, picTemp.hdc, 0, 0, mcIcon.WidthImage, mcIcon.HeightImage, lvFind.BackColor
picTemp.Picture = picTemp.Image
.ListImages.Add , sKey, picTemp.Image
picTemp.Cls
picTemp.Picture = LoadPicture("")
End With
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Botón para comenzar la búsqueda de Mp3s
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub cmdSearch_Click()
If Trim(txtSearch.Text) = "" Then
Exit Sub
ElseIf lstDirectory.ListIndex = -1 Then
MsgBox "Falta seleccionar un directorio de la lista", vbExclamation, "Directorio"
Else
lblNumPage.Caption = "1"
With mcFind
' Si ya se estaba buscando, ... cancelar la descarga del html
ucDownHtml.CancelAllDownload
' Buscar ( Artista, directorio, número de página )
Call .FindMp3(txtSearch.Text, lstDirectory.ListIndex, CInt(lblNumPage.Caption))
End With
End If
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Cancelar todos los Downloads actuales ( Preguntando o sin preguntar )
' ----------------------------------------------------------------------------------------------------------------------------------
Private Function mCancelAll(showDialog As Boolean) As Boolean
If showDialog Then
If MsgBox("Detener ?", vbQuestion + vbYesNo) = vbNo Then
Exit Function
End If
End If
ucDownloadMp3.CancelAllDownload ' artchivos Mp3
ucDownHtml.CancelAllDownload ' Página Html
mCancelAll = True
End Function
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Mostrar menú popup para el listview de búsqueda
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub lvFind_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
Call mShowLVPopUpMenu(Button, mnuFindOptions, lvFind, x, Y)
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Eliminar los items con error y el archivo txt con la lista de urls
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mnuDeleteErrorUrls_Click()
On Error GoTo error_handler
If mColUrlsError.Count = 0 Then
MsgBox "No hay Urls con error para eliminar", vbInformation
Else
If mcFind.CheckFileExists(mcFind.TempPath & "url_error.txt") Then
Kill mcFind.TempPath & "url_error.txt"
MsgBox "Se eliminaron " & CStr(mColUrlsError.Count) & " direcciones url", vbInformation
End If
Set mColUrlsError = Nothing
Set mColUrlsError = New Collection
End If
Exit Sub
error_handler:
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Menú de opciones ´para la pantalla de búsqeuda
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mnuOptionsFind_Click(Index As Integer)
Dim xItem As ListItem
If lvFind.MultiSelect = False Then lvFind.MultiSelect = True
' recorrer todos los items
For Each xItem In lvFind.ListItems
Select Case Index
' Descargar
Case 0
If xItem.Selected Then
Call mAddNewDownload(xItem)
End If
' seleccionar todo
Case 2
xItem.Selected = True
End Select
Next
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Opción de menú ( Reproducir con el programa predeterminado, o usando MCI )
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mnuPlayOpt_Click()
With mnuPlayOpt
.Checked = Not .Checked
mOptions.bPlayMp3 = CBool(.Checked) ' guardar valor para después usarlo en el Unload del form
End With
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Opción de menú Para eliminar tags automáticamente al descargar los archivos
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mnuSettingsTags_Click(Index As Integer)
Select Case Index
' v1
Case 0
mnuSettingsTags(0).Checked = Not mnuSettingsTags(0).Checked
mOptions.bDeleteId3v1 = CBool(mnuSettingsTags(0).Checked)
' v2
Case 1
mnuSettingsTags(1).Checked = Not mnuSettingsTags(1).Checked
mOptions.bDeleteId3v2 = CBool(mnuSettingsTags(1).Checked)
End Select
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Opción de menú Para el tamaño de íconos ( 16 o 32 pix)
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mnuSizeIcons_Click(Index As Integer)
mnuSizeIcons(0).Checked = False
mnuSizeIcons(1).Checked = False
mnuSizeIcons(Index).Checked = True
If mnuSizeIcons(0).Checked Then
mOptions.lIconSize = False
End If
If mnuSizeIcons(1).Checked Then
mOptions.lIconSize = True
End If
MsgBox "Para visualziar los cambios se debe reiniciar el programa", vbInformation
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Opción de menú Para cambiar los estilos
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mnuStyles_Click(Index As Integer)
mOptions.lStyles = Index
If MsgBox("Para cambiar el estilo hay que reiniciar el programa. ¿ Salir ?", vbQuestion + vbYesNo) = vbYes Then
Unload Me
End If
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - PicBox con la cabececera de Tags
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub picBoxTitle_Resize()
With picBoxTitle
.Cls
Call cmdSearch.DrawSkin(.hdc, (.ScaleWidth / 15) - 2, (.ScaleHeight / 15) - 2, TS_NORMAL)
.CurrentX = 120
.CurrentY = 90
picBoxTitle.Print "Información del archivo :"
End With
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - ToolBar - Opciones
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub tbMain_ButtonClick(ByVal Button As MSComctlLib.Button)
With picBoxMain
Select Case Button.Index
Case 1: .Item(0).ZOrder 0 ' pantalla Buscar
Case 2: .Item(1).ZOrder 0 ' pantalla transferencias
Case 4
Me.PopupMenu mnuSettings, , Button.Left, Button.Top + Button.Height
mcSCToolBar.Refresh
Case 6
Call mcFind.FileOpen(Me.hwnd, App.Path & "\Download") ' Abrir carpeta de descargas
End Select
End With
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Setear variable a False para cuando se selecciona un fichero con error
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub txtId3v1_KeyPress(Index As Integer, KeyAscii As Integer)
Me.TagsEdit = CBool(Len(mSelCurrentFileName))
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Setear variable a False para cuando se selecciona un fichero con error
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub txtId3v2_KeyPress(Index As Integer, KeyAscii As Integer)
Me.TagsEdit = CBool(Len(mSelCurrentFileName))
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Eventos del Textbox para autocompletar al escribir
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub txtSearch_Change()
Call AutoCompletar_TextBox(txtSearch)
Dim bRet As Boolean
' deshabilitar botones cuando no hay texto
bRet = Len(txtSearch.Text)
cmdSearch.Enabled = bRet
cmdPages(0).Enabled = bRet
cmdPages(1).Enabled = bRet
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Seleccionar todo el texto al hacer doble clic en el textbox para buscar
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub txtSearch_DblClick()
With txtSearch
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
Private Sub txtSearch_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyBack, vbKeyDelete
Select Case Len(txtSearch.Text)
Case Is <> 0
mbKeyBack = True
End Select
End Select
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - escribir en disco el Html al finalizar la descarga
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub ucDownHtml_Finished(x As AsyncProperty)
On Error GoTo error_handler
With mcFind
' Descarga Ok
If x.StatusCode = vbAsyncStatusCodeEndDownloadData Then
Call mSaveData(x.Value, .TempPath & "temp.html") ' guardar Html
Call .GetUrlsMp3(.TempPath & "temp.html") ' Llnear colección con las Urls ( sigue en EndGetUrls )
' Descarga con error
Else
If mcFind.CheckConnection = False Then
MsgBox "No se detectó conexión a internet", vbCritical
Else
MsgBox "No se pudo completar la búsqueda. Pruebe realizando una nueva, o reiniciando el programa", vbCritical
End If
Me.MousePointer = 0
End If
' Eliminar archivo Html
If mcFind.CheckFileExists(.TempPath & "temp.html") Then
Kill .TempPath & "temp.html"
End If
End With
Exit Sub
error_handler:
If App.LogMode = 0 Then MsgBox Err.Description, , "ucDownHtml_Finished"
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Crear archivo y guardar los datos ( se llama desde el evento Finished de los controles de descarga )
' ----------------------------------------------------------------------------------------------------------------------------------
Function mSaveData(vData() As Byte, sUrlPath As String) As Boolean
On Error GoTo error_handler
' Abrir archivo
Dim nFileNumber As Long
nFileNumber = FreeFile
Open sUrlPath For Binary Access Write As nFileNumber
' Escribir el array de bytes para crear el archivo
Put nFileNumber, , vData
Close nFileNumber
mSaveData = True
error_handler:
End Function
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Evento de finalización de una descarga Mp3
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub ucDownloadMp3_Finished(x As AsyncProperty)
' Descarga Ok
If x.StatusCode = vbAsyncStatusCodeEndDownloadData Then
If mSaveData(x.Value, mcDownloads.Item(x.PropertyName).FileName) Then
' Guardar el estado
mcDownloads.Item(x.PropertyName).Status = eFinished
' Actualizar el listview de descargas
Call mUpdateLvItems(x.PropertyName)
Else
On Error Resume Next
lvDownloads.ListItems.Remove x.PropertyName
mcDownloads.Delete x.PropertyName
On Error GoTo 0
End If
' Descarga con error
Else
' Guardar estado
mcDownloads.Item(x.PropertyName).Status = eError
' Actualizar items del Lv
Call mUpdateLvItems(x.PropertyName)
End If
End Sub
Private Function mCheckExistLvItem(sKey As String, ObjLv As ListView) As Boolean
On Error GoTo error_handler
Dim xItem As ListItem
Set xItem = ObjLv.ListItems(sKey)
Set xItem = Nothing
mCheckExistLvItem = True
Exit Function
error_handler:
End Function
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Mostrar datos de las descargas en el StatusBar
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mUpdateStatusBar()
Dim strStatus1 As String
Dim strStatus2 As String
If lvDownloads.ListItems.Count > 0 Then
strStatus1 = "Descargando: " & CStr(lvDownloads.ListItems.Count) & " | "
Else
strStatus1 = ""
End If
If lvFiles.ListItems.Count > 0 Then
strStatus2 = "Terminados: " & CStr(lvFiles.ListItems.Count)
Else
strStatus2 = ""
End If
If Len(strStatus2) = 0 And strStatus1 <> "" Then
strStatus1 = Left(strStatus1, Len(strStatus1) - 1)
End If
lblStatus.Caption = strStatus1 & strStatus2
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Actualizar íconos del listview de descargas
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mUpdateSmallIcons(pItemLv As ListItem)
With mcDownloads
If .CheckItemExist(pItemLv.Key) Then
pItemLv.SmallIcon = .GetStatusText(.Item(pItemLv.Key).Status)
End If
End With
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Evento de progreso - Para los Mp3s
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub ucDownloadMp3_Progress(x As AsyncProperty, Percent As Single)
On Error GoTo error_handler
' Guardar datos en el item de la coección
With mcDownloads.Item(x.PropertyName)
.Progress = Percent
.FileSize = x.BytesMax
.BytesRead = .BytesRead
.Percent = Val(CStr(.Progress)) & " %"
If Percent >= 1 Then
.Status = eDownloading
Else
.Status = eNew
End If
End With
Exit Sub
error_handler:
'If App.LogMode = 0 Then MsgBox Err.Description, vbCritical, "Error en - ucDownloadMp3_Progress"
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Cargar información (Tags) del archivo Mp3 en el control Listview
' -----------------------------------------------------------------------------------------------------
Private Sub mShowTagInfo()
' Información Mpeg ( Bitrate, tags, frcuencia, versión ...)
' ------------------------------------------------------
With tInfoMpg
Call mClearInfoMp3
lblMpegInfo(0).Caption = .MPEGVersion
lblMpegInfo(1).Caption = .Bitrate
lblMpegInfo(2).Caption = .Frequency
lblMpegInfo(3).Caption = .ChannelMode
lblMpegInfo(4).Caption = mcDownloads.GetFormatLenght(.Length)
lblMpegInfo(5).Caption = mcDownloads.GetFileSize(.FileSize)
End With
' Información iD3v1
' -------------------------------------------------------------------
With tInfoV1
txtId3v1(0).Text = .Title
txtId3v1(1).Text = .Album
txtId3v1(2).Text = .Artist
cboGen(0).Text = .Genre
txtId3v1(4).Text = .SongYear
txtId3v1(5).Text = .TrackNr
txtId3v1(6).Text = .Comment
End With
' Información iD3v2
' -------------------------------------------------------------------
With tInfoV2
txtId3v2(7).Text = .Title
txtId3v2(0).Text = .Album
txtId3v2(1).Text = .Artist
cboGen(1).Text = .Genre
txtId3v2(3).Text = .SongYear
txtId3v2(4).Text = .TrackNr
txtId3v2(5).Text = .Comment
txtId3v2(6).Text = .ArtistAdditional
txtId3v2(8).Text = .CDNumber
txtId3v2(9).Text = .EncodingSettings
txtId3v2(10).Text = .Copyright
txtId3v2(11).Text = .FileType
txtId3v2(12).Text = .Language
End With
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Opción de menú para cancelar descargas y Reiniciar
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mnuCancelDownloads_Click(Index As Integer)
On Error GoTo err_handler
Dim xItem As ListItem
' Detener temporalmente el Timer que actualiza los datos en el lv de descargas
If mcTimer.TmrStop Then TimerStatus = False
Select Case Index
' Eliminar descargas seleccionadas
' ----------------------------------------------------------------------------------------------------------------------------------
Case 0
Dim arrKeys() As String
arrKeys = mGetLvSelectedItems(lvDownloads, eAll)
Dim i As Integer
For i = 0 To UBound(arrKeys)
If arrKeys(i) <> vbNullString Then
On Error Resume Next
Call ucDownloadMp3.CancelDownload(arrKeys(i))
Call mcDownloads.Delete(arrKeys(i))
lvDownloads.ListItems.Remove arrKeys(i)
On Error GoTo 0
End If
Next
Erase arrKeys
' Eliminar todas las descargas
' ----------------------------------------------------------------------------------------------------------------------------------
Case 2
If MsgBox("Eliminar todas las descargas actuales ?", vbQuestion + vbYesNo) = vbYes Then
For Each xItem In lvDownloads.ListItems
Call ucDownloadMp3.CancelDownload(xItem.Key)
Call mcDownloads.Delete(xItem.Key)
Next
lvDownloads.ListItems.Clear
End If
' Reiniciar descarga
' ----------------------------------------------------------------------------------------------------------------------------------
Case 4
If Not lvDownloads.SelectedItem Is Nothing Then
Call ucDownloadMp3.CancelDownload(lvDownloads.SelectedItem.Key)
Call ucDownloadMp3.Download(lvDownloads.SelectedItem.Key)
End If
' Seleccionar todos los lvItems
' ----------------------------------------------------------------------------------------------------------------------------------
Case 6
lvDownloads.MultiSelect = True
For Each xItem In lvDownloads.ListItems
xItem.Selected = True
Next
End Select
' Volver a activar el timer
TimerStatus = mcTimer.TmrStart(Me, mGetTimerInterval, 0)
Exit Sub
err_handler:
MsgBox Err.Description, vbCritical, "mnuCancelDownloads_Click"
End Sub
' -----------------------------------------------------------------------------------------------------
'\\ - Botón Play y Stop
' -----------------------------------------------------------------------------------------------------
Private Sub cmdPrevMp3_Click(Index As Integer)
' Si no hay item salir ...
If lvFiles.SelectedItem Is Nothing Then Exit Sub
With mcMCI
Select Case Index
Case 0: Call .ExecuteCommand(ePlayMp3, mcFind.DownloadFolder & lvFiles.SelectedItem.Text)
Case 1: Call .ExecuteCommand(eStopMp3, mcFind.DownloadFolder & lvFiles.SelectedItem.Text)
End Select
End With
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Redimensionar controles
' -----------------------------------------------------------------------------------------------------
Private Sub Form_Resize()
On Local Error Resume Next
Dim i As Integer
' si está minimizado ...salir
If WindowState = vbMinimized Then Exit Sub
For i = 0 To picBoxMain.Count - 1
picBoxMain(i).Move 0, tbMain.Height + 15, ScaleWidth, ScaleHeight - (tbMain.Height + 15 + picStatus.Height + 15)
Next
' Listview de resultados de búsqueda
With lvFind
.Width = (ScaleWidth - .Left) - 100
.Height = picBoxMain(0).Height - 240 - .Top
End With
' Botón de menú de opciones
With cmdDownloads(0)
.Top = 800
.Left = 120
End With
' Listview con los archivos que se están descargando
With lvDownloads
.Left = 120
.Width = 8000
.Height = 3500
.Top = cmdDownloads(0).Height + cmdDownloads(0).Top + 15
End With
' Listview con los archivos ya descargados
With lvFiles
.Left = 120
.Width = 8000
.Height = 3500
.Top = lvDownloads.Top + lvDownloads.Height + 80 + cmdDownloads(1).Height
End With
' Listview con los archivos que se están descargando
With cmdDownloads(1)
.Top = lvDownloads.Top + lvDownloads.Height + 60
.Left = 120
End With
' Contenedor para los controles de Tags
With frameConInfoMp3
.Left = lvFiles.Left + lvFiles.Width + 60
.Width = Me.ScaleWidth - (lvFiles.Width + lvFiles.Left + 120)
.Top = 120
.Height = picBoxMain(0).Height - 240
End With
With picBoxTitle
.Width = frameConInfoMp3.Width - 240
End With
' Listbox con la lista de Artistas
lstArt.Height = picBoxMain(0).ScaleHeight - (lstArt.Top + 30)
' botones de reproducción
cmdPrevMp3(1).Left = ScaleWidth - (cmdPrevMp3(1).Width + 120)
cmdPrevMp3(0).Left = ScaleWidth - (cmdPrevMp3(0).Width + cmdPrevMp3(1).Width + 120)
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Ordenar Columnas para el Listview de archivos ya descargados
' -----------------------------------------------------------------------------------------------------
Private Sub lvFiles_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Call LvColumnClick(lvFiles, ColumnHeader.Index)
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Ordenar Columnas para el Listview de archivos que se están descargando
' -----------------------------------------------------------------------------------------------------
Private Sub lvDownloads_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Call LvColumnClick(lvDownloads, ColumnHeader.Index)
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Ordenar Columnas para el Listview de resultados
' -----------------------------------------------------------------------------------------------------
Private Sub lvFind_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
Call LvColumnClick(lvFind, ColumnHeader.Index)
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Mostrar menú Popup para le LV de archivos en descarga
' -----------------------------------------------------------------------------------------------------
Private Sub lvDownloads_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
Call mShowLVPopUpMenu(Button, mnuCanDown, lvDownloads, x, Y)
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Sub para ordenar las columnas de un ListView
' -----------------------------------------------------------------------------------------------------
Private Sub LvColumnClick(Lv As ListView, lIndexCol As Integer)
With Lv
.SortOrder = (.SortOrder + 1) Mod 2
.SortKey = lIndexCol - 1
.Sorted = True
End With
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Sub para desplegar PopUp menu para los ListView
' -----------------------------------------------------------------------------------------------------
Private Sub mShowLVPopUpMenu(Button As Integer, pMenu As Menu, pLv As ListView, x As Single, Y As Single)
If Button <> vbRightButton Then Exit Sub
Dim xItem As ListItem
Set xItem = pLv.HitTest(x, Y)
If Not xItem Is Nothing Then
If xItem.Selected = False Then
pLv.MultiSelect = False
End If
xItem.Selected = True
Me.PopupMenu pMenu
pLv.MultiSelect = False
End If
DoEvents
pLv.MultiSelect = True
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Reproducir archivo Mp3 al hacer doble clic
' -----------------------------------------------------------------------------------------------------
Private Sub lvFiles_DblClick()
With lvFiles
If Not .SelectedItem Is Nothing Then
If mcFind.CheckFileExists(mcFind.DownloadFolder & .SelectedItem.Text) Then
' Reproducir con MciExecute
If mOptions.bPlayMp3 = False Then
Call cmdPrevMp3_Click(0)
Else
Call mnuOptionsFile_Click(1)
End If
' Remarcar item
.SelectedItem.Bold = True
.SelectedItem.ForeColor = mcStyles.ForeColorSelectedItems
Else
MsgBox "El archivo a reproducir no se encuentra en el directorio de descargas", vbExclamation, "No se encuentra el archivo"
End If
End If
End With
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Leer y Cargar los tags al hacer clic en un item
' -----------------------------------------------------------------------------------------------------
Private Sub lvFiles_ItemClick(ByVal Item As MSComctlLib.ListItem)
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Habilitar o deshabiilitar controles por el nombre
' -----------------------------------------------------------------------------------------------------
Sub mEnabledControls(bValue As Boolean, sName As String)
Dim xCtrl As Control
For Each xCtrl In Me.Controls
If LCase(xCtrl.Name) = LCase(sName) Then
If xCtrl.Enabled = bValue Then
Exit Sub
Else
xCtrl.Enabled = bValue
End If
End If
Next
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Eliminar propiedad text o caption de los controles
' -----------------------------------------------------------------------------------------------------
Private Sub mClearInfoMp3()
Dim xCtrl As Control
For Each xCtrl In Me.Controls
If LCase(xCtrl.Tag) = LCase("InfoMp3") Then
xCtrl = vbNullString
End If
Next
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Desplegar popupmenu para el listview de archivos ya descargados
' -----------------------------------------------------------------------------------------------------
Private Sub lvFiles_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
Call mShowLVPopUpMenu(Button, mnuOptDownload, lvFiles, x, Y)
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Destruir ToolTip cuando el mouse entra en el control Listview de resultados
' -----------------------------------------------------------------------------------------------------
Private Sub mCscLvFind_MouseEnter()
Call mcToolTip.Destroy
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Destruir ToolTip cuando el mouse sale del control Listview de resultados
' -----------------------------------------------------------------------------------------------------
Private Sub mCscLvFind_MouseOut()
Call mcToolTip.Destroy
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Menú de opciones de Tags
' -----------------------------------------------------------------------------------------------------
Private Sub mnuTags_Click(Index As Integer)
' Si no hay archivo salir ..
If (Len(mSelCurrentFileName) = 0) Then
MsgBox "No hay un archivo cargado para editar", vbExclamation, "Tags"
Exit Sub
End If
' Restaurar flag de edición de tags
Me.TagsEdit = False
' Estructura de datos para pasar a la función que lee y escribe los tags
Dim tTag As ID3v1Tag
Dim tTag2 As ID3v2Tag
Dim xItem As ListItem
' limpiar los types
tInfoV1 = tInfoV1_c
tInfoV2 = tInfoV2_c
tInfoMpg = tInfoMpg_c
Select Case Index
' Modificar y crear
' --------------------------------------------------------------------------------------
Case 0
' Versión 1
' -------------------------
tTag.Title = txtId3v1(0).Text
tTag.Album = txtId3v1(1).Text
tTag.Artist = txtId3v1(2).Text
tTag.Genre = cboGen(0).Text
tTag.SongYear = txtId3v1(4).Text
tTag.TrackNr = txtId3v1(5).Text
tTag.Comment = txtId3v1(6).Text
Call modInfoMp3.WriteID3v1(mSelCurrentFileName, tTag)
' Versión 2
' ------------------------------------------------------------------
tTag2.Title = txtId3v2(7).Text
tTag2.Album = txtId3v2(0).Text
tTag2.Artist = txtId3v2(1).Text
tTag2.Genre = cboGen(1).Text
tTag2.SongYear = txtId3v2(3).Text
tTag2.TrackNr = txtId3v2(4).Text
tTag2.Comment = txtId3v2(5).Text
tTag2.ArtistAdditional = txtId3v2(6).Text
tTag2.CDNumber = txtId3v2(8).Text
tTag2.EncodingSettings = txtId3v2(9).Text
tTag2.Copyright = txtId3v2(10).Text
tTag2.FileType = txtId3v2(11).Text
tTag2.Language = txtId3v2(12).Text
' escribir
Call modInfoMp3.WriteID3v2(mSelCurrentFileName, tTag2, VERSION_2_4, False, False, True)
' Eliminar tags
' ----------------------------------------------------------------
Case 2
' v1
If modInfoMp3.ReadMPEGInfo(mSelCurrentFileName, tInfoMpg) Then
If tInfoMpg.ID3v1Version <> -1 Then
Call modInfoMp3.DeleteID3v1(mSelCurrentFileName)
End If
End If
Case 3
' v2
If modInfoMp3.ReadMPEGInfo(mSelCurrentFileName, tInfoMpg) Then
If tInfoMpg.ID3v2Version <> -1 Then
Call modInfoMp3.DeleteID3v2(mSelCurrentFileName)
End If
End If
' eliminar todos los tags de los archivos cargados en LvFiles
Case 4
If lvFiles.ListItems.Count > 0 Then
If MsgBox("Eliminar todos los tags de los archivos descargados: ?.", vbQuestion + vbYesNo) = vbYes Then
Dim sFileName As String
For Each xItem In lvFiles.ListItems
sFileName = mcFind.DownloadFolder & xItem.Text
Call modInfoMp3.DeleteID3v1(sFileName)
Call modInfoMp3.DeleteID3v2(sFileName)
Next
End If
Else
MsgBox "No hay archivos para eliminar", vbCritical
End If
End Select
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ -Cargar Listado de artístas en listbox, (desde los archivos txt)
' -----------------------------------------------------------------------------------------------------
Private Sub cboArtista_Click()
Me.MousePointer = vbHourglass
DoEvents
Call mFillLstArts(App.Path & "\data\" & cboArtista.Text & ".txt")
Me.MousePointer = vbDefault
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Mostrar menú popup de opciones ( para listview de descargas y para los que finalizaron )
' -----------------------------------------------------------------------------------------------------
Private Sub cmdDownloads_Click(Index As Integer)
Select Case Index
' menú de descargas
Case 0
If lvDownloads.ListItems.Count > 0 Then
Me.PopupMenu mnuCanDown, , cmdDownloads(0).Left, picBoxMain(1).Top + cmdDownloads(0).Top + cmdDownloads(0).Height
End If
' ya descargados
Case 1
If lvFiles.ListItems.Count > 0 Then
Me.PopupMenu mnuOptDownload, , cmdDownloads(1).Left, picBoxMain(1).Top + cmdDownloads(1).Top + cmdDownloads(1).Height
End If
End Select
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Buscar en la siguiente página o en la anterior
' -----------------------------------------------------------------------------------------------------
Private Sub cmdPages_Click(Index As Integer)
With lblNumPage
Select Case Index
Case 0
If (CInt(.Caption) > 1) Then .Caption = CStr(CInt(.Caption) - 1)
Case 1
.Caption = CStr(CInt(.Caption) + 1)
End Select
End With
' Comenzar búsqueda
With mcFind
Call .FindMp3(txtSearch.Text, lstDirectory.ListIndex, CInt(lblNumPage.Caption))
End With
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Timer para actualizar los datos de las transferencias
' -----------------------------------------------------------------------------------------------------
Private Sub iTimer_Proc(ByVal lElapsedMS As Long, ByVal lTimerID As Long)
Select Case lTimerID
Case 0
With ucDownloadMp3
' si ya no hay archivos, .. desactivar el timer y salir
If .CurrentDownloads.Count = 0 Then
If mcTimer.TmrStop Then
TimerStatus = False
Exit Sub
End If
End If
Dim xLvItem As ListItem
For Each xLvItem In lvDownloads.ListItems
Call mUpdateLvItems(xLvItem.Key)
Next
End With
mcTimer.TmrStop
TimerStatus = mcTimer.TmrStart(Me, mGetTimerInterval, 0)
Case 1 ' otro timer
End Select
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Mostrar el artista en el textbox al hacer clic en listbox
' -----------------------------------------------------------------------------------------------------
Private Sub lstArt_Click()
txtSearch.Text = lstArt.Text
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Leer y Cargar Tags del archivo Mp3 en el listview
' -----------------------------------------------------------------------------------------------------
Private Sub mLoadInfoMp3(lvItem As ListItem)
' limpiar los types
tInfoMpg = tInfoMpg_c
tInfoV1 = tInfoV1_c
tInfoV2 = tInfoV2_c
' Obtener ruta del Mp3
Dim sFileName As String
sFileName = mcFind.DownloadFolder & lvItem.Text
' Guardar la ruta
mSelCurrentFileName = sFileName
If modInfoMp3.ReadMPEGInfo(sFileName, tInfoMpg) Then
Call modInfoMp3.ReadID3v1(sFileName, tInfoV1) ' v1
Call modInfoMp3.ReadID3v2(sFileName, tInfoV2) ' v2
End If
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Función para devolver un array con los items del listview ( para todos los que se encuentran seleccionados, o para los que están marcados como error)
'--------------------------------------------------------------------------------------------------------
Private Function mGetLvSelectedItems(Lv As ListView, lOpt As eLvSelectedItems) As String()
On Error GoTo err_handler
Dim arrKeys() As String
Dim xLvItem As ListItem
ReDim arrKeys(0)
' devolver todos los seleccionados
If lOpt = eAll Then
For Each xLvItem In Lv.ListItems
If xLvItem.Selected Then
arrKeys(UBound(arrKeys)) = xLvItem.Key
ReDim Preserve arrKeys(UBound(arrKeys) + 1)
End If
Next
' devolver todos los que dieron error
ElseIf lOpt = eErrorItem Then
For Each xLvItem In Lv.ListItems
If xLvItem.SubItems(1) = mcDownloads.GetStatusText(eError) Then
arrKeys(UBound(arrKeys)) = xLvItem.Key
ReDim Preserve arrKeys(UBound(arrKeys) + 1)
End If
Next
End If
' quitar el último vacio
If UBound(arrKeys) > 0 Then
ReDim Preserve arrKeys(UBound(arrKeys) - 1)
End If
' retornar array de items
mGetLvSelectedItems = arrKeys
Exit Function
err_handler:
If App.LogMode = 0 Then
MsgBox Err.Description, vbCritical, "mGetLvSelectedItems"
End If
End Function
' -----------------------------------------------------------------------------------------------------
' \\ - Opciones de menú para el listview con la lista de archivos ya descargados
' -----------------------------------------------------------------------------------------------------
Private Sub mnuOptDown_Click(Index As Integer)
On Error GoTo err_handler
Dim xLvItem As ListItem
Dim arrKeys() As String
Dim i As Integer
Select Case Index
' Eliminar todos los archivos de la lista, y también del disco
' -------------------------------------------------------------
Case 1
' obtener los que están seleccionados
arrKeys = mGetLvSelectedItems(lvFiles, eAll)
If UBound(arrKeys) > 0 Then
If MsgBox("¿ Eliminar archivos del disco ?", vbQuestion + vbYesNo) = vbNo Then
Exit Sub
End If
End If
Dim sFileName As String
' recorrer items
For i = 0 To UBound(arrKeys)
If arrKeys(i) <> vbNullString Then
sFileName = mcFind.DownloadFolder & lvFiles.ListItems(arrKeys(i)).Text
' Eliminar del disco, de la colección y del listview
On Error Resume Next
If mcFind.CheckFileExists(sFileName) Then Kill sFileName
Call mcDownloads.Delete(arrKeys(i))
lvFiles.ListItems.Remove arrKeys(i)
On Error GoTo 0
End If
Next
Erase arrKeys
' Eliminar de la lista los que dieron error
' -------------------------------------------------------------
Case 2
arrKeys = mGetLvSelectedItems(lvFiles, eErrorItem)
For i = 0 To UBound(arrKeys)
If arrKeys(i) <> vbNullString Then
On Error Resume Next
mcDownloads.Delete arrKeys(i)
lvFiles.ListItems.Remove arrKeys(i)
On Error GoTo 0
End If
Next
Erase arrKeys
' Eliminar toda la lista
' -------------------------------------------------------------
Case 4
If lvFiles.ListItems.Count > 0 Then
If MsgBox("Limpiar la lista?", vbQuestion + vbYesNo) = vbYes Then
For Each xLvItem In lvFiles.ListItems
On Error Resume Next
' remover item de la colección
Call mcDownloads.Delete(xLvItem.Key)
On Error GoTo 0
Next
lvFiles.ListItems.Clear
End If
End If
Case 6
Call mSelectAllLvItems(lvFiles)
Case 8
arrKeys = mGetLvSelectedItems(lvFiles, eAll)
For i = 0 To UBound(arrKeys)
Call mAddUrlError(arrKeys(i))
Next
End Select
' si no hay mas archivos, cerrar Mci por si estaba en reproducción
If lvFiles.ListItems.Count = 0 Then
mSelCurrentFileName = vbNullString
Call mcMCI.ExecuteCommand(eCloseMp3, vbNullString)
Call mClearInfoMp3
Call mEnabledControls(True, "txtId3v1")
Call mEnabledControls(True, "txtId3v2")
Call mEnabledControls(True, "cboGen")
Me.TagsEdit = False
End If
Exit Sub
err_handler:
MsgBox Err.Description, vbCritical, "mnuOptDown_Click"
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' Menú de opciones para mostrar diálogo de propiedades de archivo, y para abrir el Mp3 con el reproductor predeterminado de windows
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mnuOptionsFile_Click(Index As Integer)
Select Case Index
Case 0
' Reproducir con MCI
Call lvFiles_DblClick
Case 1
' Reproducir con el predeterminado
If Not lvFiles.SelectedItem Is Nothing Then
Call mcFind.FileOpen(Me.hwnd, mcFind.DownloadFolder & lvFiles.SelectedItem.Text)
End If
Case 3
' Diálogo de propiedades
If Not lvFiles.SelectedItem Is Nothing Then
Call mcDlgs.showDlgFileProperty(mcFind.DownloadFolder & lvFiles.SelectedItem.Text, Me.hwnd)
End If
End Select
End Sub
' ------------------------------------------------------------------------------------
' Seleccionar todos los items de un LV
' ------------------------------------------------------------------------------------
Private Sub mSelectAllLvItems(ObjLv As ListView)
ObjLv.MultiSelect = True
Dim xItem As ListItem
For Each xItem In ObjLv.ListItems
xItem.Selected = True
Next
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Volver a Redibujar Skin para el PicBox de barra de estado cuando se redimensiona el control
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub picStatus_Resize()
With picStatus
.Cls
Call cmdSearch.DrawSkin(.hdc, (.ScaleWidth / 15) - 2, (.ScaleHeight / 15) - 2, TS_NORMAL)
End With
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Desplegar menú de opciones de Tags
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub cmdTags_Click()
If Not lvFiles.SelectedItem Is Nothing Then
Me.PopupMenu mnuTagOpt, , cmdTags.Left + frameConInfoMp3.Left, frameConInfoMp3.Top + cmdTags.Top + cmdTags.Height + picBoxMain(0).Top
End If
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Antes de cerrar el form, verificar si hay descargas en progreso
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error GoTo err_handler
With ucDownloadMp3.CurrentDownloads
If .Count > 0 Then
' Mostrar pantalla de transferencias
'ucMenu1.Buttons(2).Selected = True
DoEvents
If MsgBox("Se están descargando " & CStr(.Count) & " archivos. ¿ Salir ?", vbQuestion + vbYesNo) = vbNo Then
Cancel = True
End If
Else
' Cancelar todo y salir
Call mCancelAll(False)
End If
End With
Exit Sub
err_handler:
MsgBox Err.Description, vbCritical, "Form_QueryUnload"
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Destruir referencias y descargar objetos
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
On Error GoTo err_handler
Call mSaveUrlError
' Cargar valores de configuración desde el archivo Ini
With mcIni
Call .writeValue(mIniPath, "Reproducción", "PlayMp3", mOptions.bPlayMp3)
Call .writeValue(mIniPath, "Tags", "EliminarID3v1", mOptions.bDeleteId3v1)
Call .writeValue(mIniPath, "Tags", "EliminarID3v2", mOptions.bDeleteId3v2)
Call .writeValue(mIniPath, "Estilo", "Estilo", mOptions.lStyles)
Call .writeValue(mIniPath, "Iconos", "Tamaño", mOptions.lIconSize)
End With
Set mColUrlsError = Nothing
mcSCToolBar.UnSubClassToolBar
Set mcSCToolBar = Nothing
Set mcFind = Nothing
Set mcSCLvFind = Nothing
Set mcscLvDownload = Nothing
Set mcscLvFiles = Nothing
Set mcDownloads = Nothing
Set mcToolTip = Nothing
Set mcDlgs = Nothing
Set mcIni = Nothing
Set mcMCI = Nothing
Set mcStyles = Nothing
mcTimer.TmrStop
Set mcTimer = Nothing
End
Exit Sub
err_handler:
MsgBox Err.Description, vbCritical, "Form unload"
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Almacenar Items con error
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mAddUrlError(sKey As String)
On Error Resume Next
mColUrlsError.Add sKey, sKey
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Guardar en un archivo de texto las url con error
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mSaveUrlError()
On Error GoTo error_handler
Dim f As Integer
f = FreeFile
Open mcFind.TempPath & "url_error.txt" For Output As #1
Dim i As Integer
For i = 1 To mColUrlsError.Count
Print #f, mColUrlsError.Item(i)
Next
Close f
Exit Sub
error_handler:
Close
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Cargar las url de error desde el archivo de texto
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mLoadUrlError()
On Error GoTo error_handler
Dim sUrl As String
Dim f As Integer
f = FreeFile
Open mcFind.TempPath & "url_error.txt" For Input As #f
While Not EOF(f)
Line Input #f, sUrl
Call mAddUrlError(sUrl)
Wend
Close #f
Exit Sub
error_handler:
Close
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Agregar nueva descarga al ahcer doble clic en un resultado
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub lvFind_DblClick()
' Enviar el item seleccionado actualmente
Call mAddNewDownload(lvFind.SelectedItem)
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Sub para agregar nueva descarga
' ----------------------------------------------------------------------------------------------------------------------------------
Sub mAddNewDownload(pItemLv As ListItem)
On Error GoTo error_handler
' .. si no hay item salir
If pItemLv Is Nothing Then Exit Sub
Dim xItemLvDown As ListItem
With pItemLv
'si ya se encuentra esta descarga, mostrar tooltip y salir
If mcDownloads.CheckItemExist(.Key) Then
mcToolTip.Destroy
mcToolTip.Icon = TTIconInfo
mcToolTip.Style = TTBalloon
mcToolTip.VisibleTime = 4000
mcToolTip.DelayTime = 1
mcToolTip.Title = .Text
mcToolTip.Create lvFind.hwnd
mcToolTip.TipText = "El archivo seleccionado ya se encuentra en la lista de descargas"
Call mUpdateSmallIcons(pItemLv)
Exit Sub
' Agregar nueva
Else
' Nuevo Item para guardar en la colección
Dim xItemDownload As New cDownloadItem
xItemDownload.Key = mcFind.Item(.Key).Key ' Clave
xItemDownload.Url = mcFind.Item(.Key).Url ' Dirección url
xItemDownload.Title = mcFind.Item(.Key).Title ' Titulo - Nombre del archivo
xItemDownload.Status = eNew ' Estado
xItemDownload.FileName = mcFind.Item(.Key).FileName ' Nombre de archivo - Ruta completa
' Agregar a la colección
Call mcDownloads.Add(xItemDownload.Title, xItemDownload.Url, xItemDownload.FileName, xItemDownload.Url, eNew)
' Agregar al Listview
Set xItemLvDown = lvDownloads.ListItems.Add(1, xItemDownload.Key)
' Actualizar listview
Call mUpdateLvItems(xItemDownload.Url)
' Agregar descarga
Call ucDownloadMp3.Download(xItemDownload.Url)
' Comenzar timer
mcTimer.TmrStop
TimerStatus = mcTimer.TmrStart(Me, mGetTimerInterval, 0)
.Bold = True
.ForeColor = mcStyles.ForeColorSelectedItems
Set xItemDownload = Nothing
End If
End With
Exit Sub
error_handler:
MsgBox Err.Description, vbCritical, "Error: " & CStr(Err.Number)
End Sub
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Usar valor de Interval de acuerdo a la cantidad de items que hay cargados
' ----------------------------------------------------------------------------------------------------------------------------------
Private Function mGetTimerInterval() As Long
Dim lItemsCount As Long
lItemsCount = lvDownloads.ListItems.Count
If lItemsCount <= 5 Then
mGetTimerInterval = 2000
ElseIf lItemsCount > 5 And lItemsCount <= 10 Then
mGetTimerInterval = 3000
ElseIf lItemsCount > 10 And lItemsCount <= 15 Then
mGetTimerInterval = 4000
ElseIf lItemsCount > 15 And lItemsCount <= 25 Then
mGetTimerInterval = 6000
Else
mGetTimerInterval = 10000
End If
End Function
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Guardar estado del Timer
' ----------------------------------------------------------------------------------------------------------------------------------
Property Get TimerStatus() As Boolean
TimerStatus = mTimerStatus
End Property
Property Let TimerStatus(bValue As Boolean)
mTimerStatus = bValue
End Property
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Guardar modificación de tags
' ----------------------------------------------------------------------------------------------------------------------------------
Property Get TagsEdit() As Boolean
TagsEdit = mTagsEdit
End Property
Property Let TagsEdit(bValue As Boolean)
mTagsEdit = bValue
End Property
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Autocompletar TextBox al escribir
' ----------------------------------------------------------------------------------------------------------------------------------
Public Function AutoCompletar_TextBox(textBox As textBox)
Dim i As Integer
Dim posSelect As Integer
Select Case (mbKeyBack Or Len(textBox.Text) = 0)
Case True
mbKeyBack = False
Exit Function
End Select
With textBox
For i = 0 To lstArt.ListCount - 1
If InStr(1, lstArt.List(i), .Text, vbTextCompare) = 1 Then
posSelect = .SelStart
.Text = lstArt.List(i)
.SelStart = posSelect
.SelLength = Len(.Text) - posSelect
lstArt.ListIndex = i
Exit For
End If
Next i
End With
End Function
' ----------------------------------------------------------------------------------------------------------------------------------
' \\ - Leer txt, y cargar artístas en el listbox
' ----------------------------------------------------------------------------------------------------------------------------------
Private Sub mFillLstArts(sFileName As String)
On Error GoTo error_handler
Dim sValue As String
lstArt.Clear
If mcFind.CheckFileExists(sFileName) Then
Dim f As Integer
f = FreeFile
Open sFileName For Input As #f
' leer lineas del archivo
While Not EOF(f)
Line Input #f, sValue
lstArt.AddItem sValue
Wend
Close f
End If
Exit Sub
error_handler:
MsgBox Err.Description
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Eliminar archivos al presionar la tecla Delete
' -----------------------------------------------------------------------------------------------------
Private Sub lvDownloads_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyDelete: Call mnuCancelDownloads_Click(0)
End Select
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Eliminar archivos al presionar la tecla Delete, y reproducir al presionar enter
' -----------------------------------------------------------------------------------------------------
Private Sub lvFiles_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyDelete: Call mnuOptDown_Click(1)
Case vbKeyReturn: Call lvFiles_DblClick
End Select
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - Buscar al presionar la tecla enter,Abrir carpeta d e descargas
' -----------------------------------------------------------------------------------------------------
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyReturn: Call cmdSearch_Click
Case vbKeyF2: Call tbMain_ButtonClick(tbMain.Buttons(6))
End Select
End Sub
' -----------------------------------------------------------------------------------------------------
' \\ - eventos de controles para cambiar el backcolor cuando reciben y pierden el foco
' -----------------------------------------------------------------------------------------------------
Private Sub lstArt_GotFocus()
lstArt.BackColor = mcStyles.BackColorControlFocus
End Sub
Private Sub lstArt_LostFocus()
lstArt.BackColor = mcStyles.BackColorControls
End Sub
Private Sub txtSearch_GotFocus()
With txtSearch
.BackColor = mcStyles.BackColorControlFocus
.SelStart = 0
.SelLength = Len(.Text)
End With
End Sub
Private Sub txtSearch_LostFocus()
txtSearch.BackColor = mcStyles.BackColorTextBox
End Sub
Private Sub txtId3v1_GotFocus(Index As Integer)
Call mChangeBackColorCtrl(mcStyles.BackColorControls, txtId3v1())
txtId3v1(Index).BackColor = mcStyles.BackColorControlFocus
End Sub
Private Sub txtId3v1_LostFocus(Index As Integer)
Call mChangeBackColorCtrl(mcStyles.BackColorControls, txtId3v1())
End Sub
Private Sub txtId3v2_GotFocus(Index As Integer)
Call mChangeBackColorCtrl(mcStyles.BackColorControls, txtId3v2())
txtId3v2(Index).BackColor = mcStyles.BackColorControlFocus
End Sub
Private Sub txtId3v2_LostFocus(Index As Integer)
Call mChangeBackColorCtrl(mcStyles.BackColorControls, txtId3v2())
End Sub
Private Sub lvFind_GotFocus()
If mcStyles.CurrentStyle > 0 Then lvFind.BackColor = mcStyles.BackColorControlFocus
End Sub
Private Sub lvFind_LostFocus()
If mcStyles.CurrentStyle > 0 Then lvFind.BackColor = mcStyles.BackColorControls
End Sub
Private Sub mChangeBackColorCtrl(lcolor As Long, xArrCtrl As Variant)
Dim xCtrl As Variant
For Each xCtrl In xArrCtrl
xCtrl.BackColor = lcolor
Next
cboGen(0).BackColor = lcolor
cboGen(1).BackColor = lcolor
End Sub
Private Sub cboDirectory_Click()
lblNumPage.Caption = "1"
End Sub
Private Sub cboGen_Click(Index As Integer)
Me.TagsEdit = CBool(Len(mSelCurrentFileName))
End Sub
Private Sub cboGen_GotFocus(Index As Integer)
Call mChangeBackColorCtrl(mcStyles.BackColorControls, txtId3v1())
cboGen(Index).BackColor = mcStyles.BackColorControlFocus
End Sub
Private Sub cboGen_LostFocus(Index As Integer)
Call mChangeBackColorCtrl(mcStyles.BackColorControls, txtId3v1())
End Sub
Private Sub cboGen_KeyPress(Index As Integer, KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub lstdirectory_Click()
If Me.Visible Then
lblNumPage.Caption = "1"
Call cmdSearch_Click
End If
End Sub
Private Sub lstDirectory_GotFocus()
lstDirectory.BackColor = mcStyles.BackColorControlFocus
End Sub
Private Sub lstDirectory_LostFocus()
lstDirectory.BackColor = mcStyles.BackColorControls
End Sub
