系统.frm

强大的公司管理系统

VERSION 5.00
Begin VB.Form xitong 
   Caption         =   "系统设置"
   ClientHeight    =   5940
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6825
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5940
   ScaleWidth      =   6825
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command3 
      Caption         =   "复制数据库结构"
      Height          =   375
      Left            =   4320
      TabIndex        =   5
      Top             =   5520
      Width           =   1815
   End
   Begin VB.CommandButton Command2 
      Caption         =   "压缩数据库"
      Height          =   375
      Left            =   2760
      TabIndex        =   4
      Top             =   5520
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "创建数据库"
      Height          =   375
      Left            =   1080
      TabIndex        =   3
      Top             =   5520
      Width           =   1335
   End
   Begin VB.Frame Frame2 
      Caption         =   "其他设置"
      Height          =   5175
      Left            =   3480
      TabIndex        =   1
      Top             =   120
      Width           =   3135
   End
   Begin VB.Frame Frame1 
      Caption         =   "系统设置"
      Height          =   5175
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3135
      Begin VB.CheckBox Check1 
         Caption         =   "启用日志记录"
         Height          =   180
         Left            =   120
         TabIndex        =   2
         Top             =   360
         Width           =   2775
      End
   End
End
Attribute VB_Name = "xitong"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Command1_Click()
Dim myDB As DAO.Database
Dim str_SQL As String

Set myDB = DAO.Workspaces(0).CreateDatabase(App.Path & "\mydb.mdb", dbLangGeneral)

str_SQL = "Create Table NewTable1(Field1 Text(10),Field2 Short)"
myDB.Execute str_SQL
    
str_SQL = "Create Table NewTable2(Field1 Text(10),Field2 Short)"
myDB.Execute str_SQL

myDB.Close

End Sub

Private Sub Command2_Click()

On Error GoTo Err_Handle

Dim yasuoDB As New DAO.DBEngine
yasuoDB.CompactDatabase App.Path & "\mydb.mdb", App.Path & "\mydb_new.mdb"

Err_Handle:
    MsgBox Err.Description
Exit Sub
End Sub

Private Sub Command3_Click()
    Dim sourceDB As DAO.Database
    Set sourceDB = OpenDatabase(App.Path & "\mydb.MDB")
    Dim destDB As DAO.Database
    Set destDB = CreateDatabase(App.Path & "\结构库.mdb", dbLangGeneral)
    
    Dim sourceT As TableDef
    For Each sourceT In sourceDB.TableDefs
        If sourceT.Attributes = 0 Then
            Dim destT As TableDef
            Set destT = destDB.CreateTableDef(sourceT.Name, sourceT.Attributes, _
                               sourceT.SourceTableName, sourceT.Connect)
                               
            Dim sourceF As Field
            For Each sourceF In sourceT.Fields
                Dim destF As Field
                Set destF = destT.CreateField(sourceF.Name, sourceF.Type, sourceF.Size)
                destT.Fields.Append destF
            Next
            destDB.TableDefs.Append destT
        End If
    Next
    destDB.Close
    sourceDB.Close
End Sub

Private Sub Form_Load()

Call CheckLogin(Me)
Call SetCenter(Me)
End Sub