www.pudn.com > SkyMediaSongTool.rar > Form1.frm
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "天行歌表工具--曾万程 13976025165 定制各种专业行业工具软件"
ClientHeight = 7755
ClientLeft = 45
ClientTop = 330
ClientWidth = 11880
Icon = "Form1.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7755
ScaleWidth = 11880
StartUpPosition = 2 '屏幕中心
Begin VB.ListBox rt1
Height = 3840
Left = 30
TabIndex = 69
Top = 1470
Visible = 0 'False
Width = 9240
End
Begin VB.Frame Frame9
Caption = "其他功能"
Height = 630
Left = 90
TabIndex = 64
Top = 7080
Width = 11745
Begin VB.CommandButton Command20
Caption = "清空日志"
Height = 360
Left = 5385
TabIndex = 68
Top = 195
Width = 1170
End
Begin VB.CommandButton Command19
Caption = "查看日志"
Height = 360
Left = 4170
TabIndex = 67
Top = 195
Width = 1200
End
Begin VB.CommandButton Command18
Caption = "中止当前操作"
Height = 360
Left = 2040
TabIndex = 66
Top = 195
Width = 2115
End
Begin VB.CommandButton Command17
Caption = "重计字数及拼音索引"
Height = 360
Left = 165
TabIndex = 65
Top = 195
Width = 1860
End
End
Begin VB.Frame Frame8
Caption = "加歌"
Height = 6945
Left = 9300
TabIndex = 42
Top = 150
Width = 2580
Begin VB.CheckBox tdiskname
Caption = "劲榜"
Height = 255
Left = 1800
TabIndex = 63
Top = 6150
Width = 675
End
Begin VB.ComboBox tmtvorvcd
Height = 300
ItemData = "Form1.frx":030A
Left = 1200
List = "Form1.frx":0314
TabIndex = 61
Text = "0"
Top = 6105
Width = 525
End
Begin VB.ComboBox tlanguage
Height = 300
ItemData = "Form1.frx":031E
Left = 1200
List = "Form1.frx":033A
TabIndex = 60
Text = "国语"
Top = 5760
Width = 1245
End
Begin VB.ComboBox ttype
Height = 300
ItemData = "Form1.frx":036E
Left = 1200
List = "Form1.frx":03C3
TabIndex = 58
Text = "流行金曲"
Top = 5415
Width = 1245
End
Begin VB.CommandButton Command16
Caption = "开始加歌"
Height = 375
Left = 135
TabIndex = 56
ToolTipText = "文件名符合指定规则,自动批量添加歌曲并以指定的起始ID号指定文件夹下的媒体文件重名命!"
Top = 4965
Width = 930
End
Begin VB.CommandButton Command15
Caption = "编号检测"
Height = 345
Left = 120
TabIndex = 54
Top = 4575
Width = 945
End
Begin VB.TextBox Text5
Height = 270
Left = 990
TabIndex = 53
Text = "0"
Top = 4230
Width = 1455
End
Begin VB.OptionButton Option4
Caption = "vob"
Height = 270
Left = 1890
TabIndex = 51
Top = 3930
Width = 600
End
Begin VB.OptionButton Option3
Caption = "dat"
Height = 270
Left = 1285
TabIndex = 50
Top = 3930
Width = 600
End
Begin VB.OptionButton Option2
Caption = "mp2"
Height = 270
Left = 710
TabIndex = 49
Top = 3930
Width = 600
End
Begin VB.OptionButton Option1
Caption = "mpg"
Height = 270
Left = 90
TabIndex = 48
Top = 3930
Value = -1 'True
Width = 600
End
Begin VB.FileListBox File1
Height = 1530
Left = 105
OLEDragMode = 1 'Automatic
TabIndex = 47
ToolTipText = "单曲加歌请将文件拖到数据窗口"
Top = 2385
Width = 2355
End
Begin VB.DirListBox Dir1
Height = 1350
Left = 105
TabIndex = 46
Top = 1035
Width = 2355
End
Begin VB.DriveListBox Drive2
Height = 300
Left = 120
TabIndex = 45
Top = 735
Width = 2370
End
Begin VB.ComboBox Combo5
Height = 300
ItemData = "Form1.frx":0480
Left = 120
List = "Form1.frx":048A
TabIndex = 43
Text = "歌手-歌名"
Top = 435
Width = 2355
End
Begin VB.Label Label14
Caption = "声道:"
Height = 225
Index = 2
Left = 615
TabIndex = 62
Top = 6180
Width = 480
End
Begin VB.Label Label14
Caption = "语种:"
Height = 225
Index = 1
Left = 615
TabIndex = 59
Top = 5850
Width = 480
End
Begin VB.Label Label14
Caption = "类别:"
Height = 225
Index = 0
Left = 615
TabIndex = 57
Top = 5475
Width = 480
End
Begin VB.Label Label13
BackColor = &H00800000&
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
ForeColor = &H0000FF00&
Height = 735
Left = 1170
TabIndex = 55
Top = 4590
Width = 1275
End
Begin VB.Label Label12
Caption = "起始编号:"
Height = 240
Left = 135
TabIndex = 52
Top = 4275
Width = 1140
End
Begin VB.Label Label11
Caption = "文件名格式"
Height = 195
Left = 75
TabIndex = 44
Top = 240
Width = 1110
End
End
Begin VB.Frame Frame7
Caption = "ID号重编"
Height = 1725
Left = 5730
TabIndex = 32
Top = 5355
Width = 3510
Begin VB.CommandButton Command21
Caption = "浏览.."
Height = 315
Left = 2490
TabIndex = 71
ToolTipText = "指定文件夹下的媒体文件重编号"
Top = 1290
Width = 900
End
Begin VB.TextBox Text6
Height = 270
Left = 120
TabIndex = 70
Top = 1320
Width = 2295
End
Begin VB.CommandButton Command14
Caption = "开始编号"
Height = 315
Left = 2490
TabIndex = 41
Top = 840
Width = 900
End
Begin VB.CommandButton Command13
Caption = "测试"
Height = 315
Left = 1500
TabIndex = 40
ToolTipText = "校验指定编号是否合法"
Top = 840
Width = 915
End
Begin VB.TextBox Text4
Height = 300
Left = 1500
TabIndex = 37
Text = "0"
Top = 480
Width = 780
End
Begin VB.CommandButton Command12
Caption = "搜索"
Height = 315
Left = 120
TabIndex = 35
Top = 840
Width = 645
End
Begin VB.ComboBox Combo4
Height = 300
Left = 90
TabIndex = 33
Top = 480
Width = 1335
End
Begin VB.Label Label10
BorderStyle = 1 'Fixed Single
Caption = "0"
Height = 330
Left = 2400
TabIndex = 39
Top = 465
Width = 960
End
Begin VB.Label Label9
Caption = "预编码"
Height = 240
Left = 2370
TabIndex = 38
Top = 195
Width = 975
End
Begin VB.Label Label8
Caption = "起始编号"
Height = 255
Left = 1515
TabIndex = 36
Top = 210
Width = 780
End
Begin VB.Label Label7
Caption = "重编号的单盘表"
Height = 240
Left = 90
TabIndex = 34
Top = 225
Width = 1275
End
End
Begin VB.Frame Frame6
Caption = "歌表合并"
Height = 1695
Left = 2625
TabIndex = 24
Top = 5370
Width = 3075
Begin VB.CommandButton Command11
Caption = "搜索源表"
Height = 360
Left = 150
TabIndex = 31
ToolTipText = "在当前文件中搜索所有.dbf表"
Top = 795
Width = 1125
End
Begin VB.TextBox Text3
Height = 315
Left = 1710
TabIndex = 30
Text = "totaltab"
Top = 435
Width = 1140
End
Begin VB.CommandButton Command10
Caption = "合并"
Height = 360
Left = 1830
TabIndex = 29
Top = 795
Width = 1020
End
Begin VB.ComboBox Combo3
Height = 300
Left = 150
TabIndex = 25
Top = 450
Width = 1125
End
Begin VB.Label Label6
Caption = "目的表"
Height = 270
Left = 1770
TabIndex = 28
Top = 210
Width = 1035
End
Begin VB.Label Label5
Caption = "源表"
Height = 225
Left = 135
TabIndex = 27
Top = 240
Width = 1050
End
Begin VB.Label Label4
Caption = "===>"
Height = 195
Left = 1335
TabIndex = 26
Top = 480
Width = 435
End
End
Begin VB.Frame Frame5
Caption = "单硬盘歌表生成"
Height = 1710
Left = 75
TabIndex = 21
Top = 5355
Width = 2490
Begin VB.CommandButton Command9
Caption = "生成"
Height = 390
Left = 1245
TabIndex = 23
Top = 690
Width = 1140
End
Begin VB.DriveListBox Drive1
Height = 300
Left = 105
TabIndex = 22
Top = 225
Width = 2280
End
End
Begin VB.Frame Frame4
Caption = "其他操作"
Height = 1230
Left = 6000
TabIndex = 13
Top = 150
Width = 3255
Begin VB.TextBox Text2
Height = 375
Left = 2745
TabIndex = 19
Text = "14"
Top = 735
Width = 435
End
Begin VB.CommandButton Command7
Caption = "音量标准化到"
Height = 390
Left = 1440
TabIndex = 18
Top = 735
Width = 1290
End
Begin VB.CommandButton Command6
Caption = "初始化点击率"
Height = 390
Left = 105
TabIndex = 17
Top = 735
Width = 1320
End
Begin VB.CommandButton Command5
Caption = "显示电影"
Height = 360
Left = 2175
TabIndex = 16
Top = 300
Width = 960
End
Begin VB.CommandButton Command4
Caption = "清空劲榜"
Height = 360
Left = 1140
TabIndex = 15
Top = 300
Width = 1005
End
Begin VB.CommandButton Command3
Caption = "显示劲榜"
Height = 360
Left = 105
TabIndex = 14
Top = 300
Width = 1005
End
End
Begin VB.Frame Frame3
Caption = "校验歌库"
Height = 1245
Left = 3060
TabIndex = 10
Top = 135
Width = 2835
Begin VB.CommandButton Command8
Caption = "生成失败列表"
Height = 390
Left = 90
TabIndex = 20
Top = 765
Width = 1470
End
Begin VB.CommandButton Command2
Caption = "开始校验"
Height = 405
Left = 1590
TabIndex = 11
Top = 750
Width = 1095
End
Begin VB.Label Label3
Caption = "校验搜索出来的歌曲是否存在对应的媒体文件,如果存在,则转移到90005OK表中"
ForeColor = &H000000FF&
Height = 615
Left = 105
TabIndex = 12
Top = 225
Width = 2640
End
End
Begin VB.Frame Frame2
Caption = "歌曲搜索"
Height = 1245
Left = 30
TabIndex = 5
Top = 135
Width = 3015
Begin VB.ComboBox Combo2
Height = 300
ItemData = "Form1.frx":04A4
Left = 120
List = "Form1.frx":04B1
TabIndex = 9
Text = "90005"
Top = 780
Width = 1680
End
Begin VB.TextBox Text1
Height = 300
Left = 1080
TabIndex = 8
Top = 360
Width = 1815
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "Form1.frx":04CF
Left = 120
List = "Form1.frx":04EB
TabIndex = 7
Text = "歌名"
Top = 360
Width = 855
End
Begin VB.CommandButton Command1
Caption = "搜索"
Height = 375
Left = 1920
TabIndex = 6
Top = 765
Width = 975
End
End
Begin MSComctlLib.ListView LV1
Height = 3810
Left = 45
TabIndex = 0
Top = 1455
Width = 9225
_ExtentX = 16272
_ExtentY = 6720
View = 3
LabelEdit = 1
SortOrder = -1 'True
LabelWrap = 0 'False
HideSelection = 0 'False
OLEDropMode = 1
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
OLEDropMode = 1
NumItems = 12
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "ID"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "歌名"
Object.Width = 3528
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "歌手"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "语种"
Object.Width = 1058
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 4
Text = "字数"
Object.Width = 1058
EndProperty
BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 5
Text = "类型"
Object.Width = 1058
EndProperty
BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 6
Text = "音量"
Object.Width = 1058
EndProperty
BeginProperty ColumnHeader(8) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 7
Text = "声道"
Object.Width = 1058
EndProperty
BeginProperty ColumnHeader(9) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 8
Text = "拼音"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(10) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 9
Text = "劲榜"
Object.Width = 1235
EndProperty
BeginProperty ColumnHeader(11) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 10
Text = "电影标示"
Object.Width = 882
EndProperty
BeginProperty ColumnHeader(12) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 11
Text = "点击数"
Object.Width = 1235
EndProperty
End
Begin VB.Frame Frame1
Caption = "数据读取进度"
Height = 1335
Left = 120
TabIndex = 1
Top = 1800
Visible = 0 'False
Width = 8535
Begin MSComctlLib.ProgressBar PBar1
Height = 495
Left = 120
TabIndex = 2
Top = 360
Width = 8295
_ExtentX = 14631
_ExtentY = 873
_Version = 393216
Appearance = 0
Scrolling = 1
End
Begin VB.Label Label2
Height = 255
Left = 120
TabIndex = 4
Top = 960
Width = 3135
End
Begin VB.Label Label1
Height = 255
Left = 3600
TabIndex = 3
Top = 960
Width = 2055
End
End
Begin VB.Menu pop1
Caption = "pop1"
Visible = 0 'False
Begin VB.Menu Fdel
Caption = "删除记录"
End
Begin VB.Menu editsong
Caption = "编辑记录"
End
Begin VB.Menu FdelandF
Caption = "删除文件"
End
Begin VB.Menu searchfile
Caption = "试听歌曲"
End
Begin VB.Menu DESCsort
Caption = "降序排序"
Checked = -1 'True
End
Begin VB.Menu ASCsort
Caption = "升序排序"
Checked = -1 'True
End
Begin VB.Menu tabsaveas
Caption = "列表另存为"
End
End
Begin VB.Menu pop2
Caption = "pop2"
Visible = 0 'False
Begin VB.Menu lsong
Caption = "试听歌曲"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub ASCsort_Click()
LV1.SortOrder = lvwAscending
If LV1.SortOrder = lvwAscending Then
ASCsort.Checked = True
DESCsort.Checked = False
Else
ASCsort.Checked = False
DESCsort.Checked = True
End If
End Sub
Private Sub Command1_Click()
Dim tmpsql As String, tmptable As String
If Trim(Combo2.Text) = "" Then
tmpsql = "select * from 90005"
Else
tmpsql = "select * from " & Combo2.Text
End If
Select Case Combo1.Text
Case ""
Exit Sub
Case "全部"
Case "歌名"
If Trim(Text1.Text) = "" Then
tmpsql = tmpsql & " where singname=NULL"
Else
tmpsql = tmpsql & " where singname like '" & Trim(Text1.Text) & "%'"
End If
Case "歌手"
If Trim(Text1.Text) = "" Then
tmpsql = tmpsql & " where singer=NULL"
Else
tmpsql = tmpsql & " where singer like '" & Trim(Text1.Text) & "%'"
End If
Case "编号"
If Trim(Text1.Text) = "" Then
tmpsql = tmpsql & " where ID=NULL"
Else
tmpsql = tmpsql & " where ID like '" & Trim(Text1.Text) & "%'"
End If
Case "拼音"
If Trim(Text1.Text) = "" Then
tmpsql = tmpsql & " where qindex=NULL"
Else
tmpsql = tmpsql & " where qindex like '" & UCase(Trim(Text1.Text)) & "%'"
End If
Case "类型"
If Trim(Text1.Text) = "" Then
tmpsql = tmpsql & " where type=NULL"
Else
tmpsql = tmpsql & " where type like '" & Trim(Text1.Text) & "%'"
End If
Case "字数"
If Trim(Text1.Text) = "" Then
tmpsql = tmpsql & " where lengthes=NULL"
Else
tmpsql = tmpsql & " where lengthes=" & Trim(Text1.Text)
End If
Case "语种"
If Trim(Text1.Text) = "" Then
tmpsql = tmpsql & " where languager=NULL"
Else
tmpsql = tmpsql & " where language like '" & Trim(Text1.Text) & "%'"
End If
End Select
sql90005 = tmpsql
showdata tmpsql
End Sub
Private Sub ProgressBar1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
End Sub
Private Sub Command10_Click()
If Trim(Text3.Text) = "" Then Exit Sub
If Trim(Combo3.Text) = "" Then
MsgBox "没有选择源表!", vbOKOnly + vbCritical, "错误"
Exit Sub
End If
If Trim(Combo3.Text) = Trim(Text3.Text) Then
MsgBox "错误,源表和目的表选择了相同的表,无法完成合并!", vbOKOnly + vbCritical, "错误"
Exit Sub
End If
If fso.FileExists(Trim(Text3.Text) & ".dbf") = 0 Then
aaa = MsgBox("文件" & Trim(Text3.Text) & ".dbf" & "在当前文件中不存在,是否生成文件?", vbYesNo + vbQuestion, "询问")
If aaa = vbYes Then fso.CopyFile appath & "tab.dll", appath & Trim(Text3.Text) & ".dbf", True
End If
rt1.AddItem CStr(Now()) & "合并歌库"
Dim rss As New ADODB.Recordset
Dim rsd As New ADODB.Recordset
sqls = "select * from " & Trim(Combo3.Text)
sqld = "select * from " & Trim(Text3.Text)
rss.Open sqls, conn, 1, 1
If rss.EOF And rss.BOF Then
MsgBox "源表为空!", vbOKOnly + vbInformation, "提示"
rss.Close
rsd.Close
Set rss = Nothing
Set rsd = Nothing
Exit Sub
End If
LV1.Visible = False
Frame1.Visible = True
PBar1.Value = 0
PBar1.Max = rss.RecordCount
kk = 0
JJ = 0
Do Until rss.EOF
DoEvents
If PBar1.Value < PBar1.Max Then PBar1.Value = PBar1.Value + 1
Label2.Caption = PBar1.Value & "/" & PBar1.Max
Label1.Caption = CStr(Int(PBar1.Value / PBar1.Max * 100)) & "%"
sqld = "select * from " & Trim(Text3.Text) & " where id='" & Trim(rss("id")) & "'"
rsd.Open sqld, conn, 1, 3
If rsd.RecordCount > 0 Then
rt1.AddItem Trim(rss("id")) & "------" & "ID号重复，未合并到指定的表中！"
kk = kk + 1
Else
JJ = JJ + 1
rsd.AddNew
If Trim(rss("id")) <> "" Then rsd("id") = Trim(rss("id"))
If Trim(rss("singname")) <> "" Then rsd("singname") = Trim(rss("singname"))
If Trim(rss("singer")) <> "" Then rsd("singer") = Trim(rss("singer"))
If Trim(rss("language")) <> "" Then rsd("language") = Trim(rss("language"))
If Trim(rss("lengthes")) <> "" Then rsd("lengthes") = Trim(rss("lengthes"))
If Trim(rss("type")) <> "" Then rsd("type") = Trim(rss("type"))
If Trim(rss("diskname")) <> "" Then rsd("diskname") = Trim(rss("diskname"))
If Trim(rss("file_loca")) <> "" Then rsd("file_loca") = Trim(rss("file_loca"))
If Trim(rss("area")) <> "" Then rsd("area") = Trim(rss("area"))
If Trim(rss("mtvorvcd")) <> "" Then rsd("mtvorvcd") = Trim(rss("mtvorvcd"))
If Trim(rss("sex")) <> "" Then rsd("sex") = Trim(rss("sex"))
If Trim(rss("temp")) <> "" Then rsd("temp") = Trim(rss("temp"))
If Trim(rss("qindex")) <> "" Then rsd("qindex") = Trim(rss("qindex"))
rsd.Update
End If
rsd.Close
rss.MoveNext
Loop
rt1.AddItem Combo3.Text & "合并到" & Text3.Text & ",成功:" & JJ & "条,由于ID号重复,失败:" & kk & "条"
MsgBox Combo3.Text & "合并到" & Text3.Text & ",成功:" & JJ & "条,由于ID号重复,失败:" & kk & "条,详情请查看日志！", vboknoly + vbInformation, "提示"
LV1.Visible = True
Frame1.Visible = False
If rss.State <> 0 Then rss.Close
If rsd.State <> 0 Then rsd.Close
Set rss = Nothing
Set rsd = Nothing
End Sub
Private Sub Command11_Click()
Dim f As File
Dim fs As Files
Dim fl As Folder
Set fl = fso.GetFolder(appath)
Set fs = fl.Files
Combo3.Clear
For Each f In fs
If LCase(Right(f.Name, 3)) = "dbf" Then
Combo3.AddItem Left(f.Name, InStr(1, f.Name, ".") - 1)
End If
Next f
End Sub
Private Sub Command12_Click()
Dim f As File
Dim fs As Files
Dim fl As Folder
Set fl = fso.GetFolder(appath)
Set fs = fl.Files
Combo4.Clear
For Each f In fs
If LCase(Right(f.Name, 3)) = "dbf" Then
Combo4.AddItem Left(Trim(f.Name), Len(Trim(f.Name)) - 4)
End If
Next f
End Sub
Private Sub Command13_Click()
On Error Resume Next
rs.Open "select * from " & Trim(Combo4.Text), conn, 1, 1
If rs.EOF And rs.BOF Then
MsgBox "所选歌表是空的！", vbOKOnly + vbCritical, "错误"
rs.Close
Exit Sub
Else
rscount = rs.RecordCount
End If
rs.Close
isexits = 0
rt1.AddItem CStr(Now()) & "开始测试指定编号段!"
For j = CLng(Trim(Text4.Text)) To CLng(Trim(Text4.Text)) + rscount
DoEvents
If isex = 1 Then
isex = 0
rt1.AddItem "指定编号段测试被用户人为中断!"
Exit For
End If
Label10.Caption = j
rs.Open "select * from " & Trim(Combo4.Text) & " where id='" & Trim(Text4.Text) & "'", conn, 1, 1
If rs.EOF And rs.BOF Then
Else
rt1.AddItem CStr(Now()) & "歌曲编号检测：" & CStr(j) & "-----编号在歌表中已经存在！"
isexits = 1
End If
rs.Close
Next j
If isexits = 1 Then
rt1.AddItem "指定编号段有编号与现有歌表重复"
MsgBox "注意，经测试，编号与现有歌表中有重复！重编号将会失败，请选择另外的编号段进行重编号！详情请查看日志.", vbOKOnly + vbCritical, "注意"
isexits = 0
Else
rt1.AddItem "指定编号段测试成功,没有编号重复,可以进行重编号操作"
MsgBox "经测试，编号与现有歌表中没有重复！可以进行重编号操作！", vbOKOnly + vbInformation, "注意"
End If
End Sub
Private Sub Command14_Click()
If Trim(Text6.Text) = "" Or IsNull(Text6.Text) Or fso.FolderExists(Trim(Text6.Text)) = False Then
MsgBox "选择的文件夹错误或文件夹不存在!", vbCritical + vbOKOnly, "错误"
Exit Sub
End If
If Trim(Text4.Text) = "" Then
MsgBox "没有指定起始编号!", vbCritical + vbOKOnly, "错误"
Exit Sub
End If
If Trim(Combo4.Text) = "" Then
MsgBox "没有选择相应的单盘歌表!", vbCritical + vbOKOnly, "错误"
Exit Sub
End If
abbss = MsgBox("请确认你是否进行过指定号码段的校验,如果没有校验,将存在编号段重复的可能,因而造成歌曲点播出现问题!是否成功进行了编号段校验?", vbYesNo + vbQuestion, "确认")
If abbss = vbNo Then Exit Sub
If fso.FileExists(mmain.appath & "newnumber_" & Combo4.Text & ".dbf") = True Then
aabb = MsgBox(mmain.appath & "newnumber_" & Combo4.Text & ".dbf" & "已经存在,是否清空原有数据?", vbYesNo + vbQuestion, "询问")
If aabb = vbYes Then
fso.CopyFile mmain.appath & "tab.dll", mmain.appath & "newnumber_" & Combo4.Text & ".dbf", True
End If
Else
fso.CopyFile mmain.appath & "tab.dll", mmain.appath & "newnumber_" & Combo4.Text & ".dbf", True
End If
Form7.Text1.Text = Text4.Text
Form7.Text3.Text = Text6.Text
Form7.Frame1.Caption = "源表:" & Combo4.Text
Form7.Frame2.Caption = "重编号后的表:" & "newnumber_" & Combo4.Text
Form7.Show
End Sub
Private Sub Command15_Click()
On Error Resume Next
Dim readid As New ADODB.Recordset
sqlreadid = "select * from " & Combo2.Text & " where id between " & Text5.Text & "-" & CStr(CLng(Text5.Text) + File1.ListCount - 1)
readid.Open sqlreadid, conn, 1, 1
If readid.EOF And readid.BOF Then
Label13.ForeColor = RGB(0, 0, 255)
Label13.Caption = "预计最大编号:" & CStr(CLng(Text5.Text) - 1 + File1.ListCount)
Else
Label13.ForeColor = RGB(255, 0, 0)
Label13.Caption = "预计最大编号:" & CStr(CLng(Text5.Text) - 1 + File1.ListCount)
End If
readid.Close
Set readid = Nothing
End Sub
Private Sub Command16_Click()
If File1.ListCount < 1 Then Exit Sub
'On Error GoTo errhandle
On Error Resume Next
Dim tmpsingname As String
Dim tmpsinger As String
Dim tmplist As String
Dim rsnewsing As New ADODB.Recordset
sql = "select * from " & Trim(Combo2.Text)
rsnewsing.Open sql, conn, 1, 3
For i = 0 To File1.ListCount - 1
tmplist = File1.List(i)
If InStr(1, tmplist, "-") 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
If InStr(1, tmplist, "－") 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 = ""
tmpsinger = ""
End If
End If
j = 0
If tmpsinger <> "" And tmpsingname <> "" Then
DoEvents
rsnewsing.AddNew
rsnewsing("id") = CStr(CLng(Text5.Text) + i)
Set adlv = LV1.ListItems.Add(, , CStr(CLng(Text5.Text) + i))
rsnewsing("singname") = tmpsingname
adlv.SubItems(1) = tmpsingname
rsnewsing("singer") = tmpsinger
adlv.SubItems(2) = tmpsinger
rsnewsing("type") = typetxttotypeid(Ttype.Text)
adlv.SubItems(5) = typetxttotypeid(Ttype.Text)
rsnewsing("language") = Trim(Tlanguage.Text)
adlv.SubItems(3) = Trim(Tlanguage.Text)
rsnewsing("mtvorvcd") = CLng(Tmtvorvcd.Text)
adlv.SubItems(7) = 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 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
Select Case LCase(Right(File1.List(i), 3))
Case "mpg"
If Right(Dir1.Path, 1) = "\" Then
Name Dir1.Path & File1.List(i) As Dir1.Path & CStr(CLng(Text5.Text) + i) & ".mpg"
Else
Name Dir1.Path & "\" & File1.List(i) As Dir1.Path & "\" & CStr(CLng(Text5.Text) + i) & ".mpg"
End If
Case "dat"
If Right(Dir1.Path, 1) = "\" Then
Name Dir1.Path & File1.List(i) As Dir1.Path & CStr(CLng(Text5.Text) + i) & ".dat"
Else
Name Dir1.Path & "\" & File1.List(i) As Dir1.Path & "\" & CStr(CLng(Text5.Text) + i) & ".dat"
End If
Case "mp2"
If Right(Dir1.Path, 1) = "\" Then
Name Dir1.Path & File1.List(i) As Dir1.Path & CStr(CLng(Text5.Text) + i) & ".mp2"
Else
Name Dir1.Path & "\" & File1.List(i) As Dir1.Path & "\" & CStr(CLng(Text5.Text) + i) & ".mp2"
End If
Case "vob"
If Right(Dir1.Path, 1) = "\" Then
Name Dir1.Path & File1.List(i) As Dir1.Path & CStr(CLng(Text5.Text) + i) & ".vob"
Else
Name Dir1.Path & "\" & File1.List(i) As Dir1.Path & "\" & CStr(CLng(Text5.Text) + i) & ".vob"
End If
End Select
End If
Next
File1.Refresh
Text5.Text = CStr(CLng(Text5.Text) + i)
MsgBox Dir1.Path & "文件夹下的所有媒体文件添加歌库表并按指定ID重命名成功!", vbOKOnly + vbInformation, "提示"
Exit Sub
errhandle:
On Error Resume Next
Set rsnewsing = Nothing
MsgBox "数据连接出错", vbOKOnly + vbCritical, "错误"
End Sub
Private Sub Command17_Click()
rs.Open "select * from " & Trim(Combo2.Text), conn, 1, 3
If rs.EOF And rs.BOF Then
MsgBox Trim(Combo2.Text) & "表是空的!", vbOKOnly + vbInformation, "提示"
rs.Close
Exit Sub
End If
LV1.Visible = False
Frame1.Visible = True
PBar1.Value = 0
PBar1.Max = rs.RecordCount
Label1.Caption = "0%"
Label2.Caption = "0/" & PBar1.Max
Do Until rs.EOF
DoEvents
If PBar1.Value < PBar1.Max Then PBar1.Value = PBar1.Value + 1
Label1.Caption = CStr(Int(PBar1.Value / PBar1.Max * 100))
Label2.Caption = PBar1.Value & "/" & PBar1.Max
tmp_py = getpy(rs("singname"))
If Trim(tmp_py) <> "" Then rs("qindex") = Trim(tmp_py)
If Trim(tmp_py) <> "" Then rs("lengthes") = Len(Trim(tmp_py))
rs.Update
rs.MoveNext
Loop
Frame1.Visible = False
LV1.Visible = True
rs.Close
End Sub
Private Sub Command18_Click()
isex = 1
End Sub
Private Sub Command19_Click()
On Error Resume Next
If Command19.Caption = "查看日志" Then
Command19.Caption = "关闭日志"
rt1.Visible = True
Else
rt1.Visible = False
Command19.Caption = "查看日志"
End If
End Sub
Private Sub Command2_Click()
aaa = MsgBox("是否现在进行校验(视校验歌曲的多少和电脑配置,可能要花费比较长的时间)", vbYesNo + vbQuestion, "询问")
If aaa = vbNo Then Exit Sub
On Error GoTo errhandle
Frame2.Enabled = False
Frame3.Enabled = False
Frame4.Enabled = False
If sql90005 = "" Then
MsgBox "歌曲列表为空", vbOKOnly + vbCritical, "错误"
Frame2.Enabled = True
Frame3.Enabled = True
Frame4.Enabled = True
Exit Sub
End If
If fso.FileExists(appath & "90005OK.dbf") = 0 Then
fso.CopyFile appath & "tab.dll", appath & "90005ok.dbf", True
Else
isclean = MsgBox("是否清空90005OK表中的原有数据?点按'是'清空,点按'否'不清空.", vbYesNo + vbQuestion, "询问")
If isclean = vbYes Then
fso.CopyFile appath & "tab.dll", appath & "90005ok.dbf", True
End If
End If
rs.Open sql90005, conn, 1, 3
rs1.Open "select * from 90005ok", conn, 1, 3
If rs.EOF And rs.BOF Then
MsgBox "没有选择歌曲列表!", vbOKOnly + vbCritical, "提示"
rs.Close
Frame2.Enabled = True
Frame3.Enabled = True
Frame4.Enabled = True
Exit Sub
End If
LV1.Visible = False
Frame1.Visible = True
Label1.Caption = "0/100"
Label2.Caption = "0/" & rs.RecordCount
PBar1.Value = 0
PBar1.Max = rs.RecordCount
ak = 0
rt1.AddItem CStr(Now()) & Trim(Combo2.Text) & "表，开始校验操作！"
Do Until rs.EOF
DoEvents
If isex = 1 Then
isex = 0
rt1.AddItem CStr(Now()) & Trim(Combo2.Text) & "表校验被用户人为中断！"
Exit Do
End If
Form1.Label1.Caption = CStr(Int(Form1.PBar1.Value / Form1.PBar1.Max * 100)) & "/100"
Form1.Label2.Caption = CStr(Form1.PBar1.Value) & "/" & Form1.PBar1.Max
If PBar1.Value < PBar1.Max Then PBar1.Value = PBar1.Value + 1
For i = 67 To 90
tmph = Chr(i) & ":\"
If fso.FileExists(tmph & Trim(rs("ID")) & ".mpg") Then
ak = ak + 1
rs1.AddNew
If Trim(rs("ID")) <> "" Then rs1("ID") = rs("ID")
If Trim(rs("singname")) <> "" Then rs1("singname") = rs("singname")
If Trim(rs("singer")) <> "" Then rs1("singer") = rs("singer")
If Trim(rs("language")) <> "" Then rs1("language") = rs("language")
If Trim(rs("lengthes")) <> "" Then rs1("lengthes") = rs("lengthes")
If Trim(rs("type")) <> "" Then rs1("type") = rs("type")
If Trim(rs("diskname")) <> "" Then rs1("diskname") = rs("diskname")
If Trim(rs("file_loca")) <> "" Then rs1("file_loca") = rs("file_loca")
If Trim(rs("area")) <> "" Then rs1("area") = rs("area")
If Trim(rs("mtvorvcd")) <> "" Then rs1("mtvorvcd") = rs("mtvorvcd")
If Trim(rs("sex")) <> "" Then rs1("sex") = rs("sex")
If Trim(rs("temp")) <> "" Then rs1("temp") = rs("temp")
If Trim(rs("qindex")) <> "" Then rs1("qindex") = rs("qindex")
rs1("path") = tmph & Trim(rs("ID")) & ".mpg"
rs1.Update
Exit For
End If
If fso.FileExists(tmph & Trim(rs("ID")) & ".mp2") Then
ak = ak + 1
rs1.AddNew
If Trim(rs("ID")) <> "" Then rs1("ID") = rs("ID")
If Trim(rs("singname")) <> "" Then rs1("singname") = rs("singname")
If Trim(rs("singer")) <> "" Then rs1("singer") = rs("singer")
If Trim(rs("language")) <> "" Then rs1("language") = rs("language")
If Trim(rs("lengthes")) <> "" Then rs1("lengthes") = rs("lengthes")
If Trim(rs("type")) <> "" Then rs1("type") = rs("type")
If Trim(rs("diskname")) <> "" Then rs1("diskname") = rs("diskname")
If Trim(rs("file_loca")) <> "" Then rs1("file_loca") = rs("file_loca")
If Trim(rs("area")) <> "" Then rs1("area") = rs("area")
If Trim(rs("mtvorvcd")) <> "" Then rs1("mtvorvcd") = rs("mtvorvcd")
If Trim(rs("sex")) <> "" Then rs1("sex") = rs("sex")
If Trim(rs("temp")) <> "" Then rs1("temp") = rs("temp")
If Trim(rs("qindex")) <> "" Then rs1("qindex") = rs("qindex")
rs1("path") = tmph & Trim(rs("ID")) & ".mp2"
rs1.Update
Exit For
End If
If fso.FileExists(tmph & Trim(rs("ID")) & ".dat") Then
ak = ak + 1
rs1.AddNew
If Trim(rs("ID")) <> "" Then rs1("ID") = rs("ID")
If Trim(rs("singname")) <> "" Then rs1("singname") = rs("singname")
If Trim(rs("singer")) <> "" Then rs1("singer") = rs("singer")
If Trim(rs("language")) <> "" Then rs1("language") = rs("language")
If Trim(rs("lengthes")) <> "" Then rs1("lengthes") = rs("lengthes")
If Trim(rs("type")) <> "" Then rs1("type") = rs("type")
If Trim(rs("diskname")) <> "" Then rs1("diskname") = rs("diskname")
If Trim(rs("file_loca")) <> "" Then rs1("file_loca") = rs("file_loca")
If Trim(rs("area")) <> "" Then rs1("area") = rs("area")
If Trim(rs("mtvorvcd")) <> "" Then rs1("mtvorvcd") = rs("mtvorvcd")
If Trim(rs("sex")) <> "" Then rs1("sex") = rs("sex")
If Trim(rs("temp")) <> "" Then rs1("temp") = rs("temp")
If Trim(rs("qindex")) <> "" Then rs1("qindex") = rs("qindex")
rs1("path") = tmph & Trim(rs("ID")) & ".dat"
rs1.Update
Exit For
End If
If fso.FileExists(tmph & Trim(rs("ID")) & ".vob") Then
ak = ak + 1
rs1.AddNew
If Trim(rs("ID")) <> "" Then rs1("ID") = rs("ID")
If Trim(rs("singname")) <> "" Then rs1("singname") = rs("singname")
If Trim(rs("singer")) <> "" Then rs1("singer") = rs("singer")
If Trim(rs("language")) <> "" Then rs1("language") = rs("language")
If Trim(rs("lengthes")) <> "" Then rs1("lengthes") = rs("lengthes")
If Trim(rs("type")) <> "" Then rs1("type") = rs("type")
If Trim(rs("diskname")) <> "" Then rs1("diskname") = rs("diskname")
If Trim(rs("file_loca")) <> "" Then rs1("file_loca") = rs("file_loca")
If Trim(rs("area")) <> "" Then rs1("area") = rs("area")
If Trim(rs("mtvorvcd")) <> "" Then rs1("mtvorvcd") = rs("mtvorvcd")
If Trim(rs("sex")) <> "" Then rs1("sex") = rs("sex")
If Trim(rs("temp")) <> "" Then rs1("temp") = rs("temp")
If Trim(rs("qindex")) <> "" Then rs1("qindex") = rs("qindex")
rs1("path") = tmph & Trim(rs("ID")) & ".vob"
rs1.Update
Exit For
End If
Next i
rs.MoveNext
Loop
rt1.AddItem "共校验" & PBar1.Value & "首歌曲," & ak & "首歌曲通过校验，成功添中到9005OK表中。"
rt1.AddItem CStr(Now()) & "校验完成."
LV1.Visible = True
Frame1.Visible = False
rs.Close
rs1.Close
Frame2.Enabled = True
Frame3.Enabled = True
Frame4.Enabled = True
Exit Sub
errhandle:
MsgBox "数据库连接出错!", vbOKOnly + vbCritical, "提示"
Frame2.Enabled = True
Frame3.Enabled = True
Frame4.Enabled = True
If rs.State <> 0 Then rs.Close
If rs1.State <> 0 Then rs1.Close
End Sub
Private Sub Command20_Click()
rt1.Clear
End Sub
Private Sub Command21_Click()
Form6.Show
End Sub
Private Sub Command3_Click()
showdata "select * from " & Combo2.Text & " where diskname<>'' and diskname<>'0'"
End Sub
Private Sub Command4_Click()
On Error GoTo errhandle
s = MsgBox("此操作执行清空劲榜歌曲列表,此操作为是不可逆操作,是否确定?", vbQuestion + vbYesNo, "询问")
If s = vbNo Then Exit Sub
rs.Open "select * from " & Combo2.Text & " where diskname<>'' and diskname<>'0'", conn, 1, 3
rt1.AddItem CStr(Now()) & "歌表" & Trim(Combo2.Text) & "开始清空劲榜歌曲操作！"
If Not (rs.EOF And rs.BOF) Then
LV1.Visible = False
Frame1.Visible = True
PBar1.Value = 0
PBar1.Max = rs.RecordCount
Do Until rs.EOF
DoEvents
If isex = 1 Then
isex = 0
Exit Do
End If
If PBar1.Value < PBar1.Max Then PBar1.Value = PBar1.Value + 1
rs("diskname") = 0
rs.Update
rs.MoveNext
Loop
LV1.Visible = True
Frame1.Visible = False
End If
rt1.AddItem CStr(Now()) & "歌表" & Trim(Combo2.Text) & "共有" & PBar1.Value & "首劲榜歌曲，清空成功！"
rt1.AddItem CStr(Now()) & "歌表" & Trim(Combo2.Text) & "清空劲榜歌曲成功！"
rs.Close
Exit Sub
errhandle:
MsgBox "数据库的连接出错!", vbOKOnly + vbCritical, "错误"
If rs.State <> 0 Then rs.Close
End Sub
Private Sub Command5_Click()
showdata "select * from " & Combo2.Text & " where sex<>0"
End Sub
Private Sub Command6_Click()
s = MsgBox("此操作执行点击率清零,所有歌曲的点击率将初始化到0,此操作为是不可逆操作,是否确定?", vbQuestion + vbYesNo, "询问")
If s = vbNo Then Exit Sub
On Error GoTo errhandle
rs.Open "select * from " & Combo2.Text & " where temp<>0", conn, 1, 3
rt1.AddItem CStr(Now()) & "歌表" & Trim(Combo2.Text) & "开始点击率清零操作！"
If Not (rs.EOF And rs.BOF) Then
LV1.Visible = False
Frame1.Visible = True
PBar1.Value = 0
PBar1.Max = rs.RecordCount
Do Until rs.EOF
DoEvents
If isex = 1 Then
isex = 0
Exit Do
End If
If PBar1.Value < PBar1.Max Then PBar1.Value = PBar1.Value + 1
rs("temp") = 0
rs.Update
rs.MoveNext
Loop
LV1.Visible = True
Frame1.Visible = False
End If
rs.Close
rt1.AddItem "歌表" & Trim(Combo2.Text) & "共有" & PBar1.Value & "条记录点击率非零，清零成功！"
rt1.AddItem CStr(Now()) & "歌表" & Trim(Combo2.Text) & "点击率清零操作完成！"
Exit Sub
errhandle:
MsgBox "数据库连接出错!", vbOKOnly + vbCritical, "错误"
If rs.State <> 0 Then rs.Close
End Sub
Private Sub Command7_Click()
s = MsgBox("此操作执行音量标准化操作,所有搜索出来的歌曲将标准化到" & Text2.Text & ",此操作为是不可逆操作,是否确定?", vbQuestion + vbYesNo, "询问")
If s = vbNo Then Exit Sub
If Trim(sql90005) = "" Then
MsgBox "执行些操作前,请选搜索出要执行此操作的对象!", vbOKOnly + vbInformation, "出错了"
Exit Sub
End If
On Error GoTo errhandle
rs.Open sql90005, conn, 1, 3
rt1.AddItem CStr(Now()) & "歌表" & Trim(Combo2.Text) & "开始初始化音量操作！"
If Not (rs.EOF And rs.BOF) Then
LV1.Visible = False
Frame1.Visible = True
PBar1.Value = 0
PBar1.Max = rs.RecordCount
i = 0
Do Until rs.EOF
DoEvents
i = i + 1
If isex = 1 Then
isex = 0
Exit Do
End If
If PBar1.Value < PBar1.Max Then PBar1.Value = PBar1.Value + 1
rs("area") = Text2.Text
rs.Update
rs.MoveNext
Loop
LV1.Visible = True
Frame1.Visible = False
End If
rt1.AddItem "歌表" & Trim(Combo2.Text) & "共有" & i & "条记录音量初始化成功！"
rt1.AddItem CStr(Now()) & "歌表" & Trim(Combo2.Text) & "初始化音量操作完成！"
rs.Close
Exit Sub
errhandle:
MsgBox "数据库连接出错!", vbOKOnly + vbCritical, "错误"
If rs.State <> 0 Then rs.Close
End Sub
Private Sub Command8_Click()
Command8.Enabled = False
fso.CopyFile appath & "tab.dll", appath & "90005bad.dbf", True
Dim rsbad As New ADODB.Recordset
rs.Open "select * from " & Trim(Combo2.Text), conn, 1, 1
rs1.Open "select * from 90005OK", conn, 1, 1
rsbad.Open "select * from 90005bad", conn, 1, 3
If Not (rsbad.EOF And rs.BOF) Then
Do Until rsbad.EOF
rsbad.Delete
rsbad.Update
rsbad.MoveNext
Loop
End If
If rs.EOF And rs.BOF Then
MsgBox "源记录90005表为空", vbOKOnly + vbCritical, "提示"
rs.Close
rs1.Close
rsbad.Close
Command8.Enabled = True
Exit Sub
End If
If rs1.EOF And rs1.BOF Then
MsgBox "校验记录90005Ok表为空", vbOKOnly + vbCritical, "提示"
rs.Close
rs1.Close
rsbad.Close
Command8.Enabled = True
Exit Sub
End If
rs1.Close
LV1.Visible = False
Frame1.Visible = True
PBar1.Value = 0
PBar1.Max = rs.RecordCount
Do Until rs.EOF
DoEvents
If isex = 1 Then
isex = 0
Exit Do
End If
If PBar1.Value < PBar1.Max Then PBar1.Value = PBar1.Value + 1
Label2.Caption = CStr(PBar1.Value) & "/" & CStr(PBar1.Max)
Label1.Caption = ""
rs1.Open "select * from 90005OK where id='" & Trim(rs("id")) & "'", conn, 1, 1
If rs1.EOF And rs1.BOF Then
DoEvents
rsbad.AddNew
rsbad("id") = rs("id")
If Trim(rs("singname")) <> "" Then rsbad("singname") = rs("singname")
If Trim(rs("singer")) <> "" Then rsbad("singer") = rs("singer")
If Trim(rs("language")) <> "" Then rsbad("language") = rs("language")
If Trim(rs("lengthes")) <> "" Then rsbad("lengthes") = rs("lengthes")
If Trim(rs("type")) <> "" Then rsbad("type") = rs("type")
If Trim(rs("diskname")) <> "" Then rsbad("diskname") = rs("diskname")
If Trim(rs("file_loca")) <> "" Then rsbad("file_loca") = rs("file_loca")
If Trim(rs("area")) <> "" Then rsbad("area") = rs("area")
If Trim(rs("mtvorvcd")) <> "" Then rsbad("mtvorvcd") = rs("mtvorvcd")
If Trim(rs("sex")) <> "" Then rsbad("sex") = rs("sex")
If Trim(rs("temp")) <> "" Then rsbad("temp") = rs("temp")
If Trim(rs("qindex")) <> "" Then rsbad("qindex") = rs("qindex")
rsbad.Update
End If
rs1.Close
rs.MoveNext
Loop
Command8.Enabled = True
LV1.Visible = True
Frame1.Visible = False
rs.Close
If rs1.State <> 0 Then rs1.Close
If rsbad.State <> 0 Then rsbad.Close
End Sub
Private Sub Command9_Click()
aaa = MsgBox("是否确定生成" & Drive1.Drive & "单独列表?(歌表将以 90005+盘符.dbf 的文件形式保存于当前文件夹中)", vbYesNo + vbQuestion, "提示")
If aaa = vbNo Then Exit Sub
'On Error GoTo errhandle
tmpdiskfile = appath & "90005" & UCase(Left(Drive1.Drive, 1)) & ".dbf"
tmpdiskfilename = "90005" & UCase(Left(Drive1.Drive, 1))
If fso.FileExists(tmpdiskfile) Then
aaa = MsgBox(tmpdiskfile & "已经存在,是否重新生成此硬盘单盘列表?", vbYesNo + vbQuestion, "提示")
If aaa = vbNo Then Exit Sub
End If
fso.CopyFile appath & "tab.dll", tmpdiskfile, True
Combo2.AddItem tmpdiskfilename
If connf() <> 1 Then
MsgBox "未知错误", vbOKOnly + vbCritical, "提示"
Exit Sub
End If
Dim rsd As New ADODB.Recordset
sqlrsd = "select * from " & tmpdiskfilename
rsd.Open sqlrsd, conn, 1, 3
rs.Open "select * from " & Combo2.Text, conn, 1, 1
If rs.EOF And rs.BOF Then
MsgBox "总表为空!", vbOKOnly + vbInformation, "提示"
rs.Close
rsd.Close
Set rsd = Nothing
Exit Sub
End If
Frame5.Enabled = False
LV1.Visible = False
Frame1.Visible = True
PBar1.Value = 0
PBar1.Max = rs.RecordCount
Label1.Caption = ""
Label2.Caption = ""
rt1.AddItem CStr(Now()) & " 开始生成" & Drive1.Drive & "硬盘单盘歌表"
ak = 0
Do Until rs.EOF
DoEvents
If isex = 1 Then
isex = 0
rt1.AddItem "操作被用户人为中断!"
Exit Do
End If
If PBar1.Value < PBar1.Max Then PBar1.Value = PBar1.Value + 1
Label2.Caption = PBar1.Value & "/" & PBar1.Max
Label1.Caption = CStr(Int(PBar1.Value / PBar1.Max * 100)) & "%"
If fso.FileExists(Left(Drive1.Drive, 1) & ":\" & Trim(rs("id")) & ".mpg") Or fso.FileExists(Left(Drive1.Drive, 1) & ":\" & Trim(rs("id")) & ".mp2") Or fso.FileExists(Left(Drive1.Drive, 1) & ":\" & Trim(rs("id")) & ".dat") Or fso.FileExists(Left(Drive1.Drive, 1) & ":\" & Trim(rs("id")) & ".vob") Then
ak = ak + 1
rsd.AddNew
If Trim(rs("id")) <> "" Then rsd("id") = rs("id")
If Trim(rs("singname")) <> "" Then rsd("singname") = rs("singname")
If Trim(rs("singer")) <> "" Then rsd("singer") = rs("singer")
If Trim(rs("language")) <> "" Then rsd("language") = rs("language")
If Trim(rs("lengthes")) <> "" Then rsd("lengthes") = rs("lengthes")
If Trim(rs("type")) <> "" Then rsd("type") = rs("type")
If Trim(rs("diskname")) <> "" Then rsd("diskname") = rs("diskname")
If Trim(rs("file_loca")) <> "" Then rsd("file_loca") = rs("file_loca")
If Trim(rs("area")) <> "" Then rsd("area") = rs("area")
If Trim(rs("mtvorvcd")) <> "" Then rsd("mtvorvcd") = rs("mtvorvcd")
If Trim(rs("sex")) <> "" Then rsd("sex") = rs("sex")
If Trim(rs("temp")) <> "" Then rsd("temp") = rs("temp")
If Trim(rs("qindex")) <> "" Then rsd("qindex") = rs("qindex")
rsd.Update
End If
rs.MoveNext
Loop
rt1.AddItem Drive1.Drive & "盘单盘歌表生成成功,该盘共有" & ak & "首歌曲,保存在" & tmpdiskfilename & "中."
rs.Close
rsd.Close
Set rsd = Nothing
Frame5.Enabled = True
LV1.Visible = True
Frame1.Visible = False
Exit Sub
errhandle:
MsgBox "生成过程中发生错误", vbOKOnly + vbCritical, "错误"
Frame5.Enabled = True
LV1.Visible = True
Frame1.Visible = False
If rs.State <> 0 Then rs.Close
If rsd.State <> 0 Then rsd.Close
Exit Sub
End Sub
Private Sub DESCsort_Click()
LV1.SortOrder = lvwDescending
If LV1.SortOrder = lvwAscending Then
ASCsort.Checked = True
DESCsort.Checked = False
Else
ASCsort.Checked = False
DESCsort.Checked = True
End If
End Sub
Private Sub Dir1_Change()
On Error GoTo errhandle
File1.Path = Dir1.Path
Exit Sub
errhandle:
MsgBox "拒绝访问!", vbOKOnly + vbCritical, "错误"
End Sub
Private Sub Drive2_Change()
On Error GoTo errhandle
Dir1.Path = Drive2.Drive
Exit Sub
errhandle:
MsgBox "驱动器未准备好!", vbOKOnly + vbCritical, "错误"
Exit Sub
End Sub
Private Sub editsong_Click()
If LV1.ListItems.Count = 0 Then
Else
Form2.TID = Trim(LV1.SelectedItem.Text)
Form2.Tname = Trim(LV1.SelectedItem.SubItems(1))
Form2.Tsinger = Trim(LV1.SelectedItem.SubItems(2))
Form2.Tlanguage = Trim(Trim(LV1.SelectedItem.SubItems(3)))
Form2.Tlengthes = Trim(LV1.SelectedItem.SubItems(4))
Form2.Ttype = Trim(typeidtotypetxt(LV1.SelectedItem.SubItems(5)))
Form2.Tarea = Trim(LV1.SelectedItem.SubItems(6))
Form2.Tmtvorvcd = Trim(LV1.SelectedItem.SubItems(7))
Form2.Tqindex = Trim(LV1.SelectedItem.SubItems(8))
If Trim(LV1.SelectedItem.SubItems(9)) = "0" Or Trim(LV1.SelectedItem.SubItems(9)) = "" Then
Form2.tdiskname.Value = 0
Else
Form2.tdiskname.Value = 1
End If
If Trim(LV1.SelectedItem.SubItems(10)) = "0" Or Trim(LV1.SelectedItem.SubItems(10)) = "" Then
Form2.Tsex.Value = 0
Else
Form2.Tsex.Value = 1
End If
Form2.Ttemp.Text = Trim(LV1.SelectedItem.SubItems(11))
For i = 67 To 90
tmpbb = Chr(i) & ":\"
tmpbb1 = tmpbb & Trim(LV1.SelectedItem.Text) & ".mpg"
tmpbb2 = tmpbb & Trim(LV1.SelectedItem.Text) & ".dat"
tmpbb3 = tmpbb & Trim(LV1.SelectedItem.Text) & ".mp2"
tmpbb4 = tmpbb & Trim(LV1.SelectedItem.Text) & ".vob"
If fso.FileExists(tmpbb1) Then
Form2.Label11 = tmpbb1
Exit For
End If
If fso.FileExists(tmpbb2) Then
Form2.Label11 = tmpbb2
Exit For
End If
If fso.FileExists(tmpbb3) Then
Form2.Label11 = tmpbb3
Exit For
End If
If fso.FileExists(tmpbb4) Then
Form2.Label11 = tmpbb4
Exit For
End If
Form2.Label11 = "找不到媒体文件"
Next i
Form2.Show
End If
End Sub
Private Sub Fdel_Click()
If LV1.ListItems.Count = 0 Then
MsgBox "没有可供操作的对象!", vbOKOnly + vbCritical, "提示"
Exit Sub
End If
isdel = MsgBox("确定删除ID为" & LV1.SelectedItem.Text & "的记录?", vbYesNo + vbQuestion, "询问")
If isdel = vbNo Then
Exit Sub
End If
rs.Open "select * from " & Combo2.Text & " where id='" & LV1.SelectedItem.Text & "'", conn, 1, 3
If rs.EOF And rs.BOF Then
MsgBox "该记录不存在,也许已经被删除!", vbOKOnly + vbCritical, "提示"
rs.Close
Exit Sub
End If
rs.Delete
rs.Update
LV1.ListItems.Remove LV1.SelectedItem.Index
rs.Close
End Sub
Private Sub FdelandF_Click()
If LV1.ListItems.Count = 0 Then
MsgBox "没有可供操作的对象!", vbOKOnly + vbCritical, "提示"
Exit Sub
End If
rs.Open "select * from " & Combo2.Text & " where id='" & LV1.SelectedItem.Text & "'", conn, 1, 3
If rs.EOF And rs.BOF Then
MsgBox "该记录不存在,也许已经被删除!", vbOKOnly + vbCritical, "提示"
rs.Close
Exit Sub
End If
isdel = MsgBox("确定删除ID为" & LV1.SelectedItem.Text & "的记录及对应的" & rs("path") & "文件?", vbYesNo + vbQuestion, "询问")
If isdel = vbNo Then
rs.Close
Exit Sub
End If
On Error GoTo errhandle
fso.DeleteFile rs("path"), True
rs.Delete
rs.Update
LV1.ListItems.Remove LV1.SelectedItem.Index
rs.Close
MsgBox "记录和文件删除成功!", vbOKOnly + vbInformation, "提示"
Exit Sub
errhandle:
MsgBox "记录或文件删除出错,可能文件被占用", vbOKOnly + vbCritical, "错误"
If rs.State <> 0 Then rs.Close
End Sub
Private Sub File1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
If File1.ListIndex < 0 Then Exit Sub
If File1.ListCount < 1 Then Exit Sub
Me.PopupMenu pop2
End If
End Sub
Private Sub Form_Load()
File1.Pattern = "*.mpg"
If LV1.SortOrder = lvwAscending Then
ASCsort.Checked = True
DESCsort.Checked = False
Else
ASCsort.Checked = False
DESCsort.Checked = True
End If
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Unload Form2
Unload Form3
Unload Form4
If conn.State <> 0 Then conn.Close
If rs.State <> 0 Then rs.Close
If conn1.State <> 0 Then conn1.Close
If rs1.State <> 0 Then rs1.Close
Set conn = Nothing
Set rs = Nothing
Set conn1 = Nothing
Set rs1 = Nothing
Unload Form6
Unload Me
End
End Sub
Private Sub lsong_Click()
On Error Resume Next
DoEvents
Form3.MPlayer.FileName = IIf(Right(Dir1.Path, 1) = "\", Dir1.Path, Dir1.Path & "\") & File1.List(File1.ListIndex)
Form3.Caption = IIf(Right(Dir1.Path, 1) = "\", Dir1.Path, Dir1.Path & "\") & File1.List(File1.ListIndex)
Form3.Show
Form3.MPlayer.Play
End Sub
Private Sub LV1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
LV1.Sorted = False
LV1.SortKey = ColumnHeader.Index - 1
LV1.Sorted = True
End Sub
Private Sub LV1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
If LV1.ListItems.Count < 1 Then
Fdel.Enabled = False
FdelandF.Enabled = False
editsong.Enabled = False
searchfile.Enabled = False
tabsaveas.Enabled = False
Else
Select Case LCase(Trim(Combo2.Text))
Case "90005"
Fdel.Enabled = True
FdelandF.Enabled = False
editsong.Enabled = True
searchfile.Enabled = True
tabsaveas.Enabled = True
Case "90005ok"
Fdel.Enabled = False
FdelandF.Enabled = True
editsong.Enabled = True
searchfile.Enabled = True
tabsaveas.Enabled = True
Case "90005bad"
Fdel.Enabled = True
FdelandF.Enabled = False
editsong.Enabled = True
searchfile.Enabled = True
tabsaveas.Enabled = True
Case Else
Fdel.Enabled = True
FdelandF.Enabled = False
editsong.Enabled = True
searchfile.Enabled = True
tabsaveas.Enabled = True
End Select
End If
Me.PopupMenu pop1
End If
End Sub
Private Sub LV1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
aaa = MsgBox("文件名是否符合规则？(点击是,将按指定文件名规则自动添加,点击否,手动添加.)", vbYesNo + vbQuestion, "询问")
If aaa = vbYes Then
mmain.addsong File1.ListIndex, True
Else
mmain.addsong File1.ListIndex, False
End If
End Sub
Private Sub Option1_Click()
File1.Pattern = "*.mpg"
End Sub
Private Sub Option2_Click()
File1.Pattern = "*.mp2"
End Sub
Private Sub Option3_Click()
File1.Pattern = "*.dat"
End Sub
Private Sub Option4_Click()
File1.Pattern = "*.vob"
End Sub
Private Sub searchfile_Click()
If LV1.ListItems.Count < 1 Then
MsgBox "没有可操作的数据对象!", vbOKOnly + vbCritical, "错误"
Exit Sub
End If
On Error Resume Next
For i = 67 To 90
tmpbb = Chr(i) & ":\"
tmpbb1 = tmpbb & Trim(LV1.SelectedItem.Text) & ".mpg"
tmpbb2 = tmpbb & Trim(LV1.SelectedItem.Text) & ".dat"
tmpbb3 = tmpbb & Trim(LV1.SelectedItem.Text) & ".mp2"
tmpbb4 = tmpbb & Trim(LV1.SelectedItem.Text) & ".vob"
If fso.FileExists(tmpbb1) Then
'MsgBox "找到文件:" & tmpbb1, vbOKOnly + vbInformation, "提示"
Form3.Caption = tmpbb1
Form3.MPlayer.FileName = tmpbb1
Form3.Show
Form3.MPlayer.Play
Exit Sub
End If
If fso.FileExists(tmpbb2) Then
'MsgBox "找到文件:" & tmpbb2, vbOKOnly + vbInformation, "提示"
Form3.Caption = tmpbb2
Form3.MPlayer.FileName = tmpbb2
Form3.Show
Form3.MPlayer.Play
Exit Sub
End If
If fso.FileExists(tmpbb3) Then
'MsgBox "找到文件:" & tmpbb3, vbOKOnly + vbInformation, "提示"
Form3.Caption = tmpbb3
Form3.MPlayer.FileName = tmpbb3
Form3.Show
Form3.MPlayer.Play
Exit Sub
End If
If fso.FileExists(tmpbb4) Then
'MsgBox "找到文件:" & tmpbb4, vbOKOnly + vbInformation, "提示"
Form3.Caption = tmpbb4
Form3.MPlayer.FileName = tmpbb4
Form3.Show
Form3.MPlayer.Play
Exit Sub
End If
Next i
MsgBox "找不到相应的媒体文件!", vbOKOnly + vbCritical, "提示"
End Sub
Private Sub tabsaveas_Click()
inputname:
saveasfname = InputBox("请输入文件名,文件格式为.DBF,文件将保存到程序所在文件夹下!(文件名只能是字母及数字组合,不能带其他符号!)", "输入文件名")
If saveasfname = vbCancel Then Exit Sub
If Trim(saveasfname) = "" Then
aaa = MsgBox("输入文件名错误,是否重新输入?", vbYesNoCancel + vbCritical, "错误")
If aaa = vbYes Then
GoTo inputname
Else
Exit Sub
End If
End If
On Error GoTo errhandle
sfn = saveasfname
If InStr(1, Trim(saveasfname), ".") Then
saveasfname = Left(Trim(saveasfname), InStr(1, Trim(saveasfname), ".") - 1)
End If
saveasfname = appath & Trim(saveasfname) & ".dbf"
If fso.FileExists(saveasfname) Then
bbb = MsgBox(saveasfname & "文件已经存在,是否覆盖原有文件?", vbYesNo + vbQuestion, "询问")
If bbb = vbNo Then GoTo inputname
End If
fso.CopyFile appath & "tab.dll", saveasfname, True
savetab sfn
Exit Sub
errhandle:
End Sub
Private Sub savetab(fpath As String)
If LV1.ListItems.Count < 1 Then Exit Sub
sqlsavetab = "select * from " & fpath & " where id is null"
rs.Open sqlsavetab, conn, 1, 3
LV1.Visible = False
Frame1.Visible = True
PBar1.Value = 0
PBar1.Max = LV1.ListItems.Count
kkk = 0
For kkk = 1 To LV1.ListItems.Count Step 1
DoEvents
If PBar1.Value < PBar1.Max Then PBar1.Value = PBar1.Value + 1
Label1.Caption = CStr(Int(PBar1.Value / PBar1.Max * 100)) & "%"
Label2.Caption = CStr(PBar1.Value) & "/" & CStr(PBar1.Max)
rs.AddNew
rs("id") = Trim(LV1.ListItems(kkk).Text)
If Trim(LV1.ListItems(kkk).SubItems(1)) <> "" Then rs("singname") = Trim(LV1.ListItems(kkk).SubItems(1))
If Trim(LV1.ListItems(kkk).SubItems(2)) <> "" Then rs("singer") = Trim(LV1.ListItems(kkk).SubItems(2))
If Trim(LV1.ListItems(kkk).SubItems(3)) <> "" Then rs("language") = Trim(LV1.ListItems(kkk).SubItems(3))
If Trim(LV1.ListItems(kkk).SubItems(4)) <> "" Then rs("lengthes") = CLng(Trim(LV1.ListItems(kkk).SubItems(4)))
If Trim(LV1.ListItems(kkk).SubItems(5)) <> "" Then rs("type") = Trim(LV1.ListItems(kkk).SubItems(5))
If Trim(LV1.ListItems(kkk).SubItems(9)) <> "" Then rs("diskname") = Trim(LV1.ListItems(kkk).SubItems(9))
rs("file_loca") = "HAVE"
If Trim(LV1.ListItems(kkk).SubItems(6)) <> "" Then rs("area") = Trim(LV1.ListItems(kkk).SubItems(6))
If Trim(LV1.ListItems(kkk).SubItems(7)) <> "" Then rs("mtvorvcd") = CLng(Trim(LV1.ListItems(kkk).SubItems(7)))
If Trim(LV1.ListItems(kkk).SubItems(10)) <> "" Then rs("sex") = CLng(Trim(LV1.ListItems(kkk).SubItems(10)))
If Trim(LV1.ListItems(kkk).SubItems(11)) <> "" Then rs("temp") = CLng(Trim(LV1.ListItems(kkk).SubItems(11)))
If Trim(LV1.ListItems(kkk).SubItems(8)) <> "" Then rs("qindex") = Trim(LV1.ListItems(kkk).SubItems(8))
rs.Update
Next kkk
MsgBox fpath & ".dbf" & "文件保存成功!", vbOKOnly + vbInformation, "提示"
Frame1.Visible = False
LV1.Visible = True
rs.Close
End Sub