database.cls

VB类实现学生信息管理系统

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "database"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Const adStateOpen = 1
Const adStateClosed = 0
Private db_name As String
Private cnn As ADODB.Connection
Private db_string As String
Private default_db_path  As String
Private affect_row As Integer
Public db_type As String
Dim WithEvents connevent As ADODB.Connection
Attribute connevent.VB_VarHelpID = -1
Private Sub Class_Initialize()
Set cnn = New ADODB.Connection
db_name = ""
default_db_path = App.Path + "\student.mdb;"
cnn.CursorLocation = adUseClient
db_type = ""
End Sub




Public Property Let db_path(ByVal vData As Variant)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.cccc = 5
    db_name = vData
End Property


Public Property Set db_path(ByVal vData As Variant)
'向属性指派对象时使用，位于 Set 语句的左边。
'Syntax: Set x.cccc = Form1
    Set db_name = vData
End Property

Public Sub connect()
If InStr(db_type, "access") > 0 Then 'access database
    If db_name <> "" Then
         db_string = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & db_name & " Persist Security Info=False"
    Else
         db_string = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & default_db_path & " Persist Security Info=False"
    End If
End If

If InStr(db_type, "oracle") > 0 Then 'oracle
   
db_string = "Provider=MSDAORA.1;Password=v30;User ID=gms;Data Source=" & db_name & ";Persist Security Info=True"
End If


If InStr(db_type, "sql_server") > 0 Then 'sql_server


End If


On Error Resume Next
cnn.Open db_string



End Sub
Public Sub disconnect()
   cnn.Close
   
End Sub
Public Function db_state() As Integer
 If cnn.State = adStateOpen Then
    db_state = 1
 End If
 
 If cnn.State = adStateClosed Then
    db_state = 0
 End If
 
 

End Function




Public Function ExecuteSQL(ByVal SQL As String, MsgString As String) As ADODB.Recordset 'executes SQL and returns Recordset
   Dim rst As ADODB.Recordset
   
   
   
   Dim sTokens() As String '定义一个string类
   
   On Error GoTo ExecuteSQL_Error
   
   sTokens = Split(SQL)
   
   Set connevent = cnn
   If db_state = 1 Then
      If InStr("INSERT,DELETE,UPDATE", UCase$(sTokens(0))) Then ' return recordset
              cnn.Execute SQL
          If affect_row > 0 Then 'insert,update,delete need consider the affected rows
              'MsgBox affect_row
               MsgString = Trim(LCase$(sTokens(0))) & "_ok"
          Else
               MsgString = Trim(LCase$(sTokens(0))) & "_wrong"
          End If
      
      Else 'select操作
             Set rst = New ADODB.Recordset
             rst.Open Trim$(SQL), cnn, adOpenStatic, adLockReadOnly
      
          If rst.RecordCount <> 0 Then
             Set ExecuteSQL = rst
             MsgString = "query_ok"
          Else
             MsgString = "query_wrong"
          End If
      End If
   Else
             MsgString = "database_wrong"
   End If
   
ExecuteSQL_Exit:
   Set rst = Nothing
   Set connevent = Nothing
   Exit Function
   
ExecuteSQL_Error:

   MsgString = "unknow_wrong"
   Resume ExecuteSQL_Exit
End Function

Private Sub connevent_ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)
 affect_row = RecordsAffected '用来判定
End Sub


Public Sub init()
Dim sql_temp As String
Dim tmp_cmd As ADODB.Command

If InStr(db_type, "access") > 0 Then
   
sql_temp = "CREATE TABLE user_Info ("
sql_temp = sql_temp & " user_ID char (10)  primary key NOT NULL  ,"
sql_temp = sql_temp & " user_PWD char (50)  NULL ,"
sql_temp = sql_temp & " user_Des char (10)  NULL );"

Set tmp_cmd = New ADODB.Command
Set tmp_cmd.ActiveConnection = cnn

tmp_cmd.CommandText = sql_temp
tmp_cmd.CommandType = adCmdText
tmp_cmd.Execute
MsgBox oper_flag

sql_temp = "insert into user_info values('admin','" + DigestStrToHexStr("admin") + "',0)"
MsgBox sql_temp

tmp_cmd.CommandText = sql_temp
tmp_cmd.CommandType = adCmdText
tmp_cmd.Execute



End If


If InStr(db_type, "oracle") > 0 Then
sql_temp = "CREATE TABLE user_Info ("
sql_temp = sql_temp & " user_ID char (10)  primary key NOT NULL  ,"
sql_temp = sql_temp & " user_PWD char (50)  NULL ,"
sql_temp = sql_temp & " user_Des char (10)  NULL );"

Set tmp_cmd = New ADODB.Command
Set tmp_cmd.ActiveConnection = cnn

tmp_cmd.CommandText = sql_temp
tmp_cmd.CommandType = adCmdText
tmp_cmd.Execute

MsgBox oper_flag


End If

End Sub