createdatabase.cls

这个就不用多说了

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CreateDatabase"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Dim conn As New ADODB.Connection
Dim mycommand As New ADODB.Command
Dim Myrecordset As New ADODB.Recordset
Sub conn_open(str As String)
    On Error GoTo err:
        If conn.state = 0 Then
         conn.ConnectionString = str
         conn.Open
        End If
        Exit Sub
err:
        MsgBox "不能连接数据", vbInformation, "提示"
        End
    End Sub
Function check(str As String, txt As String) As Boolean
check = False
Call conn_open(str)
mycommand.ActiveConnection = conn
mycommand.CommandType = adCmdText
mycommand.CommandText = txt
Set Myrecordset = mycommand.Execute
If Myrecordset.Fields(0).Value = 0 Then
   check = True
End If
End Function

Sub Create_SysDatabase()
Dim txt As String
Dim str As String
On Error GoTo err:
str = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=master"
txt = "SELECT count(*) FROM  sysdatabases Where Name = 'SYS'"
If check(str, txt) Then
   mycommand.ActiveConnection = conn
   mycommand.CommandText = "create database SYS"
   mycommand.Execute
End If
conn.Close
str = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=SYS"
txt = "select count(*) from dbo.sysobjects where id = object_id(N'[dbo].[SYS]') and OBJECTPROPERTY(id, N'IsUserTable') = 1"
If check(str, txt) Then
   mycommand.ActiveConnection = conn
   mycommand.CommandText = " CREATE TABLE [dbo].[SYS] ( [BH] [nvarchar] (50) COLLATE Chinese_PRC_CI_AS NOT NULL , [Name] [nvarchar] (100) COLLATE Chinese_PRC_CI_AS NOT NULL) ON [PRIMARY]"
   mycommand.Execute
End If
txt = "select Count(*) from dbo.sysobjects where id = object_id(N'[dbo].[MyUser]') and OBJECTPROPERTY(id, N'IsUserTable') = 1"
If check(str, txt) Then
   mycommand.ActiveConnection = conn
   mycommand.CommandText = " CREATE TABLE [dbo].[MyUser] ( [ID] [int] IDENTITY (1, 1) NOT NULL ,[UserName] [nvarchar] (50) COLLATE Chinese_PRC_CI_AS NULL ,[PWord] [nvarchar] (50) COLLATE Chinese_PRC_CI_AS NULL) ON [PRIMARY]"
   mycommand.Execute
   mycommand.CommandText = " insert Myuser (UserName,Pword) values('SYSTEM','88888')"
   mycommand.Execute
End If
conn.Close
Exit Sub
err:
MsgBox (err.Description)

End Sub
Function Create_Database(strDatabase As String, str1 As String, str2 As String, int1, int2) As Boolean
Create_Database = False
Dim txt As String
Dim str As String
Dim mystr As String
mystr = "JZ" & int2
On Error GoTo err:
str = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=master"
txt = "SELECT count(*) FROM  sysdatabases Where Name = " & " '" & strDatabase & "'"
If check(str, txt) Then
mycommand.ActiveConnection = conn
mycommand.CommandText = "CREATE DATABASE " & strDatabase & " ON PRIMARY (NAME = " & "'" & strDatabase & "'" & " , FILENAME = N'" & App.Path & "\data\" & strDatabase & " _Data.MDF' , SIZE = 1, FILEGROWTH = 10%) LOG ON (NAME = N'dfsew_Log', FILENAME = N'" & App.Path & "\data\" & strDatabase & " _Log.LDF' , SIZE = 1, FILEGROWTH = 10%)"
mycommand.Execute
Else
MsgBox " 存在此数据库,vbInformation ,提示"
Exit Function
End If
mycommand.CommandText = "RESTORE DATABASE " & strDatabase & " FROM  DISK =   N'" & App.Path & "\JS\GYZC' WITH  FILE = 1,  NOUNLOAD ,  STATS = 10,  RECOVERY ,  REPLACE ,  MOVE N'GYZC_Data' TO N'" & App.Path & "\data\" & strDatabase & " _Data.MDF', MOVE N'GYZC_Log' TO N'" & App.Path & "\data\" & strDatabase & " _Log.LDF'"
mycommand.Execute
conn.Close
str = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=" & strDatabase & ""
Call conn_open(str)
mycommand.ActiveConnection = conn
mycommand.CommandText = "insert JZ (JZYEAR," & mystr & ")" & "values(" & int1 & ",1)"
mycommand.Execute
conn.Close
str = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=SYS"
conn_open (str)
mycommand.ActiveConnection = conn
mycommand.CommandText = "insert SYS (BH,Name) values(" & "'" & str1 & "'" & "," & "'" & str2 & "'" & ")"
mycommand.Execute
conn.Close
Create_Database = True
Exit Function
err:
Create_Database = False
MsgBox (err.Description)

End Function


Private Sub Class_Terminate()
Set conn = Nothing
End Sub