www.pudn.com > SkyMediaSongTool.rar > database.bas

Attribute VB_Name = "database" 
Public fso As New FileSystemObject 
Public conn As New ADODB.Connection 
Public rs As New ADODB.Recordset 
Public conn1 As New ADODB.Connection 
Public rs1 As New ADODB.Recordset 
Public sql90005 As String, sql90005ok As String 
Public Function connf() As Integer 
    On Error GoTo errhandle 
    If conn.State <> 0 Then conn.Close 
    conn.Open "Provider=MSDASQL.1;Persist Security Info=False;Data Source=dBASE Files;Initial Catalog=" & appath 
    connf = 1 
    Exit Function 
errhandle: 
    connf = 0 
End Function 
Public Sub showdata(sqlstr As String) 
On Error GoTo errhandle 
    'Form1.Enabled = False 
    Form1.Frame2.Enabled = False 
    Form1.Frame3.Enabled = False 
    Form1.Frame4.Enabled = False 
    Form1.Command1.Enabled = False 
    Form1.Frame1.Visible = True 
    Form1.LV1.Visible = False 
    Form1.LV1.ListItems.Clear 
    Form1.PBar1.Value = 0 
     
    rs.Open sqlstr, conn, 1, 3 
    If rs.EOF And rs.BOF Then 
        rs.Close 
        Form1.Enabled = True 
        Form1.Frame2.Enabled = True 
        Form1.Frame3.Enabled = True 
        Form1.Frame4.Enabled = True 
        Form1.Command1.Enabled = True 
        Form1.LV1.Visible = True 
        Form1.Frame1.Visible = False 
        Exit Sub 
    End If 
    Form1.Label1.Caption = "0/100" 
    Form1.Label2.Caption = "0/" & rs.RecordCount 
    Form1.PBar1.Max = rs.RecordCount 
    Do Until rs.EOF 
        DoEvents 
        If isex = 1 Then 
            isex = 0 
            Exit Do 
        End If 
        Set aditem = Form1.LV1.ListItems.Add(, , rs("id")) 
        If Trim(rs("singname")) <> "" Then aditem.SubItems(1) = CStr(rs("singname")) 
        If Trim(rs("singer")) <> "" Then aditem.SubItems(2) = CStr(rs("singer")) 
        If Trim(rs("language")) <> "" Then aditem.SubItems(3) = CStr(rs("language")) 
        If Trim(rs("lengthes")) <> "" Then aditem.SubItems(4) = CStr(rs("lengthes")) 
        If Trim(rs("type")) <> "" Then aditem.SubItems(5) = CStr(rs("type")) 
        If Trim(rs("area")) <> "" Then aditem.SubItems(6) = CStr(rs("area")) 
        If Trim(rs("mtvorvcd")) <> "" Then aditem.SubItems(7) = CStr(rs("mtvorvcd")) 
        If Trim(rs("qindex")) <> "" Then aditem.SubItems(8) = CStr(rs("qindex")) 
        If Trim(rs("diskname")) <> "" Then aditem.SubItems(9) = CStr(rs("diskname")) 
        If Trim(rs("sex")) <> "" Then aditem.SubItems(10) = CStr(rs("sex")) 
        If Trim(rs("temp")) <> "" Then aditem.SubItems(11) = CStr(rs("temp")) 
         
        If Form1.PBar1.Value < Form1.PBar1.Max Then 
            Form1.PBar1.Value = Form1.PBar1.Value + 1 
        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 
        rs.MoveNext 
        Set aditem = Nothing 
    Loop 
    rs.Close 
    Form1.Enabled = True 
    Form1.Frame2.Enabled = True 
    Form1.Frame3.Enabled = True 
    Form1.Frame4.Enabled = True 
    Form1.LV1.Visible = True 
    Form1.Frame1.Visible = False 
    Form1.Command1.Enabled = True 
    Exit Sub 
errhandle: 
    MsgBox "数据连接出错!", vbCritical + vbOKOnly, "错误提示" 
    If rs.State <> 0 Then rs.Close 
    Form1.Enabled = True 
    Form1.Frame2.Enabled = True 
    Form1.Frame3.Enabled = True 
    Form1.Frame4.Enabled = True 
    Form1.LV1.Visible = True 
    Form1.Frame1.Visible = False 
    Form1.Command1.Enabled = True 
End Sub