www.pudn.com > SkyMediaSongTool.rar > main.bas
Attribute VB_Name = "mmain"
'获得拼音GetPinYin
'参数顺序: 拼音缓存区,要转换的字符,输出分隔符
Public Declare Function GetPinYin Lib "pinyin.dll" (ByVal pBuf As String, ByVal pString As String, Optional ByVal pSeparator As String = " ") As Long
'获得拼音首字母GetPinYinLeader
'参数顺序: 拼音缓存区,要转换的字符
Public Declare Function GetPinYinLeader Lib "pinyin.dll" (ByVal pBuf As String, ByVal pString As String) As Long
Public strBuf As String * 200 '字符缓存区
Public appath As String
Public sfn As String
Public isex As Integer
Public Function ZeroTrim(pStr As String) As String
Dim pos As Integer
pos = InStr(1, pStr, Chr(0))
If pos > 1 Then
ZeroTrim = Left(pStr, pos - 1)
Else
ZeroTrim = pStr
End If
End Function
Public Function getpy(str As String) As String
'防止传入空字符串
If Trim(str) = "" Then
getpy = ""
Exit Function
End If
'取得拼音首字母
Call GetPinYinLeader(strBuf, str)
tmppy = Replace(Replace(Replace(Replace(Replace(Replace(Replace(UCase(ZeroTrim(strBuf)), "'", ""), "", ""), " ", ""), ",", ""), ".", ""), "-", ""), "_", "")
If InStr(1, tmppy, "(") Then
getpy = Left(tmppy, InStr(1, tmppy, "(") - 1)
Else
If InStr(1, tmppy, "[") Then
getpy = Left(tmppy, InStr(1, tmppy, "[") - 1)
Else
getpy = tmppy
End If
End If
getpy = Replace(getpy, "1", "Y")
getpy = Replace(getpy, "2", "E")
getpy = Replace(getpy, "3", "S")
getpy = Replace(getpy, "4", "S")
getpy = Replace(getpy, "5", "W")
getpy = Replace(getpy, "6", "L")
getpy = Replace(getpy, "7", "Q")
getpy = Replace(getpy, "8", "B")
getpy = Replace(getpy, "9", "J")
getpy = Replace(getpy, "0", "L")
getpy = Replace(getpy, "*", "")
getpy = Replace(getpy, "#", "")
getpy = Replace(getpy, "$", "")
getpy = Replace(getpy, "&", "")
getpy = Replace(getpy, "@", "")
getpy = Replace(getpy, "!", "")
'getpy = Replace(getpy, "O", "")
getpy = Replace(getpy, "I", "")
getpy = Replace(getpy, "V", "")
getpy = Replace(getpy, "U", "")
getpy = IIf(Len(getpy) >= 10, UCase(Left(getpy, 9)), UCase(getpy))
End Function
Public Sub Main()
isex = 0
If connf() = 1 Then
If Right(App.Path, 1) = "\" Then
appath = App.Path
Else
appath = App.Path & "\"
End If
Dim f As File
Dim fs As Files
Dim fl As Folder
Set fl = fso.GetFolder(appath)
Set fs = fl.Files
Form1.Combo2.Clear
For Each f In fs
If LCase(Right(f.Name, 3)) = "dbf" Then
Form1.Combo2.AddItem Left(f.Name, InStr(1, f.Name, ".") - 1)
End If
Next f
Form1.Combo2.Text = Form1.Combo2.List(0)
Form5.Show
Else
MsgBox "数据连接出错", vbCritical + vbOKOnly, "错误提示"
End
End If
End Sub
Public Function typetxttotypeid(txt As String) As String
Select Case txt
Case "合唱歌"
typetxttotypeid = "8"
Case "校园歌"
typetxttotypeid = "9"
Case "生日歌"
typetxttotypeid = "10"
Case "DISCO"
typetxttotypeid = "11"
Case "革命歌曲"
typetxttotypeid = "12"
Case "戏曲"
typetxttotypeid = "13"
Case "浪漫舞曲"
typetxttotypeid = "14"
Case "怀旧舞曲"
typetxttotypeid = "15"
Case "流行金曲"
typetxttotypeid = "16"
Case "粤曲"
typetxttotypeid = "17"
Case "儿歌"
typetxttotypeid = "18"
Case "民歌"
typetxttotypeid = "19"
Case "其它"
typetxttotypeid = "20"
Case "季节"
typetxttotypeid = "21"
Case "试听"
typetxttotypeid = "试听"
Case "试唱"
typetxttotypeid = "试唱"
Case "战争"
typetxttotypeid = "战争"
Case "科幻"
typetxttotypeid = "科幻"
Case "警匪"
typetxttotypeid = "警匪"
Case "喜剧"
typetxttotypeid = "喜剧"
Case "爱情"
typetxttotypeid = "爱情"
Case "动画"
typetxttotypeid = "动画"
Case "武侠"
typetxttotypeid = "武侠"
Case "恐怖"
typetxttotypeid = "恐怖"
Case "革命"
typetxttotypeid = "革命"
Case "故事"
typetxttotypeid = "故事"
Case "相声"
typetxttotypeid = "相声"
End Select
End Function
Public Function typeidtotypetxt(txt As String) As String
Select Case txt
Case "8"
typeidtotypetxt = "合唱歌"
Case "9"
typeidtotypetxt = "校园歌"
Case "10"
typeidtotypetxt = "生日歌"
Case "11"
typeidtotypetxt = "DISCO"
Case "12"
typeidtotypetxt = "革命歌曲"
Case "13"
typeidtotypetxt = "戏曲"
Case "14"
typeidtotypetxt = "浪漫舞曲"
Case "15"
typeidtotypetxt = "怀旧舞曲"
Case "16"
typeidtotypetxt = "流行金曲"
Case "17"
typeidtotypetxt = "粤曲"
Case "18"
typeidtotypetxt = "儿歌"
Case "19"
typeidtotypetxt = "民歌"
Case "20"
typeidtotypetxt = "其它"
Case "21"
typeidtotypetxt = "季节"
Case "试听"
typeidtotypetxt = "试听"
Case "试唱"
typeidtotypetxt = "试唱"
Case "战争"
typeidtotypetxt = "战争"
Case "科幻"
typeidtotypetxt = "科幻"
Case "警匪"
typeidtotypetxt = "警匪"
Case "喜剧"
typeidtotypetxt = "喜剧"
Case "爱情"
typeidtotypetxt = "爱情"
Case "动画"
typeidtotypetxt = "动画"
Case "武侠"
typeidtotypetxt = "武侠"
Case "恐怖"
typeidtotypetxt = "恐怖"
Case "革命"
typeidtotypetxt = "革命"
Case "故事"
typeidtotypetxt = "故事"
Case "相声"
typeidtotypetxt = "相声"
End Select
End Function
Public Sub addsong(findex As Long, isa As Boolean)
If isa = True Then
On Error Resume Next
Else
On Error GoTo errhandle
End If
If findex < 0 Or CStr(findex) = "" Or findex > Form1.File1.ListCount Then
MsgBox "参数错误,超出范围!", vbOKOnly + vbCritical, "错误"
Exit Sub
End If
If isa = True Then
Dim tmpsingname As String
Dim tmpsinger As String
Dim tmplist As String
Dim rsnewsing As New ADODB.Recordset
sql = "select * from " & Trim(Form1.Combo2.Text)
rsnewsing.Open sql, conn, 1, 3
tmplist = Form1.File1.List(findex)
'MsgBox tmplist
'Exit Sub
If InStr(1, tmplist, "-") Then
If Form1.Combo5.Text = "歌手-歌名" Then
tmpsinger = Left(tmplist, InStr(1, tmplist, "-") - 1)
tmpsinger = Replace(tmpsinger, "&", "VS")
If Len(tmpsinger) > 10 Then tmpsinger = Left(tmpsinger, 7)
tmpsingname = Mid(tmplist, InStr(1, tmplist, "-") + 1, Len(tmplist) - 4 - InStr(1, tmplist, "-"))
tmpsingname = Replace(tmpsingname, "&", "")
If Len(tmpsingname) > 30 Then tmpsingname = Left(tmpsingname, 30)
Else
tmpsingname = Left(tmplist, InStr(1, tmplist, "-") - 1)
tmpsingname = Replace(tmpsingname, "&", "")
If Len(tmpsingname) > 30 Then tmpsingname = Left(tmpsingname, 30)
tmpsinger = Mid(tmplist, InStr(1, tmplist, "-") + 1, Len(tmplist) - 4 - InStr(1, tmplist, "-"))
tmpsinger = Replace(tmpsinger, "&", "VS")
If Len(tmpsinger) > 10 Then tmpsinger = Left(tmpsinger, 7)
End If
Else
If InStr(1, tmplist, "－") Then
If Form1.Combo5.Text = "歌手-歌名" Then
tmpsinger = Left(tmplist, InStr(1, tmplist, "－") - 1)
tmpsinger = Replace(tmpsinger, "&", "VS")
If Len(tmpsinger) > 10 Then tmpsinger = Left(tmpsinger, 7)
tmpsingname = Mid(tmplist, InStr(1, tmplist, "－") + 1, Len(tmplist) - 4 - InStr(1, tmplist, "－"))
tmpsingname = Replace(tmpsingname, "&", "")
If Len(tmpsingname) > 30 Then tmpsingname = Left(tmpsingname, 30)
Else
tmpsingname = Left(tmplist, InStr(1, tmplist, "－") - 1)
tmpsingname = Replace(tmpsingname, "&", "")
tmpsinger = Mid(tmplist, InStr(1, tmplist, "－") + 1, Len(tmplist) - 4 - InStr(1, tmplist, "－"))
tmpsinger = Replace(tmpsinger, "&", "VS")
If Len(tmpsinger) > 10 Then tmpsinger = Left(tmpsinger, 7)
If Len(tmpsingname) > 30 Then tmpsingname = Left(tmpsingname, 30)
End If
Else
tmpsingname = ""
tmpsinger = ""
End If
End If
j = 0
If tmpsinger <> "" And tmpsingname <> "" Then
DoEvents
rsnewsing.AddNew
rsnewsing("id") = CStr(CLng(Form1.Text5.Text))
Set adlv = Form1.LV1.ListItems.Add(, , CStr(CLng(Form1.Text5.Text)))
rsnewsing("singname") = tmpsingname
adlv.SubItems(1) = tmpsingname
rsnewsing("singer") = tmpsinger
adlv.SubItems(2) = tmpsinger
rsnewsing("type") = typetxttotypeid(Form1.Ttype.Text)
adlv.SubItems(5) = typetxttotypeid(Form1.Ttype.Text)
rsnewsing("language") = Trim(Form1.Tlanguage.Text)
adlv.SubItems(3) = Trim(Form1.Tlanguage.Text)
rsnewsing("mtvorvcd") = CLng(Form1.Tmtvorvcd.Text)
adlv.SubItems(7) = Form1.Tmtvorvcd.Text
rsnewsing("lengthes") = Len(getpy(tmpsingname))
adlv.SubItems(4) = Len(getpy(tmpsingname))
rsnewsing("area") = "14"
adlv.SubItems(6) = "14"
rsnewsing("file_loca") = "HAVE"
If Form1.tdiskname.Value = 1 Then
rsnewsing("diskname") = "1"
adlv.SubItems(9) = "1"
Else
rsnewsing("diskname") = "0"
adlv.SubItems(9) = "0"
End If
rsnewsing("sex") = 0
adlv.SubItems(10) = "0"
rsnewsing("temp") = 0
adlv.SubItems(11) = "0"
rsnewsing("qindex") = getpy(tmpsingname)
adlv.SubItems(8) = getpy(tmpsingname)
rsnewsing.Update
tmpaaaa = ""
Select Case LCase(Right(Form1.File1.List(findex), 3))
Case "mpg"
If Right(Form1.Dir1.Path, 1) = "\" Then
Name Form1.Dir1.Path & Form1.File1.List(findex) As Form1.Dir1.Path & CStr(CLng(Form1.Text5.Text)) & ".mpg"
Else
Name Form1.Dir1.Path & "\" & File1.List(findex) As Form1.Dir1.Path & "\" & CStr(CLng(Form1.Text5.Text)) & ".mpg"
End If
Case "dat"
If Right(Form1.Dir1.Path, 1) = "\" Then
Name Form1.Dir1.Path & Form1.File1.List(findex) As Form1.Dir1.Path & CStr(CLng(Form1.Text5.Text)) & ".dat"
Else
Name Form1.Dir1.Path & "\" & Form1.File1.List(findex) As Form1.Dir1.Path & "\" & CStr(CLng(Form1.Text5.Text)) & ".dat"
End If
Case "mp2"
If Right(Form1.Dir1.Path, 1) = "\" Then
Name Form1.Dir1.Path & Form1.File1.List(findex) As Form1.Dir1.Path & CStr(CLng(Form1.Text5.Text)) & ".mp2"
Else
Name Form1.Dir1.Path & "\" & Form1.File1.List(findex) As Form1.Dir1.Path & "\" & CStr(CLng(Form1.Text5.Text)) & ".mp2"
End If
Case "vob"
If Right(Form1.Dir1.Path, 1) = "\" Then
Name Form1.Dir1.Path & Form1.File1.List(findex) As Form1.Dir1.Path & CStr(CLng(Form1.Text5.Text)) & ".vob"
Else
Name Form1.Dir1.Path & "\" & Form1.File1.List(findex) As Form1.Dir1.Path & "\" & CStr(CLng(Form1.Text5.Text)) & ".vob"
End If
End Select
Form1.File1.Refresh
Form1.Text5.Text = CStr(CLng(Form1.Text5.Text) + 1)
rsnewsing.Close
MsgBox "文件添加歌库表并按指定ID重命名成功!", vbOKOnly + vbInformation, "提示"
Else
rsnewsing.Close
MsgBox "文件添加歌库不成功,文件名不合规则,请选择手动添加!", vbOKOnly + vbInformation, "提示"
End If
Else
Form4.TID.Text = Trim(Form1.Text5.Text)
Form4.Tlanguage = Form1.Tlanguage
Form4.Ttype = Form1.Ttype
Form4.tdiskname.Value = Form1.tdiskname.Value
Form4.Tmtvorvcd.Text = Form1.Tmtvorvcd.Text
Form4.Show
End If
Exit Sub
errhandle:
MsgBox "歌曲添加过程中有错误发生,请检查!", vbOKOnly + vbCritical, "错误"
If rs.State <> 0 Then rs.Close
End Sub