system_module.bas

适合于中小型企业管理

Attribute VB_Name = "Mdl_sysMain"
Option Explicit

Public Const DBphyFileName = "MIS2Data"
'默认的初始化帐套的物理文件名，打包时的物理文件名必须与此保持一致，且放在程序执行目录下
Public Const DBlogicFileName = "MIS2Data"
'必须是备份时数据库的逻辑文件名；
'默认的初始化帐套的逻辑文件名，新建帐套时需要用到

Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Public ServerName_Str As String
Public Conn_System As Connection
Public Conn_System3 As Connection
Public Conn_System1 As New ADODB.Connection
Public Conn_System2 As New Connection
Public YesNoStr As String
Public PathStr As String
Public BakFile As String, BakFilePath As String
Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long


Sub Main()
    Set Conn_System = Cw_DataEnvi.Connection1
    App.HelpFile = App.Path + "\系统管理.chm"
    Form_user.Show
End Sub


Public Sub setStatusBar(Str As String, tf As Boolean)
    If tf = True Then Form_main.StatusBar.Panels(2).Text = "就绪": Form_main.Refresh: Exit Sub
    Form_main.StatusBar.Panels(2).Text = Str
    Form_main.Refresh
End Sub

Public Sub sub_DBInit()
'新建数据库，初始化DB系统环境
On Error Resume Next
Dim sSql As String
Dim rs As New ADODB.Recordset

sSql = "CREATE DATABASE [EboSys]  ON (NAME = N'EboSys_Data', FILENAME = N'" & App.Path & "\EboSys_Data.MDF' , SIZE = 1, FILEGROWTH = 10%) LOG ON (NAME = N'EboSys_Log', FILENAME = N'" & App.Path & "\EboSys_Log.LDF' , SIZE = 1, FILEGROWTH = 10%) " _
        & "Collate Chinese_PRC_CI_AS " & Chr(10)
        
Conn_System2.Execute sSql

    sSql = "exec sp_dboption N'EboSys', N'autoclose', N'false' " _
        & "exec sp_dboption N'EboSys', N'bulkcopy', N'false' " _
        & "exec sp_dboption N'EboSys', N'trunc. log', N'true' " _
        & "exec sp_dboption N'EboSys', N'torn page detection', N'true' " _
        & "exec sp_dboption N'EboSys', N'read only', N'false' " _
        & "exec sp_dboption N'EboSys', N'dbo use', N'false' " _
        & "exec sp_dboption N'EboSys', N'single', N'false' " _
        & "exec sp_dboption N'EboSys', N'autoshrink', N'false' " _
        & "exec sp_dboption N'EboSys', N'ANSI null default', N'false' " _
        & "exec sp_dboption N'EboSys', N'recursive triggers', N'false' " _
        & "exec sp_dboption N'EboSys', N'ANSI nulls', N'false' " _
        & "exec sp_dboption N'EboSys', N'concat null yields null', N'false' " _

    sSql = sSql & "exec sp_dboption N'EboSys', N'cursor close on commit', N'false' " _
        & "exec sp_dboption N'EboSys', N'default to local cursor', N'false' " _
        & "exec sp_dboption N'EboSys', N'quoted identifier', N'false' " _
        & "exec sp_dboption N'EboSys', N'ANSI warnings', N'false' " _
        & "exec sp_dboption N'EboSys', N'auto create statistics', N'true' " _
        & "exec sp_dboption N'EboSys', N'auto update statistics', N'true' " _

    sSql = sSql & "use EboSys "
Conn_System2.Execute sSql


sSql = "if exists (select * from dbo.sysobjects where " & Chr(13) _
        & " id = object_id(N'[Ebo_DataBases]') and OBJECTPROPERTY(id, N'IsUserTable') = 1) " & Chr(13) _
        & " drop table [Ebo_DataBases] " & Chr(13) _
        & " CREATE TABLE Ebo_DataBases (" _
        & "DataBasesName        Nvarchar(18  ) NOT NULL," _
        & "Number               Nvarchar(8) NULL," _
        & "CountingRoomName     Nvarchar(20) NULL," _
        & "NewDate              datetime NULL," _
        & "BackupDate           datetime NULL," _
        & "RestoreDate          datetime NULL," _
        & "ServerName           varchar(30) NULL," _
        & "DatabaseType         varchar(30) NULL," _
        & "YNuse                char(1) NULL," _
        & "CoName               nvarchar(50) NULL," _
        & "Address              nvarchar(50) NULL," _
        & "Phone                nvarchar(30) NULL," _
        & "qsqj                 int" _
        & ")"
sSql = sSql & " ALTER TABLE Ebo_DataBases " _
        & "ADD PRIMARY KEY (DataBasesName) "
Conn_System2.Execute sSql

sSql = " if exists (select * from dbo.sysobjects where " & Chr(13) _
            & " id = object_id(N'[Ebo_BakDataBases]') and OBJECTPROPERTY(id, N'IsUserTable') = 1) " & Chr(13) _
            & " drop table [Ebo_BakDataBases] " & Chr(13) _
            & " CREATE TABLE Ebo_BakDataBases (" _
            & "Number               int IDENTITY(1,1)," _
            & "DatabaseName         nvarchar(30) NOT NULL," _
            & "BakName              nvarchar(30) NULL," _
            & "BakPath              nvarchar(100) NULL," _
            & "BakDate              datetime NULL" _
            & ")"
sSql = sSql & " ALTER TABLE Ebo_BakDataBases " _
        & "ADD PRIMARY KEY (Number, DatabaseName) "
 Conn_System2.Execute sSql

sSql = " if exists (select * from dbo.sysobjects where " _
            & " id = object_id(N'[Ebo_Password]') and OBJECTPROPERTY(id, N'IsUserTable') = 1) " _
            & " drop table [Ebo_Password] " _
            & " CREATE TABLE Ebo_Password (" _
            & "id                   smallint NOT NULL," _
            & "Password             varchar(50) NULL" _
            & ") "

sSql = sSql & " ALTER TABLE Ebo_Password " _
        & "ADD PRIMARY KEY (id) "
Conn_System2.Execute sSql

'自动升级的文件存储表
sSql = "if exists (select * from dbo.sysobjects where id = object_id(N'[sys_Update]') and OBJECTPROPERTY(id, N'IsUserTable') = 1)" _
        & " drop table [sys_Update] " _
        & " CREATE TABLE [sys_Update] ( " _
        & " [iNo] [int] IDENTITY (1, 1) NOT NULL ," _
        & " [ProjectName] [varchar] (50) COLLATE Chinese_PRC_CI_AS NOT NULL ," _
        & " [ModelName] [varchar] (50) COLLATE Chinese_PRC_CI_AS NOT NULL ," _
        & " [Version] [varchar] (50) COLLATE Chinese_PRC_CI_AS NOT NULL ," _
        & " [CreateTime] [datetime] NOT NULL ," _
        & " [FileSize] [bigint] NOT NULL ," _
        & " [UpdateTimes] [int] NULL ," _
        & " [FileBody] [image] NULL ," _
        & " [Remark] [varchar] (80) COLLATE Chinese_PRC_CI_AS NULL" _
        & " ) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY]"

Conn_System2.Execute sSql

'新建存储过程
sSql = " if exists (select * from sysobjects where id = object_id(N'[Ebo_AddDatabase]') and OBJECTPROPERTY(id, N'IsProcedure') = 1) " & Chr(13) _
        & " drop procedure [Ebo_AddDatabase] "
        Conn_System2.Execute sSql
Conn_System2.Execute Form_user.Text(0).Text

sSql = " if exists (select * from sysobjects where id = object_id(N'[Ebo_BakDatabase]') and OBJECTPROPERTY(id, N'IsProcedure') = 1) " & Chr(13) _
        & " drop procedure [Ebo_BakDatabase] "
        Conn_System2.Execute sSql
Conn_System2.Execute Form_user.Text(1).Text

'新建登陆名
sSql = "SELECT * FROM master..sysxlogins WHERE name='Ebodiy2008'"
Set rs = Conn_System2.Execute(sSql)
If rs.EOF Then
    Conn_System2.Execute " EXEC sp_addlogin 'Ebodiy2008', 'Gen13301481112'"
    Conn_System2.Execute " EXEC sp_addsrvrolemember 'Ebodiy2008', 'sysadmin'"
End If
End Sub