Minimum requirements: VB4
Download: source code
Screenshot:
Project: Standard EXE
Controls: fm (Frame), cmdDown (CommandButton), cmdUp (CommandButton), cmdFix (CommandButton), cmdApply (CommandButton), txtTitle (TextBox), txtArtist (TextBox), txtFile (TextBox), lbl (Label), lbl (Label), lbl (Label), File1 (FileListBox), Dir1 (DirListBox), Drive1 (DriveListBox)
Code:
Option Explicit
Dim sDir As String
Private Sub cmdApply_Click()
If Len(txtArtist) > 30 Then
If MsgBox("Artist tag is longer than 30 characters" & vbCrLf & _
" Would you like to truncate it?", vbYesNo, "Warning") = vbYes Then
txtArtist = Trim(Left(txtArtist, 27)) & "..."
Else
MsgBox "Unable to apply changes", , "Error"
End If
Exit Sub
End If
If Len(txtTitle) > 30 Then
If MsgBox("Title tag is longer than 30 characters" & vbCrLf & _
" Would you like to truncate it?", vbYesNo, "Warning") = vbYes Then
txtTitle = Trim(Left(txtTitle, 27)) & "..."
Else
MsgBox "Unable to apply changes", , "Error"
End If
Exit Sub
End If
If Len(txtFile) > 255 Then
If MsgBox("File name is longer than 255 characters" & vbCrLf & _
" Would you like to truncate it?", vbYesNo, "Warning") = vbYes Then
txtFile = Trim(Left(txtFile, 255))
Else
MsgBox "Unable to apply changes", , "Error"
End If
Exit Sub
End If
If InStr(txtFile, "*") > 0 Or InStr(txtFile, "?") > 0 Then
MsgBox "Special characters from file name will be removed", , "Warning"
txtFile = Replace(txtFile, "*", "")
txtFile = Replace(txtFile, "?", "")
Exit Sub
End If
Me.MousePointer = vbHourglass
If Dir(File1.Path & "\new", vbDirectory) = "" Then MkDir File1.Path & "\new"
Name File1.Path & "\" & File1.List(File1.ListIndex) As File1.Path & "\new\" & txtFile
SetTag File1.Path & "\new\" & txtFile, txtTitle, txtArtist
File1.Refresh
txtFile = "": txtTitle = "": txtArtist = ""
If File1.ListCount > 0 Then File1.ListIndex = 0
Me.MousePointer = vbDefault
End Sub
Private Sub cmdDown_Click()
If InStr(txtFile, "-") <> 0 Then
txtArtist = Left(txtFile, InStr(txtFile, "-") - 1)
txtArtist = Replace(txtArtist, "_", " ")
txtArtist = Capitalize(txtArtist)
End If
txtTitle = Mid(txtFile, InStr(txtFile, "-") + 1)
txtTitle = Left(txtTitle, Len(txtTitle) - 4)
txtTitle = Replace(txtTitle, "_", " ")
txtTitle = Capitalize(txtTitle)
End Sub
Private Sub cmdFix_Click()
txtFile = Replace(txtFile, " ", "_")
txtFile = Replace(txtFile, "_-_", "-")
txtFile = Replace(txtFile, "(", "")
txtFile = Replace(txtFile, ")", "")
End Sub
Private Sub cmdUp_Click()
txtFile = txtArtist & "-" & txtTitle & ".mp3"
txtFile = Replace(txtFile, " ", "_")
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
If File1.ListCount > 0 Then File1.ListIndex = 0
End Sub
Private Sub Drive1_Change()
Dim sDrive As String
sDrive = Drive1.Drive
If InStr(sDrive, "[") <> 0 Then sDrive = Trim(Left(sDrive, InStr(sDrive, "[") - 1))
sDrive = sDrive & "\"
Dir1.Path = sDrive
End Sub
Private Sub Form_Load()
sDir = GetSetting("mp3_norm", "StartUp", "Dir", "")
If Dir(sDir, vbDirectory) <> "" And Dir(sDir, vbDirectory) <> "." Then
Drive1.Drive = Left(sDir, InStr(sDir, ":") - 1)
Dir1.Path = sDir
End If
End Sub
Private Sub File1_Click()
Dim sFile As String
sFile = File1.Path & "\" & File1.List(File1.ListIndex)
Dim sArtist As String
Dim sTitle As String
txtFile = File1.List(File1.ListIndex)
txtTitle = ""
txtArtist = ""
If GetTag(sFile, sTitle, sArtist) Then
txtTitle = Capitalize(sTitle)
txtArtist = Capitalize(sArtist)
End If
End Sub
Private Function GetTag(ByVal sFile As String, sTitle As String, sArtist As String) As Boolean
Dim b As Byte
Dim l As Long
Dim s As String
l = FileLen(sFile) - 1
Open sFile For Binary Access Read As 1
While FileLen(sFile) - l < 128
l = l - 1
Get #1, l, b
s = Chr(b) & s
Wend
Close #1
If InStr(s, "TAG") <> 0 Then
s = Mid(s, InStr(s, "TAG") + 3)
For l = 1 To 30
sTitle = sTitle & RusLat(Mid(s, l, 1))
Next
For l = 31 To 60
sArtist = sArtist & RusLat(Mid(s, l, 1))
Next
sTitle = Trim(sTitle)
sArtist = Trim(sArtist)
GetTag = True
Else
GetTag = False
End If
End Function
Private Function SetTag(ByVal sFile As String, sTitle As String, sArtist As String) As Boolean
Dim b As Byte
Dim l As Long
Dim lPos As Long
Dim s As String
Dim i As Integer
l = FileLen(sFile)
Open sFile For Binary Access Read Write As 1
While FileLen(sFile) - l < 128
Get #1, l, b
s = Chr(b) & s
l = l - 1
Wend
If InStr(s, "TAG") <> 0 Then
s = Left(s, InStr(s, "TAG") - 1)
l = FileLen(sFile) - 127 + Len(s)
Else
s = ""
l = FileLen(sFile) - 1
End If
s = s & "TAG" & txtTitle & Space(30 - Len(txtTitle)) & txtArtist & Space(30 - Len(txtArtist)) & Space(64)
For lPos = l To l + Len(s) - 1
i = i + 1
Put #1, lPos, Asc(Mid(s, i, 1))
Next
Close #1
End Function
Private Function Capitalize(ByVal s As String) As String
Dim i As Integer
s = UCase(Mid(s, 1, 1)) & LCase(Mid(s, 2))
For i = 2 To Len(s)
If Mid(s, i, 1) = " " Or Mid(s, i, 1) = "." Or Mid(s, i, 1) = "," Then
If i <> Len(s) Then s = Left(s, i) & UCase(Mid(s, i + 1, 1)) & Mid(s, i + 2)
End If
Next
Capitalize = s
End Function
Private Function RusLat(ByVal s As String) As String
Select Case Asc(s)
'lower case
Case &HB8: RusLat = "yo"
Case &HE9: RusLat = "y"
Case &HF6: RusLat = "ts"
Case &HF3: RusLat = "u"
Case &HEA: RusLat = "k"
Case &HE5: RusLat = "e"
Case &HED: RusLat = "n"
Case &HE3: RusLat = "g"
Case &HF8: RusLat = "sh"
Case &HF9: RusLat = "sch"
Case &HE7: RusLat = "z"
Case &HF5: RusLat = "kh"
Case &HFA: RusLat = "y"
Case &HF4: RusLat = "f"
Case &HFB: RusLat = "i"
Case &HE2: RusLat = "v"
Case &HE0: RusLat = "a"
Case &HEF: RusLat = "p"
Case &HF0: RusLat = "r"
Case &HEE: RusLat = "o"
Case &HEB: RusLat = "l"
Case &HE4: RusLat = "d"
Case &HE6: RusLat = "zh"
Case &HFD: RusLat = "e"
Case &HFF: RusLat = "ya"
Case &HF7: RusLat = "ch"
Case &HF1: RusLat = "s"
Case &HEC: RusLat = "m"
Case &HE8: RusLat = "i"
Case &HF2: RusLat = "t"
Case &HFC: RusLat = "'"
Case &HE1: RusLat = "b"
Case &HFE: RusLat = "yu"
'upper case
Case &H98: RusLat = "Yo"
Case &HE9: RusLat = "Y"
Case &HD6: RusLat = "Ts"
Case &HD3: RusLat = "U"
Case &HCA: RusLat = "K"
Case &HC5: RusLat = "E"
Case &HCD: RusLat = "N"
Case &HC3: RusLat = "G"
Case &HD8: RusLat = "Sh"
Case &HD9: RusLat = "Sch"
Case &HC7: RusLat = "Z"
Case &HD5: RusLat = "Kh"
Case &HDA: RusLat = "Y"
Case &HD4: RusLat = "F"
Case &HDB: RusLat = "I"
Case &HC2: RusLat = "V"
Case &HC0: RusLat = "A"
Case &HCF: RusLat = "P"
Case &HD0: RusLat = "R"
Case &HCE: RusLat = "O"
Case &HCB: RusLat = "L"
Case &HC4: RusLat = "D"
Case &HC6: RusLat = "Zh"
Case &HDD: RusLat = "E"
Case &HDF: RusLat = "Ya"
Case &HD7: RusLat = "Ch"
Case &HD1: RusLat = "S"
Case &HCC: RusLat = "M"
Case &HC8: RusLat = "I"
Case &HD2: RusLat = "T"
Case &HDC: RusLat = "'"
Case &HC1: RusLat = "B"
Case &HDE: RusLat = "Yu"
Case Else: RusLat = s
End Select
End Function
Private Sub Form_Unload(Cancel As Integer)
SaveSetting "mp3_norm", "StartUp", "Dir", File1.Path
End Sub
Controls: fm (Frame), cmdDown (CommandButton), cmdUp (CommandButton), cmdFix (CommandButton), cmdApply (CommandButton), txtTitle (TextBox), txtArtist (TextBox), txtFile (TextBox), lbl (Label), lbl (Label), lbl (Label), File1 (FileListBox), Dir1 (DirListBox), Drive1 (DriveListBox)
Code:
Option Explicit
Dim sDir As String
Private Sub cmdApply_Click()
If Len(txtArtist) > 30 Then
If MsgBox("Artist tag is longer than 30 characters" & vbCrLf & _
" Would you like to truncate it?", vbYesNo, "Warning") = vbYes Then
txtArtist = Trim(Left(txtArtist, 27)) & "..."
Else
MsgBox "Unable to apply changes", , "Error"
End If
Exit Sub
End If
If Len(txtTitle) > 30 Then
If MsgBox("Title tag is longer than 30 characters" & vbCrLf & _
" Would you like to truncate it?", vbYesNo, "Warning") = vbYes Then
txtTitle = Trim(Left(txtTitle, 27)) & "..."
Else
MsgBox "Unable to apply changes", , "Error"
End If
Exit Sub
End If
If Len(txtFile) > 255 Then
If MsgBox("File name is longer than 255 characters" & vbCrLf & _
" Would you like to truncate it?", vbYesNo, "Warning") = vbYes Then
txtFile = Trim(Left(txtFile, 255))
Else
MsgBox "Unable to apply changes", , "Error"
End If
Exit Sub
End If
If InStr(txtFile, "*") > 0 Or InStr(txtFile, "?") > 0 Then
MsgBox "Special characters from file name will be removed", , "Warning"
txtFile = Replace(txtFile, "*", "")
txtFile = Replace(txtFile, "?", "")
Exit Sub
End If
Me.MousePointer = vbHourglass
If Dir(File1.Path & "\new", vbDirectory) = "" Then MkDir File1.Path & "\new"
Name File1.Path & "\" & File1.List(File1.ListIndex) As File1.Path & "\new\" & txtFile
SetTag File1.Path & "\new\" & txtFile, txtTitle, txtArtist
File1.Refresh
txtFile = "": txtTitle = "": txtArtist = ""
If File1.ListCount > 0 Then File1.ListIndex = 0
Me.MousePointer = vbDefault
End Sub
Private Sub cmdDown_Click()
If InStr(txtFile, "-") <> 0 Then
txtArtist = Left(txtFile, InStr(txtFile, "-") - 1)
txtArtist = Replace(txtArtist, "_", " ")
txtArtist = Capitalize(txtArtist)
End If
txtTitle = Mid(txtFile, InStr(txtFile, "-") + 1)
txtTitle = Left(txtTitle, Len(txtTitle) - 4)
txtTitle = Replace(txtTitle, "_", " ")
txtTitle = Capitalize(txtTitle)
End Sub
Private Sub cmdFix_Click()
txtFile = Replace(txtFile, " ", "_")
txtFile = Replace(txtFile, "_-_", "-")
txtFile = Replace(txtFile, "(", "")
txtFile = Replace(txtFile, ")", "")
End Sub
Private Sub cmdUp_Click()
txtFile = txtArtist & "-" & txtTitle & ".mp3"
txtFile = Replace(txtFile, " ", "_")
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
If File1.ListCount > 0 Then File1.ListIndex = 0
End Sub
Private Sub Drive1_Change()
Dim sDrive As String
sDrive = Drive1.Drive
If InStr(sDrive, "[") <> 0 Then sDrive = Trim(Left(sDrive, InStr(sDrive, "[") - 1))
sDrive = sDrive & "\"
Dir1.Path = sDrive
End Sub
Private Sub Form_Load()
sDir = GetSetting("mp3_norm", "StartUp", "Dir", "")
If Dir(sDir, vbDirectory) <> "" And Dir(sDir, vbDirectory) <> "." Then
Drive1.Drive = Left(sDir, InStr(sDir, ":") - 1)
Dir1.Path = sDir
End If
End Sub
Private Sub File1_Click()
Dim sFile As String
sFile = File1.Path & "\" & File1.List(File1.ListIndex)
Dim sArtist As String
Dim sTitle As String
txtFile = File1.List(File1.ListIndex)
txtTitle = ""
txtArtist = ""
If GetTag(sFile, sTitle, sArtist) Then
txtTitle = Capitalize(sTitle)
txtArtist = Capitalize(sArtist)
End If
End Sub
Private Function GetTag(ByVal sFile As String, sTitle As String, sArtist As String) As Boolean
Dim b As Byte
Dim l As Long
Dim s As String
l = FileLen(sFile) - 1
Open sFile For Binary Access Read As 1
While FileLen(sFile) - l < 128
l = l - 1
Get #1, l, b
s = Chr(b) & s
Wend
Close #1
If InStr(s, "TAG") <> 0 Then
s = Mid(s, InStr(s, "TAG") + 3)
For l = 1 To 30
sTitle = sTitle & RusLat(Mid(s, l, 1))
Next
For l = 31 To 60
sArtist = sArtist & RusLat(Mid(s, l, 1))
Next
sTitle = Trim(sTitle)
sArtist = Trim(sArtist)
GetTag = True
Else
GetTag = False
End If
End Function
Private Function SetTag(ByVal sFile As String, sTitle As String, sArtist As String) As Boolean
Dim b As Byte
Dim l As Long
Dim lPos As Long
Dim s As String
Dim i As Integer
l = FileLen(sFile)
Open sFile For Binary Access Read Write As 1
While FileLen(sFile) - l < 128
Get #1, l, b
s = Chr(b) & s
l = l - 1
Wend
If InStr(s, "TAG") <> 0 Then
s = Left(s, InStr(s, "TAG") - 1)
l = FileLen(sFile) - 127 + Len(s)
Else
s = ""
l = FileLen(sFile) - 1
End If
s = s & "TAG" & txtTitle & Space(30 - Len(txtTitle)) & txtArtist & Space(30 - Len(txtArtist)) & Space(64)
For lPos = l To l + Len(s) - 1
i = i + 1
Put #1, lPos, Asc(Mid(s, i, 1))
Next
Close #1
End Function
Private Function Capitalize(ByVal s As String) As String
Dim i As Integer
s = UCase(Mid(s, 1, 1)) & LCase(Mid(s, 2))
For i = 2 To Len(s)
If Mid(s, i, 1) = " " Or Mid(s, i, 1) = "." Or Mid(s, i, 1) = "," Then
If i <> Len(s) Then s = Left(s, i) & UCase(Mid(s, i + 1, 1)) & Mid(s, i + 2)
End If
Next
Capitalize = s
End Function
Private Function RusLat(ByVal s As String) As String
Select Case Asc(s)
'lower case
Case &HB8: RusLat = "yo"
Case &HE9: RusLat = "y"
Case &HF6: RusLat = "ts"
Case &HF3: RusLat = "u"
Case &HEA: RusLat = "k"
Case &HE5: RusLat = "e"
Case &HED: RusLat = "n"
Case &HE3: RusLat = "g"
Case &HF8: RusLat = "sh"
Case &HF9: RusLat = "sch"
Case &HE7: RusLat = "z"
Case &HF5: RusLat = "kh"
Case &HFA: RusLat = "y"
Case &HF4: RusLat = "f"
Case &HFB: RusLat = "i"
Case &HE2: RusLat = "v"
Case &HE0: RusLat = "a"
Case &HEF: RusLat = "p"
Case &HF0: RusLat = "r"
Case &HEE: RusLat = "o"
Case &HEB: RusLat = "l"
Case &HE4: RusLat = "d"
Case &HE6: RusLat = "zh"
Case &HFD: RusLat = "e"
Case &HFF: RusLat = "ya"
Case &HF7: RusLat = "ch"
Case &HF1: RusLat = "s"
Case &HEC: RusLat = "m"
Case &HE8: RusLat = "i"
Case &HF2: RusLat = "t"
Case &HFC: RusLat = "'"
Case &HE1: RusLat = "b"
Case &HFE: RusLat = "yu"
'upper case
Case &H98: RusLat = "Yo"
Case &HE9: RusLat = "Y"
Case &HD6: RusLat = "Ts"
Case &HD3: RusLat = "U"
Case &HCA: RusLat = "K"
Case &HC5: RusLat = "E"
Case &HCD: RusLat = "N"
Case &HC3: RusLat = "G"
Case &HD8: RusLat = "Sh"
Case &HD9: RusLat = "Sch"
Case &HC7: RusLat = "Z"
Case &HD5: RusLat = "Kh"
Case &HDA: RusLat = "Y"
Case &HD4: RusLat = "F"
Case &HDB: RusLat = "I"
Case &HC2: RusLat = "V"
Case &HC0: RusLat = "A"
Case &HCF: RusLat = "P"
Case &HD0: RusLat = "R"
Case &HCE: RusLat = "O"
Case &HCB: RusLat = "L"
Case &HC4: RusLat = "D"
Case &HC6: RusLat = "Zh"
Case &HDD: RusLat = "E"
Case &HDF: RusLat = "Ya"
Case &HD7: RusLat = "Ch"
Case &HD1: RusLat = "S"
Case &HCC: RusLat = "M"
Case &HC8: RusLat = "I"
Case &HD2: RusLat = "T"
Case &HDC: RusLat = "'"
Case &HC1: RusLat = "B"
Case &HDE: RusLat = "Yu"
Case Else: RusLat = s
End Select
End Function
Private Sub Form_Unload(Cancel As Integer)
SaveSetting "mp3_norm", "StartUp", "Dir", File1.Path
End Sub
No comments:
Post a Comment