songmanger.frm

KTV管理系统,实现了基本的日常操作.程序有不完善之处,请自修升级修改.

      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "歌手"
         Height          =   180
         Index           =   3
         Left            =   6840
         TabIndex        =   15
         Top             =   2295
         Width           =   360
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "出片年度"
         Height          =   180
         Index           =   4
         Left            =   6480
         TabIndex        =   14
         Top             =   4590
         Width           =   720
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "播放格式"
         Height          =   180
         Index           =   5
         Left            =   6480
         TabIndex        =   13
         Top             =   3435
         Width           =   720
      End
      Begin VB.Label Label4 
         BackColor       =   &H000040C0&
         ForeColor       =   &H00FFFFFF&
         Height          =   255
         Left            =   7560
         TabIndex        =   12
         Top             =   1080
         Width           =   1695
      End
      Begin VB.Label Label5 
         BackStyle       =   0  'Transparent
         Caption         =   "曲目编号"
         Height          =   255
         Left            =   6480
         TabIndex        =   11
         Top             =   1080
         Width           =   1215
      End
      Begin VB.Label Label8 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "产地"
         Height          =   180
         Left            =   6840
         TabIndex        =   10
         Top             =   4020
         Width           =   360
      End
   End
   Begin MSAdodcLib.Adodc Adodc1 
      Height          =   495
      Left            =   3720
      Top             =   0
      Visible         =   0   'False
      Width           =   1695
      _ExtentX        =   2990
      _ExtentY        =   873
      ConnectMode     =   0
      CursorLocation  =   3
      IsolationLevel  =   -1
      ConnectionTimeout=   15
      CommandTimeout  =   30
      CursorType      =   3
      LockType        =   3
      CommandType     =   8
      CursorOptions   =   0
      CacheSize       =   50
      MaxRecords      =   0
      BOFAction       =   0
      EOFAction       =   0
      ConnectStringType=   1
      Appearance      =   1
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      Orientation     =   0
      Enabled         =   -1
      Connect         =   ""
      OLEDBString     =   ""
      OLEDBFile       =   ""
      DataSourceName  =   ""
      OtherAttributes =   ""
      UserName        =   ""
      Password        =   ""
      RecordSource    =   ""
      Caption         =   "Adodc1"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      _Version        =   393216
   End
   Begin MCI.MMControl MMControl1 
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   0
      Visible         =   0   'False
      Width           =   3540
      _ExtentX        =   6244
      _ExtentY        =   873
      _Version        =   393216
      DeviceType      =   ""
      FileName        =   ""
   End
   Begin VB.Menu popmenu 
      Caption         =   "导入"
      Visible         =   0   'False
      Begin VB.Menu singlefile 
         Caption         =   "单个文件"
      End
      Begin VB.Menu folder 
         Caption         =   "目录"
      End
   End
End
Attribute VB_Name = "songManger"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim filename As String
Dim menuFlag As String
Dim fileB As String
Dim fileE As String
Private Sub Adodc1_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
On Error Resume Next
If Not Adodc1.Recordset.BOF Or Not Adodc1.Recordset.EOF Then
Label4.Caption = Adodc1.Recordset.Fields("编号")
Text1(0).Text = Adodc1.Recordset.Fields("歌名")
Combo1(0).Text = Adodc1.Recordset.Fields("歌手")
Combo1(1).Text = Adodc1.Recordset.Fields("性别")
Combo1(2).Text = Adodc1.Recordset.Fields("格式")
Combo1(3).Text = Adodc1.Recordset.Fields("产地")
Text1(1).Text = Adodc1.Recordset.Fields("日期")
Combo1(4).Text = Adodc1.Recordset.Fields("类型")
filename = Adodc1.Recordset.Fields("位置")
End If
End Sub

Private Sub Command1_Click()
MsgBox "请与我们取得联系以获得我们的最新正版产品!", vbOKOnly, "提示"
End Sub

Private Sub Command2_Click()
PopupMenu popmenu

End Sub

Private Sub command4_Click(Index As Integer)
Dim bianhao As Integer
On Error Resume Next
Select Case Index
    Case Is = 0
    If Command4(2).Caption = "放弃" Then
    Adodc1.Recordset.Fields("编号") = Label4.Caption
    nn = CInt(nn) + 1
    reg = WriteToFile("set", "num", CStr(nn))
    Else
    End If
    
     filename1 = songPath & "\" & fileE & "\" & fileB & "." & fileE
     nn = ReadFromFile("set", "num")
    If Dir(songPath & "\" & fileE) = "" Then MkDir songPath & "\" & fileE
    Name filename As filename1
    
    Adodc1.Recordset.Fields("字数") = Len(Text1(0).Text)
    Adodc1.Recordset.Fields("字母") = mHZtoSM.HZtoSMEx(Text1(0).Text)
    Adodc1.Recordset.Fields("歌名") = Text1(0).Text
    Adodc1.Recordset.Fields("歌手") = Combo1(0).Text
    Adodc1.Recordset.Fields("性别") = Combo1(1).Text
    Adodc1.Recordset.Fields("格式") = Combo1(2).Text
    Adodc1.Recordset.Fields("产地") = Combo1(3).Text
    Adodc1.Recordset.Fields("日期") = Text1(1).Text
    Adodc1.Recordset.Fields("类型") = Combo1(4).Text
    Adodc1.Recordset.Fields("位置") = filename1
    Adodc1.Recordset.Update
    
    Command4(2).Caption = "增加"
    Command4(4).Caption = "修改"
    Command4(0).Enabled = False
    Case Is = 1
    Case Is = 2
    If Command4(2).Caption = "增加" Then
    nn = ReadFromFile("set", "num")

    Label4.Caption = Format(Val(nn) + 1, "000000")
    Command2.Enabled = True
    Text1(0).Text = ""
    Combo1(0).Text = ""
    Combo1(1).Text = ""
    Combo1(2).Text = ""
    Combo1(3).Text = ""
    Text1(1).Text = ""
    Combo1(4).Text = ""
    Adodc1.Recordset.AddNew
    Command4(0).Enabled = True
    Command4(2).Caption = "放弃"
    ElseIf Command4(2).Caption = "放弃" Then
    Adodc1.Recordset.CancelBatch adAffectCurrent
    Adodc1.Recordset.MoveLast
    Command4(2).Caption = "增加"
    Command4(0).Enabled = False
    Label4.Caption = ""
    End If
    Case Is = 3
    Adodc1.Recordset.Delete
    Adodc1.Recordset.Update
    Case Is = 4
    If Command4(4).Caption = "修改" Then
    'filename = Adodc1.Recordset.Fields("位置")
    Command4(0).Enabled = True
    Command4(4).Caption = "放弃"
   
    ElseIf Command4(4).Caption = "放弃" Then
    Command4(0).Enabled = False
    Command4(4).Caption = "修改"
    End If
End Select

End Sub

Private Sub Command3_Click(Index As Integer)
If Adodc1.Recordset.RecordCount > 0 Then
Select Case Index
    Case Is = 0
    Adodc1.Recordset.MoveFirst
    Case Is = 1
    If Not Adodc1.Recordset.BOF Then
    Adodc1.Recordset.MovePrevious
    Else
    Adodc1.Recordset.MoveFirst
    End If
    Case Is = 2
    If Not Adodc1.Recordset.EOF Then
    Adodc1.Recordset.MoveNext
    Else
    Adodc1.Recordset.MoveLast
    End If
    Case Is = 3
    Adodc1.Recordset.MoveLast
End Select
Else
MsgBox "没有任何歌曲!请先录入.", vbOKOnly, "提示"
End If
End Sub

Private Sub Command5_Click()
    MMControl1.Command = "close"
    MMControl1.DeviceType = "mpegvideo"
    MMControl1.hWndDisplay = display.hWnd
    MMControl1.filename = filename
    MMControl1.Command = "open"
    MMControl1.Command = "play"
    display.Show
End Sub

Private Sub Command6_Click()
End
End Sub

Private Sub Command7_Click()
FrmSys.Show
End Sub

Private Sub folder_Click()
menuFlag = "folder"
Tfolder.Show 1
End Sub

Private Sub Form_Load()
Dim sql As String
On Error Resume Next
Set mHZtoSM = New cHztoSM
mHZtoSM.LoadLibFile App.Path & "\GB2312SM.Lib"
If mHZtoSM.LoadLibSuccess = False Then Unload Me

conn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\data\song.mdb;Persist Security Info=False"
With Adodc1
    .ConnectionString = conn
    .CommandTimeout = 30
    .CommandType = adCmdText
    .CursorLocation = adUseClient
    .RecordSource = "select 编号,歌名,歌手,性别,格式,大小,产地,日期,类型,位置 from songlist"
    .Refresh
End With
With Adodc2
    .ConnectionString = conn
    .CommandTimeout = 30
    .CommandType = adCmdText
    .CursorLocation = adUseClient
    .RecordSource = "select * from songtype"
    .Refresh
End With
sql = " select distinct 歌手 from songlist "
Adodc2.RecordSource = sql
Adodc2.Refresh
For I = 1 To Adodc2.Recordset.RecordCount
    If Not Adodc2.Recordset.EOF Then
    Combo1(0).AddItem Adodc2.Recordset.Fields("歌手")
    Adodc2.Recordset.MoveNext
    End If
Next
sql = " select distinct 格式 from songlist "
Adodc2.RecordSource = sql
Adodc2.Refresh
For I = 1 To Adodc2.Recordset.RecordCount
    If Not Adodc2.Recordset.EOF Then
    Combo1(2).AddItem Adodc2.Recordset.Fields("格式")
    Adodc2.Recordset.MoveNext
    End If
Next
sql = " select distinct 产地 from songlist "
Adodc2.RecordSource = sql
Adodc2.Refresh
For I = 1 To Adodc2.Recordset.RecordCount
    If Not Adodc2.Recordset.EOF Then
    Combo1(3).AddItem Adodc2.Recordset.Fields("产地")
    Adodc2.Recordset.MoveNext
    End If
Next
sql = " select distinct 类型 from songlist "
Adodc2.RecordSource = sql
Adodc2.Refresh
For I = 1 To Adodc2.Recordset.RecordCount
    If Not Adodc2.Recordset.EOF Then
    Combo1(4).AddItem Adodc2.Recordset.Fields("类型")
    Adodc2.Recordset.MoveNext
    End If
Next
Combo1(1).AddItem "男"
Combo1(1).AddItem "女"

If Adodc1.Recordset.RecordCount > 0 Then
Label4.Caption = Adodc1.Recordset.Fields("编号")
Text1(0).Text = Adodc1.Recordset.Fields("歌名")
Combo1(0).Text = Adodc1.Recordset.Fields("歌手")
Combo1(1).Text = Adodc1.Recordset.Fields("性别")
Combo1(2).Text = Adodc1.Recordset.Fields("格式")
Combo1(3).Text = Adodc1.Recordset.Fields("产地")
Text1(1).Text = Adodc1.Recordset.Fields("日期")
Combo1(4).Text = Adodc1.Recordset.Fields("类型")
Else
End If
'初始化
Command4(0).Enabled = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Set mHZtoSM = Nothing
End Sub

Private Sub singlefile_Click()
menuFlag = "singer"


fileB = ""
fileE = ""

With CommonDialog1
    .Filter = "多媒体文件|*.dat;*.mpeg;*.rm;*.rmvb;*.mp3"
    .ShowOpen
End With
filename = CommonDialog1.filename
For I = 1 To Len(filename)
    If Mid$(filename, I, 1) = "." Then
    fileB = Left$(filename, I - 1)
    fileE = Mid$(filename, I + 1, Len(filename) - I)
    End If
Next
For I = Len(fileB) To 1 Step -1
    If Mid$(fileB, I, 1) = "\" Then
    fileB = Mid$(fileB, I + 1, Len(fileB))
    Else
    End If
Next
Text1(0).Text = fileB
Combo1(2).Text = fileE
End Sub