by apoujade » Tue Apr 24, 2007 7:59 am
Hello last version here
Now is not limited to iPod, but iPod can be reference of your tagging by select it in firt message
other i made translation French and English
HTML report and M3U list
Code: Select all
Option Explicit ' report undefined variables, ...
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' Alain Poujade
Const version = 1.4
' date : 24 April 2007
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' This script update File's Tag rating and in MM Library from Reference List
' that can be changed with other way (ex in iPod)
' You must start this script from Source Node Database
' ..........................................................
' Improvement to do
' a) Auto select an spécifiq node
Dim fout, Fname, fm3u ' Gestion report files
'__________________________________________________
' Translation Table 1=French, 2 = English
'
Dim Mes(30,2), lng
Mes(1,1)="Positionnez vous sur votre liste de référence des classements"
Mes(1,2)="Select your rating reference list"
Mes(2,1)="Initialisation"
Mes(2,2)="Initialization"
Mes(3,1)="Opération annulée, Au revoir"
Mes(3,2)="Operation canceled, Bye"
Mes(4,1)="Identification "
Mes(4,2)="Identify "
Mes(5,1)=" Musique(s) dans la liste de référence"
Mes(5,2)=" Song(s) from your taging's reference"
Mes(6,1)="Continuer ?"
Mes(6,2)="Continu ?"
Mes(7,1)=" Musique(s) dans Database MediaMonkey"
Mes(7,2)=" Song(s) in MediaMonkey's DataBase"
Mes(8,1)="Lancer la recherche ? (Cela peut être long)"
Mes(8,2)="Ready to start comparation ? (Can be very long)"
Mes(9,1)="Rapport d'analyse différence(s) Classement"
Mes(9,2)="Report Analyze delta Rating Source <> MM"
Mes(10,1)="Confirmez Maj"
Mes(10,2)="Confirm Update"
Mes(11,1)="Copie Classements dans MM Database et dans les fichiers MP3"
Mes(11,2)="Make Update for Rating in MM Library and MP3 Tag Files"
Mes(12,1)="Sauve en HTML"
Mes(12,2)="Save in HTML"
Mes(13,1)="Sauve le rapport en page WEB sous "
Mes(13,2)="Save report in HTML under "
Mes(14,1)="Ne pas faire Maj"
Mes(14,2)="Do Not Update"
Mes(15,1)="Abandonne Mise à jour, ne modifie rien"
Mes(15,2)="Cancel Update, don't modify anything"
Mes(16,1)="Compare référence avec MM..."
Mes(16,2)="Comparing Source with MM...."
Mes(17,1)="Nombre de MP3 "
Mes(17,2)="Total Tracks "
Mes(18,1)=" devant être(s) mise à jour"
Mes(18,2)=" need to be updated"
Mes(19,1)=" non trouvé(s) dans MM"
Mes(19,2)=" not find in MM"
Mes(20,1)="Liste de Lecture sauvée sous "
Mes(20,2)="Player Liste saved under "
Mes(21,1)="HTML Rapport sauvé sous"
Mes(21,2)="HTML Raport saved under"
Mes(22,1)="Confirmer demande de mise à jour des classements" & vbcrlf & "dans Database MM et dans les fichiers MP3 ?"
Mes(22,2)="Confirm Update Rating" & vbcrlf & "in MM's Database and in MP3's File(s)"
Mes(23,1)=" Classement à mettre à jour"
Mes(23,2)=" Rating to change"
Mes(24,1)=" Rien à modifier, Au revoir"
Mes(24,2)=" Nothing to do, Bye"
Mes(25,1)="Titre"
Mes(25,2)="Title"
Mes(26,1)="Artiste"
Mes(26,2)="Artist"
Mes(27,1)="Réf Classement"
Mes(27,2)="Ref Rating"
Mes(28,1)="MM Classement"
Mes(28,2)="MM rating"
Mes(29,1)="Liste Vide, rien à analyser, Au revoir"
Mes(29,2)="Empty List, Nothing to analyze, Bye"
'__________________________________________________
Sub UTAG
Dim Temp, Result, res
Dim Sr, itm, list ' Source Song
Dim mk, tag, last 'MM Song
Dim Srm, mkm, ffind, ftag ' Compare var
Dim Progress, fso, mks, fsm
Dim Srce(), MM(), Ko()
res="French"
Do While lng=0
res=InputBox("Select your langage" & vbcrlf & "1 for French" & vbcrlf & "2 for English" & vbcrlf,"Question",1)
If res = 1 then
lng=1
Elseif res=2 then
lng=2
End If
Loop
res= MsgBox (Mes(1,lng) & vbcrlf & vbcrlf & vbcrlf, 4096+1+32,Mes(2,lng))
if res<> 1 then
MsgBox Mes(3,lng)
Exit Sub
End If
fname = Day(Now) & " " & MonthName(Month(Now)) & " " & Year(Now) & " " & Hour(Now) & "h" & Minute(Now)
'-------------------------------------------------------------------------------------
' Here Work from Source, scan Songs
' Iterate through the list and export all songs
mks = 0
Set Temp = SDB.MainTree.CurrentNode
Temp.Expanded = True
Set list = SDB.CurrentSongList
Redim Srce(list.count-1,4)
If list.count = 0 then
MsgBox Mes(29,lng)
Exit Sub
End If
for Sr=0 to list.count-1
Set itm = list.Item(Sr)
Srce(Sr,1) = itm.Title
Srce(Sr,2) = itm.AlbumName
Srce(Sr,3) = itm.ArtistName
Srce(Sr,4) = itm.Rating
next
if Temp.Caption <> SDB.Localize("Artist") Then
mks = 1
End If
'-------------------------------------------------------------------------------------
' Here switch to MM Database node Artist
Set Temp = SDB.MainTree.Node_Artist
SDB.MainTree.CurrentNode = Temp
Temp.Expanded = True
SDB.MainTree.CurrentNode.SortCriteria = 4 'Does means not work !!!!
res = SDB.MessageBox( Mes(4,lng) & CStr(Sr) & Mes(5,lng) & vbcrlf & vbcrlf & Mes(6,lng), mtWarning, Array(mbYes,mbNo,mbAbort))
If res <> 6 Then
MsgBox Mes(3,lng)
Exit Sub
End If
'-------------------------------------------------------------------------------------
' Here Work from MM, scan Songs
' Iterate through the list and export all songs
Set last = SDB.CurrentSongList
Redim MM(last.count-1,4)
If last.count = 0 then
MsgBox Mes(29,lng)
Exit Sub
End If
for mk=0 to last.count-1
Set tag = last.Item(mk)
MM(mk,1) = tag.Title
MM(mk,2) = tag.AlbumName
MM(mk,3) = tag.ArtistName
MM(mk,4) = tag.Rating
next
res = SDB.MessageBox( Mes(4,lng) + CStr(mk ) + Mes(7,lng) & vbcrlf & vbcrlf &_
Mes(8,lng), mtWarning, Array(mbYes,mbNo,mbAbort))
If res <> 6 Then
MsgBox Mes(3,lng)
Exit Sub
End If
'*******************************************************************'
' Create Form for reporting
Dim DlgWith, ecart
DlgWith = 700
ecart = (DlgWith-368)/7
Dim Report : Set Report = SDB.UI.NewForm
Report.Common.SetRect 50,50,DlgWith,400
Report.Common.MinWidth = DlgWith
Report.Common.MinHeight = 200
Report.FormPosition = 4
Report.BorderStyle = 2
Report.Caption = Mes(9,lng)
' Script.RegisterEvent Report, "OnClose", "Salut"
' Create a web browser component
Dim WB : Set WB = SDB.UI.NewActiveX(Report, "Shell.Explorer")
WB.Common.Align = 5 ' Fill all client rectangle
WB.Common.ControlName = "WB"
' Create a panel at the bottom of the window
Dim Faot : Set Faot = SDB.UI.NewPanel(Report)
Faot.Common.Align = 2
Faot.Common.Height = 40
Faot.Common.Width = DlgWith
Dim Maj : Set Maj = SDB.UI.NewButton(Faot)
Maj.Common.SetRect (ecart * 2) ,6,120,28
Maj.Common.Anchors = 8
Maj.Caption = Mes(10,lng)
Maj.Common.Hint = Mes(11,lng)
Maj.ModalResult = 10
Dim Sfl : Set Sfl = SDB.UI.NewButton(Faot)
Sfl.Common.SetRect (120+(ecart*3)),6,120,28
Sfl.Common.Anchors = 8
Sfl.Caption = Mes(12,lng)
Sfl.Common.Hint = Mes(13,lng) & SDB.MyMusicPath
Sfl.ModalResult = 20
Dim Niet : Set Niet = SDB.UI.NewButton(Faot)
Niet.Common.SetRect (240+(ecart*4)),6,120,28
Niet.Common.Anchors = 8
Niet.Caption = Mes(14,lng)
Niet.Common.Hint = Mes(15,lng)
Niet.ModalResult = 30
Niet.default = True
' SDB.Objects("Etat") = Report ' Save reference to the form somewhere, otherwise it would simply disappear
' Format header line
InitHead
'-------------------------------------------------------------------------------------
' Here Compare Scanning and list delta
Dim RSrce, RMM
ffind = 0
ftag = 0
mkm = mk -1
Srm = Sr -1
Redim Ko(Srm,2) ' At Maxi the Song number of Source
Set Progress = SDB.Progress
Progress.Text =Mes(16,lng)
Progress.MaxValue = Srm
For Sr=0 to Srm
' Search and Compare Loop
'--------------------------------------------------------------------------------
' Validate this instruction if the 2 Node View are not sorted as the same way
if mks = 1 then
mk = 0
end if
'--------------------------------------------------------------------------------
Do While mk <= mkm
If Srce(Sr,1) = MM(mk,1) Then
If Srce(Sr,2) = MM(mk,2) then
If Srce(Sr,3) = MM(mk,3) then
if Srce(Sr,4) = MM(mk,4) then
ffind = ffind+1
Else
Ko(ftag,1)=Sr
Ko(ftag,2)=mk
ftag = ftag + 1
RSrce = Srce(Sr,4)/20
if RSrce < 0 Then
RSrce = "N/A"
Else
RSrce =String(RSrce, "*")
End If
RMM = MM(mk,4)/20
if RMM < 0 Then
RMM = "N/A"
Else
RMM =String(RMM, "*")
End If
' Body of the report
fout= fout & "<tr><td align=right class=dark>"&ftag&"</td><td align=left>"&Srce(Sr,1) &"</td><td align=left class=dark>"&Srce(Sr,3) _
&"</td><td align=left>"&Srce(Sr,2) &"</td><td align=center class=dark><b>"&RSrce _
&"</td><td align=center><b>"&RMM&"</b></td></tr>" & vbcrlf
Set tag = last.Item(mk)
fm3u = fm3u & tag.Path & vbcrlf
End If
Exit Do
End If
End If
End If
mk = mk +1
Loop
Progress.Value = Sr
Next
Set Progress = Nothing
if ftag > 0 Then
' Write some code to finish html document
fout = fout & "</table><p/><table width=100%><tr>" & vbcrlf
fout = fout & "<td style='border-bottom-width:0px'><b>"& Mes(17,lng) & ftag &"</b>" & (" / ") & (ffind+ftag) & Mes(18,lng) & "</td></tr>" & vbcrlf
fout = fout & "<tr><td style='border-bottom-width:0px'><b>" & Mes(17,lng) & Srm+1-(ffind+ftag) &"</b>" & (" / ") & Srm+1 & Mes(19,lng)& "</td></tr>" & vbcrlf
fout = fout & "<tr><td style='border-bottom-width:0px'>" & Mes(20,lng) & SDB.MyMusicPath & "Delta rating.m3u </td> <td align=right style='border-bottom-width:0px'>Generated under <a href='http://www.mediamonkey.com'>MediaMonkey</a></td>" & vbcrlf
fout = fout & "</tr></table></body></html>" & vbcrlf
WB.SetHTMLDocument(fout)
Set fsm = SDB.Tools.FileSystem
Set res = fsm.CreateTextFile(SDB.MyMusicPath & "Delta rating" & ".m3u", True)
res.Write fm3u
res.Close
Temp = 20
Do While Temp = 20
Temp = Report.ShowModal
Select Case Temp
Case 20
Set fso = SDB.Tools.FileSystem
Set Result = fso.CreateTextFile( SDB.MyMusicPath & "Report_Delta_Rating " & Fname & ".html", True)
Result.Write fout
Result.Close
MsgBox Mes(21,lng) & vbcrlf & SDB.MyMusicPath & "Report_Delta_Rating " & Fname & ".html"
Case 10
' Here Update MM File from delta
' Write all back to DB and update tags
If SDB.MessageBox(Mes(22,lng), mtWarning, Array(mbYes,mbNo)) = 6 then
Set last = SDB.CurrentSongList
Do While ftag > 0
Sr = Ko(ftag-1,1)
mk = Ko(ftag-1,2)
Set tag = last.Item(mk)
tag.Rating=Srce(Sr,4)
tag.WriteTags
tag.UpdateDB
ftag = ftag-1
Loop
MsgBox "Update Finished"
Else
Temp = 20
End If
' Case 30
Case Else
res = SDB.MessageBox(Mes(3,lng),mtInformation,Array(mbOK))
' SDB.Objects("Etat") = Nothing
End Select
Loop
Else
res = SDB.MessageBox( CStr(ftag)+ " / " & CStr(Srm+1) & Mes(23,lng) &vbcrlf & vbcrlf &Mes(24,lng), mtInformation, Array(mbOk))
End if
End Sub
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Sub InitHead
fout = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">"
fout = fout & vbcrlf & "<html>"
fout = fout & vbcrlf & "<head><title>" & ("Report Analyse Rating") & "</title>"
' Code to format the document
fout = fout & vbcrlf & "<style type=text/css>"
fout = fout & vbcrlf & "body{font-family:'Verdana',sans-serif; background-color:#FFFFFF; font-size:9pt; color:#000000;}"
fout = fout & vbcrlf & "H1{font-family:'Verdana',sans-serif; font-size:13pt; font-weight:bold; color:#AAAAAA; text-aligh:left}"
fout = fout & vbcrlf & "P{font-family:'Verdana',sans-serif; font-size:9pt; color:#000000;}"
fout = fout & vbcrlf & "TH{font-family:'Verdana',sans-serif; font-size:10pt; font-weight:bold; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:3px;}"
fout = fout & vbcrlf & "TD{font-family:'Verdana',sans-serif; font-size:9pt; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:1px;}"
fout = fout & vbcrlf & "TD.dark{background-color:#EEEEEE}"
fout = fout & vbcrlf & "</style>"
fout = fout & vbcrlf & "</head><body>"
fout = fout & vbcrlf & "<h1>" & Mes(9,lng) & (" date : ") & fname & "</h1>"
fout = fout & vbcrlf & "<h1>" & ("Alain Poujade version : ") & Replace(CStr(version),",",".") & "</h1>"
' Headers of table
fout = fout & vbcrlf & "<table cellpadding=4 cellspacing=0>"
fout = fout & vbcrlf & "<tr align=left>"
fout = fout & vbcrlf & " <th id=dark>#</th>"
fout = fout & vbcrlf & " <th>" & (Mes(25,lng)) & "</th>"
fout = fout & vbcrlf & " <th id=dark>" & (Mes(26,lng)) & "</th>"
fout = fout & vbcrlf & " <th>" & ("Album") & "</th>"
fout = fout & vbcrlf & " <th id=dark>" & (Mes(27,lng)) & "</th>"
fout = fout & vbcrlf & " <th>" & (Mes(28,lng)) &"</th>"
fout = fout & vbcrlf & "</tr>"
fout = fout & vbcrlf
fm3u = "#EXTM3U" & vbcrlf
End Sub
Sub Salut(Report)
MsgBox "Not used at the moment"
End Sub
Hello last version here
Now is not limited to iPod, but iPod can be reference of your tagging by select it in firt message
other i made translation French and English
HTML report and M3U list
[code]Option Explicit ' report undefined variables, ...
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' Alain Poujade
Const version = 1.4
' date : 24 April 2007
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' This script update File's Tag rating and in MM Library from Reference List
' that can be changed with other way (ex in iPod)
' You must start this script from Source Node Database
' ..........................................................
' Improvement to do
' a) Auto select an spécifiq node
Dim fout, Fname, fm3u ' Gestion report files
'__________________________________________________
' Translation Table 1=French, 2 = English
'
Dim Mes(30,2), lng
Mes(1,1)="Positionnez vous sur votre liste de référence des classements"
Mes(1,2)="Select your rating reference list"
Mes(2,1)="Initialisation"
Mes(2,2)="Initialization"
Mes(3,1)="Opération annulée, Au revoir"
Mes(3,2)="Operation canceled, Bye"
Mes(4,1)="Identification "
Mes(4,2)="Identify "
Mes(5,1)=" Musique(s) dans la liste de référence"
Mes(5,2)=" Song(s) from your taging's reference"
Mes(6,1)="Continuer ?"
Mes(6,2)="Continu ?"
Mes(7,1)=" Musique(s) dans Database MediaMonkey"
Mes(7,2)=" Song(s) in MediaMonkey's DataBase"
Mes(8,1)="Lancer la recherche ? (Cela peut être long)"
Mes(8,2)="Ready to start comparation ? (Can be very long)"
Mes(9,1)="Rapport d'analyse différence(s) Classement"
Mes(9,2)="Report Analyze delta Rating Source <> MM"
Mes(10,1)="Confirmez Maj"
Mes(10,2)="Confirm Update"
Mes(11,1)="Copie Classements dans MM Database et dans les fichiers MP3"
Mes(11,2)="Make Update for Rating in MM Library and MP3 Tag Files"
Mes(12,1)="Sauve en HTML"
Mes(12,2)="Save in HTML"
Mes(13,1)="Sauve le rapport en page WEB sous "
Mes(13,2)="Save report in HTML under "
Mes(14,1)="Ne pas faire Maj"
Mes(14,2)="Do Not Update"
Mes(15,1)="Abandonne Mise à jour, ne modifie rien"
Mes(15,2)="Cancel Update, don't modify anything"
Mes(16,1)="Compare référence avec MM..."
Mes(16,2)="Comparing Source with MM...."
Mes(17,1)="Nombre de MP3 "
Mes(17,2)="Total Tracks "
Mes(18,1)=" devant être(s) mise à jour"
Mes(18,2)=" need to be updated"
Mes(19,1)=" non trouvé(s) dans MM"
Mes(19,2)=" not find in MM"
Mes(20,1)="Liste de Lecture sauvée sous "
Mes(20,2)="Player Liste saved under "
Mes(21,1)="HTML Rapport sauvé sous"
Mes(21,2)="HTML Raport saved under"
Mes(22,1)="Confirmer demande de mise à jour des classements" & vbcrlf & "dans Database MM et dans les fichiers MP3 ?"
Mes(22,2)="Confirm Update Rating" & vbcrlf & "in MM's Database and in MP3's File(s)"
Mes(23,1)=" Classement à mettre à jour"
Mes(23,2)=" Rating to change"
Mes(24,1)=" Rien à modifier, Au revoir"
Mes(24,2)=" Nothing to do, Bye"
Mes(25,1)="Titre"
Mes(25,2)="Title"
Mes(26,1)="Artiste"
Mes(26,2)="Artist"
Mes(27,1)="Réf Classement"
Mes(27,2)="Ref Rating"
Mes(28,1)="MM Classement"
Mes(28,2)="MM rating"
Mes(29,1)="Liste Vide, rien à analyser, Au revoir"
Mes(29,2)="Empty List, Nothing to analyze, Bye"
'__________________________________________________
Sub UTAG
Dim Temp, Result, res
Dim Sr, itm, list ' Source Song
Dim mk, tag, last 'MM Song
Dim Srm, mkm, ffind, ftag ' Compare var
Dim Progress, fso, mks, fsm
Dim Srce(), MM(), Ko()
res="French"
Do While lng=0
res=InputBox("Select your langage" & vbcrlf & "1 for French" & vbcrlf & "2 for English" & vbcrlf,"Question",1)
If res = 1 then
lng=1
Elseif res=2 then
lng=2
End If
Loop
res= MsgBox (Mes(1,lng) & vbcrlf & vbcrlf & vbcrlf, 4096+1+32,Mes(2,lng))
if res<> 1 then
MsgBox Mes(3,lng)
Exit Sub
End If
fname = Day(Now) & " " & MonthName(Month(Now)) & " " & Year(Now) & " " & Hour(Now) & "h" & Minute(Now)
'-------------------------------------------------------------------------------------
' Here Work from Source, scan Songs
' Iterate through the list and export all songs
mks = 0
Set Temp = SDB.MainTree.CurrentNode
Temp.Expanded = True
Set list = SDB.CurrentSongList
Redim Srce(list.count-1,4)
If list.count = 0 then
MsgBox Mes(29,lng)
Exit Sub
End If
for Sr=0 to list.count-1
Set itm = list.Item(Sr)
Srce(Sr,1) = itm.Title
Srce(Sr,2) = itm.AlbumName
Srce(Sr,3) = itm.ArtistName
Srce(Sr,4) = itm.Rating
next
if Temp.Caption <> SDB.Localize("Artist") Then
mks = 1
End If
'-------------------------------------------------------------------------------------
' Here switch to MM Database node Artist
Set Temp = SDB.MainTree.Node_Artist
SDB.MainTree.CurrentNode = Temp
Temp.Expanded = True
SDB.MainTree.CurrentNode.SortCriteria = 4 'Does means not work !!!!
res = SDB.MessageBox( Mes(4,lng) & CStr(Sr) & Mes(5,lng) & vbcrlf & vbcrlf & Mes(6,lng), mtWarning, Array(mbYes,mbNo,mbAbort))
If res <> 6 Then
MsgBox Mes(3,lng)
Exit Sub
End If
'-------------------------------------------------------------------------------------
' Here Work from MM, scan Songs
' Iterate through the list and export all songs
Set last = SDB.CurrentSongList
Redim MM(last.count-1,4)
If last.count = 0 then
MsgBox Mes(29,lng)
Exit Sub
End If
for mk=0 to last.count-1
Set tag = last.Item(mk)
MM(mk,1) = tag.Title
MM(mk,2) = tag.AlbumName
MM(mk,3) = tag.ArtistName
MM(mk,4) = tag.Rating
next
res = SDB.MessageBox( Mes(4,lng) + CStr(mk ) + Mes(7,lng) & vbcrlf & vbcrlf &_
Mes(8,lng), mtWarning, Array(mbYes,mbNo,mbAbort))
If res <> 6 Then
MsgBox Mes(3,lng)
Exit Sub
End If
'*******************************************************************'
' Create Form for reporting
Dim DlgWith, ecart
DlgWith = 700
ecart = (DlgWith-368)/7
Dim Report : Set Report = SDB.UI.NewForm
Report.Common.SetRect 50,50,DlgWith,400
Report.Common.MinWidth = DlgWith
Report.Common.MinHeight = 200
Report.FormPosition = 4
Report.BorderStyle = 2
Report.Caption = Mes(9,lng)
' Script.RegisterEvent Report, "OnClose", "Salut"
' Create a web browser component
Dim WB : Set WB = SDB.UI.NewActiveX(Report, "Shell.Explorer")
WB.Common.Align = 5 ' Fill all client rectangle
WB.Common.ControlName = "WB"
' Create a panel at the bottom of the window
Dim Faot : Set Faot = SDB.UI.NewPanel(Report)
Faot.Common.Align = 2
Faot.Common.Height = 40
Faot.Common.Width = DlgWith
Dim Maj : Set Maj = SDB.UI.NewButton(Faot)
Maj.Common.SetRect (ecart * 2) ,6,120,28
Maj.Common.Anchors = 8
Maj.Caption = Mes(10,lng)
Maj.Common.Hint = Mes(11,lng)
Maj.ModalResult = 10
Dim Sfl : Set Sfl = SDB.UI.NewButton(Faot)
Sfl.Common.SetRect (120+(ecart*3)),6,120,28
Sfl.Common.Anchors = 8
Sfl.Caption = Mes(12,lng)
Sfl.Common.Hint = Mes(13,lng) & SDB.MyMusicPath
Sfl.ModalResult = 20
Dim Niet : Set Niet = SDB.UI.NewButton(Faot)
Niet.Common.SetRect (240+(ecart*4)),6,120,28
Niet.Common.Anchors = 8
Niet.Caption = Mes(14,lng)
Niet.Common.Hint = Mes(15,lng)
Niet.ModalResult = 30
Niet.default = True
' SDB.Objects("Etat") = Report ' Save reference to the form somewhere, otherwise it would simply disappear
' Format header line
InitHead
'-------------------------------------------------------------------------------------
' Here Compare Scanning and list delta
Dim RSrce, RMM
ffind = 0
ftag = 0
mkm = mk -1
Srm = Sr -1
Redim Ko(Srm,2) ' At Maxi the Song number of Source
Set Progress = SDB.Progress
Progress.Text =Mes(16,lng)
Progress.MaxValue = Srm
For Sr=0 to Srm
' Search and Compare Loop
'--------------------------------------------------------------------------------
' Validate this instruction if the 2 Node View are not sorted as the same way
if mks = 1 then
mk = 0
end if
'--------------------------------------------------------------------------------
Do While mk <= mkm
If Srce(Sr,1) = MM(mk,1) Then
If Srce(Sr,2) = MM(mk,2) then
If Srce(Sr,3) = MM(mk,3) then
if Srce(Sr,4) = MM(mk,4) then
ffind = ffind+1
Else
Ko(ftag,1)=Sr
Ko(ftag,2)=mk
ftag = ftag + 1
RSrce = Srce(Sr,4)/20
if RSrce < 0 Then
RSrce = "N/A"
Else
RSrce =String(RSrce, "*")
End If
RMM = MM(mk,4)/20
if RMM < 0 Then
RMM = "N/A"
Else
RMM =String(RMM, "*")
End If
' Body of the report
fout= fout & "<tr><td align=right class=dark>"&ftag&"</td><td align=left>"&Srce(Sr,1) &"</td><td align=left class=dark>"&Srce(Sr,3) _
&"</td><td align=left>"&Srce(Sr,2) &"</td><td align=center class=dark><b>"&RSrce _
&"</td><td align=center><b>"&RMM&"</b></td></tr>" & vbcrlf
Set tag = last.Item(mk)
fm3u = fm3u & tag.Path & vbcrlf
End If
Exit Do
End If
End If
End If
mk = mk +1
Loop
Progress.Value = Sr
Next
Set Progress = Nothing
if ftag > 0 Then
' Write some code to finish html document
fout = fout & "</table><p/><table width=100%><tr>" & vbcrlf
fout = fout & "<td style='border-bottom-width:0px'><b>"& Mes(17,lng) & ftag &"</b>" & (" / ") & (ffind+ftag) & Mes(18,lng) & "</td></tr>" & vbcrlf
fout = fout & "<tr><td style='border-bottom-width:0px'><b>" & Mes(17,lng) & Srm+1-(ffind+ftag) &"</b>" & (" / ") & Srm+1 & Mes(19,lng)& "</td></tr>" & vbcrlf
fout = fout & "<tr><td style='border-bottom-width:0px'>" & Mes(20,lng) & SDB.MyMusicPath & "Delta rating.m3u </td> <td align=right style='border-bottom-width:0px'>Generated under <a href='http://www.mediamonkey.com'>MediaMonkey</a></td>" & vbcrlf
fout = fout & "</tr></table></body></html>" & vbcrlf
WB.SetHTMLDocument(fout)
Set fsm = SDB.Tools.FileSystem
Set res = fsm.CreateTextFile(SDB.MyMusicPath & "Delta rating" & ".m3u", True)
res.Write fm3u
res.Close
Temp = 20
Do While Temp = 20
Temp = Report.ShowModal
Select Case Temp
Case 20
Set fso = SDB.Tools.FileSystem
Set Result = fso.CreateTextFile( SDB.MyMusicPath & "Report_Delta_Rating " & Fname & ".html", True)
Result.Write fout
Result.Close
MsgBox Mes(21,lng) & vbcrlf & SDB.MyMusicPath & "Report_Delta_Rating " & Fname & ".html"
Case 10
' Here Update MM File from delta
' Write all back to DB and update tags
If SDB.MessageBox(Mes(22,lng), mtWarning, Array(mbYes,mbNo)) = 6 then
Set last = SDB.CurrentSongList
Do While ftag > 0
Sr = Ko(ftag-1,1)
mk = Ko(ftag-1,2)
Set tag = last.Item(mk)
tag.Rating=Srce(Sr,4)
tag.WriteTags
tag.UpdateDB
ftag = ftag-1
Loop
MsgBox "Update Finished"
Else
Temp = 20
End If
' Case 30
Case Else
res = SDB.MessageBox(Mes(3,lng),mtInformation,Array(mbOK))
' SDB.Objects("Etat") = Nothing
End Select
Loop
Else
res = SDB.MessageBox( CStr(ftag)+ " / " & CStr(Srm+1) & Mes(23,lng) &vbcrlf & vbcrlf &Mes(24,lng), mtInformation, Array(mbOk))
End if
End Sub
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Sub InitHead
fout = "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">"
fout = fout & vbcrlf & "<html>"
fout = fout & vbcrlf & "<head><title>" & ("Report Analyse Rating") & "</title>"
' Code to format the document
fout = fout & vbcrlf & "<style type=text/css>"
fout = fout & vbcrlf & "body{font-family:'Verdana',sans-serif; background-color:#FFFFFF; font-size:9pt; color:#000000;}"
fout = fout & vbcrlf & "H1{font-family:'Verdana',sans-serif; font-size:13pt; font-weight:bold; color:#AAAAAA; text-aligh:left}"
fout = fout & vbcrlf & "P{font-family:'Verdana',sans-serif; font-size:9pt; color:#000000;}"
fout = fout & vbcrlf & "TH{font-family:'Verdana',sans-serif; font-size:10pt; font-weight:bold; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:3px;}"
fout = fout & vbcrlf & "TD{font-family:'Verdana',sans-serif; font-size:9pt; color:#000000; border-color:#000000; border-style: solid; border-left-width:0px; border-right-width:0px; border-top-width:0px; border-bottom-width:1px;}"
fout = fout & vbcrlf & "TD.dark{background-color:#EEEEEE}"
fout = fout & vbcrlf & "</style>"
fout = fout & vbcrlf & "</head><body>"
fout = fout & vbcrlf & "<h1>" & Mes(9,lng) & (" date : ") & fname & "</h1>"
fout = fout & vbcrlf & "<h1>" & ("Alain Poujade version : ") & Replace(CStr(version),",",".") & "</h1>"
' Headers of table
fout = fout & vbcrlf & "<table cellpadding=4 cellspacing=0>"
fout = fout & vbcrlf & "<tr align=left>"
fout = fout & vbcrlf & " <th id=dark>#</th>"
fout = fout & vbcrlf & " <th>" & (Mes(25,lng)) & "</th>"
fout = fout & vbcrlf & " <th id=dark>" & (Mes(26,lng)) & "</th>"
fout = fout & vbcrlf & " <th>" & ("Album") & "</th>"
fout = fout & vbcrlf & " <th id=dark>" & (Mes(27,lng)) & "</th>"
fout = fout & vbcrlf & " <th>" & (Mes(28,lng)) &"</th>"
fout = fout & vbcrlf & "</tr>"
fout = fout & vbcrlf
fm3u = "#EXTM3U" & vbcrlf
End Sub
Sub Salut(Report)
MsgBox "Not used at the moment"
End Sub
[/code]