Dim Cn As SqlConnection '得到SQL脚本字符串 Private Function GetSql(ByVal Name As String) As String Try '通过反射取到程序集 Dim Asm As [Assembly] = [Assembly].GetExecutingAssembly() '读取资源文件资料,要将资源文件在编译时设成嵌入的资源 Dim Sm As Stream = Asm.GetManifestResourceStream(Asm.GetName().Name + "." + Name) Dim Rr As New StreamReader(Sm) Return Rr.ReadToEnd Catch ex As Exception MsgBox(Err.Description, MsgBoxStyle.OKOnly, "出错提示") Throw ex End Try End Function '得到数据库备份文件路径 Private Function GetBakFilePath(ByVal DatFileName As String) As String Try '通过反射取到程序集 Dim Asm As [Assembly] = [Assembly].GetExecutingAssembly() '读取资源文件资料,要将资源文件在编译时设成嵌入的资源 Dim Sm As Stream = Asm.GetManifestResourceStream(Asm.GetName().Name + "." + DatFileName) If File.Exists("c:\" & DatFileName) Then File.Delete("c:\" & DatFileName) End If Dim Fs As New FileStream("c:\" & DatFileName, FileMode.Create) Dim Sw As New BinaryWriter(Fs) Dim recbyte(Sm.Length - 1) As Byte Dim strread As New BinaryReader(Sm) strread.Read(recbyte, 0, recbyte.Length) Sw.Write(recbyte, 0, recbyte.Length) Sw.Close() Fs.Close() Return "C:\" & DatFileName Catch ex As Exception MsgBox(Err.Description, MsgBoxStyle.OKOnly, "出错提示") Throw ex End Try End Function Private Sub ExecuteSql(ByVal DbName As String, ByVal SqlText As String, ByVal uid As String, ByVal pwd As String, ByVal servername As String) Dim cmd As New SqlCommand(SqlText, Cn) If Cn.State = ConnectionState.Closed Then Cn.Open() Try Cn.ChangeDatabase(DbName) cmd.ExecuteNonQuery() Catch ex As Exception MsgBox("运行SQL脚本出错!", MsgBoxStyle.OKOnly, "提示") Throw ex End Try Cn.Close() End Sub Protected Sub AddDBTable(ByVal DBName As String, ByVal uid As String, ByVal pwd As String, ByVal servername As String) '判断数据库是否存在 Try Cn = New SqlConnection("Persist Security Info=False;User ID=" & uid & ";Initial Catalog=master;Data Source=" & servername & ";password=" & pwd & ";Max Pool Size=75000") Dim Dt As New DataTable() Cn.Open() Dim cmd As New SqlDataAdapter() cmd.SelectCommand = New SqlCommand("exec sp_helpdb", Cn) cmd.Fill(Dt) Dim i As Int16 For i = 0 To Dt.Rows.Count - 1 If DBName.ToLower = CType(Dt.Rows(i).Item(0), String).ToLower Then '数据库存在 cmd = Nothing Cn.Close() Exit Sub End If Next Catch ex As Exception MsgBox(Err.Description & "连接数据库出错,请检查所输入的参数是否正确!", MsgBoxStyle.OKOnly, "出错提示") Exit Sub '如已存在则跳出 End Try
Try '========方法一:运行SQL脚本创建数据库 ' ExecuteSql("Master", "Create DataBase " & DBName, uid, pwd, servername) 'ExecuteSql(DBName, GetSql("mySql.txt"), uid, pwd, servername) '========方法二:执行还原备份文件 Dim cm As New ADODB.Command() Dim cn As New ADODB.Connection() Dim dbrs As New ADODB.Recordset() cn.Open("Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" & uid & ";Initial Catalog=master;Data Source=" & servername & ";password=" & pwd) cm.ActiveConnection = cn '判断该数据是否存在,存在就删除 cm.CommandText = "exec sp_helpdb" dbrs = cm.Execute() '取所有数据库名 If Not dbrs.BOF And Not dbrs.EOF Then Do While Not dbrs.EOF If Trim(dbrs.Fields(0).Value) = Trim(DBName) Then '如果该数据库存 cm.CommandText = "drop database " & Trim(DBName) cm.Execute() Exit Do End If dbrs.MoveNext() Loop End If ' dbrs.Close() Dim Sfile As String = GetBakFilePath("installdb.dat") cm.CommandText = "restore database " & Trim(DBName) & " from DISK='" & Trim(Sfile) & "'" cm.Execute() cn.Close() If File.Exists(Sfile) Then File.Delete(Sfile) End If Catch ex As Exception MsgBox(Err.Description & "A", MsgBoxStyle.OKOnly, "出错提示") Throw ex End Try End Sub
'覆写安装方法 Public Overrides Sub Install(ByVal stateSaver As System.Collections.IDictionary) MyBase.Install(stateSaver) '取安装程序中用户界面中添回的文本框中的参数值 Dim Connstr As String = Me.Context.Parameters.Item("dbname") Dim Cs As String() = Split(Connstr, "|") AddDBTable(Cs(0), Cs(1), Cs(2), Cs(3)) End Sub
设为主页
收藏本站
相关文章: