Option Explicit Private mdbPassword As String Private mdbPath As String Private Server As String Private UserID As String Private Password As String Private DatabaseName As String Public Property Let l_mdbPath(str_mdbPath As String) mdbPath = str_mdbPath End Property Public Property Let l_mdbPassword(str_mdbPassword As String) mdbPassword = str_mdbPassword End Property Public Property Let l_Server(str_Server As String) Server = str_Server End Property Public Property Let l_LoginID(str_LoginID As String) UserID = str_LoginID End Property Public Property Let l_Password(str_Password As String) Password = str_Password End Property Public Property Let l_DatabaseName(str_DatabaseName As String) DatabaseName = str_DatabaseName End Property '建立数据库 Public Function CreateDatabase() As Integer Dim sql_connString As String Dim conn As ADODB.Connection Set conn = New ADODB.Connection sql_connString = IF EXISTS (SELECT name FROM master.dbo.sysdatabases WHERE name = N' & DatabaseName & ') sql_connString = sql_connString + DROP DATABASE [ & DatabaseName & ] sql_connString = sql_connString + CREATE DATABASE [ & DatabaseName & ] conn.ConnectionString = driver=; & _ server= & Server & ; & _ uid= & UserID & ; & _ pwd= & Password & ; & _ database=master conn.Open conn.BeginTrans conn.Execute sql_connString If conn.Errors.Count 0 Then conn.RollbackTrans Else conn.CommitTrans CreateDatabase = 1 End If conn.Close Set conn = Nothing End Function
'建立数据库登录用户 Public Function CreateLoginUser(LoginName As String, UserLoginPassword As String) As Integer Dim tmp_Str As String Dim conn_mdb As New ADODB.Connection Dim conn_Sql As New ADODB.Connection Dim rs_mdb As New ADODB.Recordset '打开SQL SERVER数据库 conn_Sql.ConnectionString = driver=; & _ server= & Server & ; & _ uid= & UserID & ; & _ pwd= & Password & ; & _ database= & DatabaseName conn_Sql.Open '打开MDB数据库 conn_mdb.Open driver=;dbq= & mdbPath & ;password= & mdbPassword rs_mdb.Open CreateLoginUser, conn_mdb, adOpenDynamic If Not (rs_mdb.EOF And rs_mdb.BOF) Then rs_mdb.MoveFirst conn_Sql.BeginTrans While Not rs_mdb.EOF tmp_Str = CStr(rs_mdb(CreateLoginUserSqlLine)) If InStr(1, tmp_Str, DefaultDatabase) 0 Then tmp_Str = Replace(tmp_Str, DefaultDatabase, DatabaseName) End If If InStr(1, tmp_Str, DefaultPassword) 0 Then tmp_Str = Replace(tmp_Str, DefaultPassword, UserLoginPassword) End If If InStr(1, tmp_Str, DefaultUser) 0 Then tmp_Str = Replace(tmp_Str, DefaultUser, LoginName) End If conn_Sql.Execute tmp_Str rs_mdb.MoveNext Wend If conn_Sql.Errors.Count 0 Then conn_Sql.RollbackTrans CreateLoginUser = 0 rs_mdb.Close Exit Function Else conn_Sql.CommitTrans CreateLoginUser = 1 rs_mdb.Close End If Else CreateLoginUser = 0 End If conn_mdb.Close conn_Sql.Close Set conn_Sql = Nothing Set conn_mdb = Nothing End Function
'建立数据库相关结构内容 Public Function CreateTable() As Integer Dim conn_mdb As New ADODB.Connection Dim conn_Sql As New ADODB.Connection Dim rs_mdb As New ADODB.Recordset '打开SQL SERVER数据库 conn_Sql.ConnectionString = driver=; & _ server= & Server & ; & _ uid= & UserID & ; & _ pwd= & Password & ; & _ database= & DatabaseName conn_Sql.Open '打开MDB数据库 conn_mdb.Open driver=;dbq= & mdbPath & ;password= & mdbPassword '第一步，从FirstDropContent表中取得SQL语句，删除库中已经存在的内容 rs_mdb.Open FirstDropContent, conn_mdb, adOpenDynamic If Not (rs_mdb.EOF And rs_mdb.BOF) Then rs_mdb.MoveFirst conn_Sql.BeginTrans While Not rs_mdb.EOF conn_Sql.Execute CStr(rs_mdb(DropContent)) rs_mdb.MoveNext Wend If conn_Sql.Errors.Count 0 Then conn_Sql.RollbackTrans CreateTable = 0 rs_mdb.Close Exit Function Else conn_Sql.CommitTrans rs_mdb.Close End If Else CreateTable = 0 End If '第二步，从CreateTable表中取得SQL语句，建立数据库的表 rs_mdb.Open CreateTable, conn_mdb, adOpenDynamic If Not (rs_mdb.EOF And rs_mdb.BOF) Then rs_mdb.MoveFirst conn_Sql.BeginTrans While Not rs_mdb.EOF conn_Sql.Execute CStr(rs_mdb(CreateTable)) rs_mdb.MoveNext Wend If conn_Sql.Errors.Count 0 Then conn_Sql.RollbackTrans CreateTable = 0 rs_mdb.Close Exit Function Else conn_Sql.CommitTrans rs_mdb.Close End If Else CreateTable = 0 End If '第三步，从AlertTable表中取得SQL语句，修改数据库的表 rs_mdb.Open AlertTable, conn_mdb, adOpenDynamic If Not (rs_mdb.EOF And rs_mdb.BOF) Then rs_mdb.MoveFirst conn_Sql.BeginTrans While Not rs_mdb.EOF conn_Sql.Execute CStr(rs_mdb(AlertTable)) rs_mdb.MoveNext Wend If conn_Sql.Errors.Count 0 Then conn_Sql.RollbackTrans CreateTable = 0 rs_mdb.Close Exit Function Else conn_Sql.CommitTrans rs_mdb.Close End If Else CreateTable = 0 End If '第四步，从CreateView表中取得SQL语句，建立数据库的视图 rs_mdb.Open CreateView, conn_mdb, adOpenDynamic If Not (rs_mdb.EOF And rs_mdb.BOF) Then rs_mdb.MoveFirst conn_Sql.BeginTrans While Not rs_mdb.EOF conn_Sql.Execute CStr(rs_mdb(CreateView)) rs_mdb.MoveNext Wend If conn_Sql.Errors.Count 0 Then conn_Sql.RollbackTrans CreateTable = 0 rs_mdb.Close Exit Function Else conn_Sql.CommitTrans rs_mdb.Close End If Else CreateTable = 0 End If '第五步，从CreateProcedure表中取得SQL语句，建立数据库的存储过程 rs_mdb.Open CreateProcedure, conn_mdb, adOpenDynamic If Not (rs_mdb.EOF And rs_mdb.BOF) Then rs_mdb.MoveFirst conn_Sql.BeginTrans While Not rs_mdb.EOF conn_Sql.Execute CStr(rs_mdb(CreateProcedure)) rs_mdb.MoveNext Wend If conn_Sql.Errors.Count 0 Then conn_Sql.RollbackTrans CreateTable = 0 rs_mdb.Close Exit Function Else conn_Sql.CommitTrans rs_mdb.Close End If Else CreateTable = 0 End If '第六步，从CreateTrigger表中取得SQL语句，建立数据库的触发过程 rs_mdb.Open CreateTrigger, conn_mdb, adOpenDynamic If Not (rs_mdb.EOF And rs_mdb.BOF) Then rs_mdb.MoveFirst conn_Sql.BeginTrans While Not rs_mdb.EOF conn_Sql.Execute CStr(rs_mdb(CreateTrigger)) rs_mdb.MoveNext Wend If conn_Sql.Errors.Count 0 Then conn_Sql.RollbackTrans CreateTable = 0 rs_mdb.Close Exit Function Else conn_Sql.CommitTrans rs_mdb.Close End If Else CreateTable = 0 End If CreateTable = 1 conn_mdb.Close conn_Sql.Close Set conn_mdb = Nothing Set conn_Sql = Nothing End Function
'删除数据库 Public Function DropDatabase() As Integer Dim sql_connString As String Dim conn As New ADODB.Connection conn.ConnectionString = driver=; & _ server= & Server & ; & _ uid= & UserID & ; & _ pwd= & Password & ; & _ database=master conn.Open conn.BeginTrans sql_connString = IF EXISTS (SELECT name FROM master.dbo.sysdatabases WHERE name = N' & DatabaseName & ') sql_connString = sql_connString + DROP DATABASE [ & DatabaseName & ] conn.Execute sql_connString If conn.Errors.Count 0 Then conn.RollbackTrans Else conn.CommitTrans DropDatabase = 1 End If conn.Close Set conn = Nothing End Function
'填充默认数据表内容 Public Function FillTable() Dim conn_mdb As New ADODB.Connection Dim conn_Sql As New ADODB.Connection Dim rs_mdb As New ADODB.Recordset Dim rs_Sql As New ADODB.Recordset '打开SQL SERVER数据库 conn_Sql.ConnectionString = driver=; & _ server= & Server & ; & _ uid= & UserID & ; & _ pwd= & Password & ; & _ database= & DatabaseName conn_Sql.Open '打开MDB数据库 conn_mdb.Open driver=;dbq= & mdbPath & ;password= & mdbPassword '第一步，将MDB库GeneralCode表中的内容导入到SQL SERVEER中的GeneralCode表中。 rs_mdb.Open GeneralCode, conn_mdb, adOpenDynamic rs_Sql.Open dbo.GeneralCode, conn_Sql, adOpenDynamic, adLockOptimistic If Not rs_Sql.EOF Then rs_Sql.MoveFirst While Not rs_Sql.EOF rs_Sql.Delete rs_Sql.MoveNext Wend End If If Not (rs_mdb.BOF And rs_mdb.EOF) Then rs_mdb.MoveFirst conn_Sql.BeginTrans While Not rs_mdb.EOF rs_Sql.AddNew rs_Sql(Catalog) = rs_mdb(Catalog).Value rs_Sql(Code) = rs_mdb(Code).Value rs_Sql(Description) = rs_mdb(Description).Value rs_Sql(FriendKeyID) = rs_mdb(FriendKeyID).Value rs_Sql(ModifyBy) = rs_mdb(ModifyBy).Value rs_Sql(ModifyDate) = rs_mdb(ModifyDate).Value rs_Sql(UsedBy) = rs_mdb(UsedBy).Value rs_Sql(TransferFlag) = rs_mdb(TransferFlag).Value rs_Sql.Update rs_mdb.MoveNext Wend If conn_Sql.Errors.Count 0 Then conn_Sql.RollbackTrans FillTable = 0 rs_mdb.Close rs_Sql.Close Exit Function Else conn_Sql.CommitTrans rs_mdb.Close rs_Sql.Close End If Else FillTable = 0 rs_mdb.Close rs_Sql.Close End If
'第二步，将MDB库Program表中的内容导入到SQL SERVEER中的Program表中。 rs_mdb.Open Program, conn_mdb, adOpenDynamic rs_Sql.Open dbo.Program, conn_Sql, adOpenDynamic, adLockOptimistic If Not rs_Sql.EOF Then rs_Sql.MoveFirst While Not rs_Sql.EOF rs_Sql.Delete rs_Sql.MoveNext Wend End If If Not (rs_mdb.BOF And rs_mdb.EOF) Then rs_mdb.MoveFirst conn_Sql.BeginTrans While Not rs_mdb.EOF rs_Sql.AddNew rs_Sql(ProgramID) = rs_mdb(ProgramID).Value rs_Sql(ProgramName) = rs_mdb(ProgramName).Value rs_Sql.Update rs_mdb.MoveNext Wend If conn_Sql.Errors.Count 0 Then conn_Sql.RollbackTrans FillTable = 0 rs_mdb.Close rs_Sql.Close Exit Function Else conn_Sql.CommitTrans rs_mdb.Close rs_Sql.Close End If Else FillTable = 0 rs_mdb.Close rs_Sql.Close End If
'第三步，将MDB库UserAuthorization表中的内容导入到SQL SERVEER中的UserAuthorization表中。 rs_mdb.Open UserAuthorization, conn_mdb, adOpenDynamic rs_Sql.Open dbo.UserAuthorization, conn_Sql, adOpenDynamic, adLockOptimistic If Not rs_Sql.EOF Then rs_Sql.MoveFirst While Not rs_Sql.EOF rs_Sql.Delete rs_Sql.MoveNext Wend End If If Not (rs_mdb.BOF And rs_mdb.EOF) Then rs_mdb.MoveFirst conn_Sql.BeginTrans While Not rs_mdb.EOF rs_Sql.AddNew rs_Sql(UserID) = rs_mdb(UserID).Value rs_Sql(UserName) = rs_mdb(UserName).Value rs_Sql(PositionID) = rs_mdb(PositionID).Value rs_Sql(GroupID) = rs_mdb(GroupID).Value rs_Sql(Password) = rs_mdb(Password).Value rs_Sql(Authoration) = rs_mdb(Authoration).Value rs_Sql(ModifyBy) = rs_mdb(ModifyBy).Value rs_Sql(ModifyDate) = Now rs_Sql(TransferFlag) = rs_mdb(TransferFlag).Value rs_Sql.Update rs_mdb.MoveNext Wend If conn_Sql.Errors.Count 0 Then conn_Sql.RollbackTrans FillTable = 0 rs_mdb.Close rs_Sql.Close Exit Function Else conn_Sql.CommitTrans rs_mdb.Close rs_Sql.Close End If Else FillTable = 0 rs_mdb.Close rs_Sql.Close End If
'第四步，将MDB库QueryView表中的内容导入到SQL SERVEER中的QueryView表中。 rs_mdb.Open QueryView, conn_mdb, adOpenDynamic rs_Sql.Open dbo.QueryView, conn_Sql, adOpenDynamic, adLockOptimistic If Not rs_Sql.EOF Then rs_Sql.MoveFirst While Not rs_Sql.EOF rs_Sql.Delete rs_Sql.MoveNext Wend End If If Not (rs_mdb.BOF And rs_mdb.EOF) Then rs_mdb.MoveFirst conn_Sql.BeginTrans While Not rs_mdb.EOF rs_Sql.AddNew rs_Sql(ProgramCode) = rs_mdb(ProgramCode).Value rs_Sql(ViewName) = rs_mdb(ViewName).Value rs_Sql.Update rs_mdb.MoveNext Wend If conn_Sql.Errors.Count 0 Then conn_Sql.RollbackTrans FillTable = 0 rs_mdb.Close rs_Sql.Close Exit Function Else conn_Sql.CommitTrans rs_mdb.Close rs_Sql.Close End If Else FillTable = 0 rs_mdb.Close rs_Sql.Close End If FillTable = 1 conn_mdb.Close conn_Sql.Close Set conn_mdb = Nothing Set conn_Sql = Nothing End Function
