frmmain.frm

一个资料管理系统的源程序

      K20ijKoi039cnfgaRREE_sdwedfrrgth_ssudgred=   $"frmMain.frx":2481E
      MenuItems       =   $"frmMain.frx":24824
      Style           =   1
      MenuBarRightColor=   -2147483633
      LeftBarBottomColor=   -2147483633
      MenuBackColor   =   -2147483633
      IconBorderStyle =   3
      HilightLeft     =   43
      IconLeft        =   21
      HiLightBorderColor=   8388736
      IconBorderColor =   8421376
      MenuTextLeft    =   45
      MenuHeight      =   21
      BeginProperty MenuTextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty MenuSelTextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin LXDCoolMenu.ImageList ImageList2 
      Left            =   7470
      Top             =   2640
      _ExtentX        =   1058
      _ExtentY        =   1058
      MaskColor       =   16777215
      ImageWidth      =   16
      ImageHeight     =   16
      ImageNumber     =   14
      Image1          =   "frmMain.frx":24EBC
      Image2          =   "frmMain.frx":251D6
      Image3          =   "frmMain.frx":254F0
      Image4          =   "frmMain.frx":2580A
      Image5          =   "frmMain.frx":25B24
      Image6          =   "frmMain.frx":25E3E
      Image7          =   "frmMain.frx":26158
      Image8          =   "frmMain.frx":26472
      Image9          =   "frmMain.frx":2678C
      Image10         =   "frmMain.frx":26AA6
      Image11         =   "frmMain.frx":26DC0
      Image12         =   "frmMain.frx":270DA
      Image13         =   "frmMain.frx":273F4
      Image14         =   "frmMain.frx":2770E
   End
   Begin VB.Menu mnuFile 
      Caption         =   "数据管理(&D)"
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public sdest As String

Private Sub MDIForm_Load()
  sbStatusBar.Panels(1).Text = "当前用户是:" & gz_user
  Call xpstyle
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
  Y = MsgBox("你要退出程序吗？", vbQuestion + vbYesNo, "提示")
  If Y <> 6 Then
    Cancel = True
  Else
    Cancel = False
  End If
End Sub
Private Sub mnu_bfsj()
    
    Dim i As String
    On Error Resume Next
    With cdlog1
        .DialogTitle = "数据备份"
        .InitDir = App.Path
        .filename = "backup.mdb"
        .Filter = "(数据库)*.mdb|*.mdb"
        .CancelError = True
        .ShowSave
        i = .filename
    End With
    If Right$(App.Path, 1) <> "\" Then spath = App.Path & "\"
    ssource = spath & "mdb\ls.lbl"
    sdest = i
    If Err.Number <> cdlCancel Then
      On Error GoTo sjbf_error
      If Dir$(i) <> "" Then
        s = MsgBox("文件已存在,确认替换它！", vbYesNo + vbQuestion)
        If s = vbYes Then
          FileCopy ssource, sdest
          bkup
        Else
          mnu_bfsj
        End If
      Else
          FileCopy ssource, sdest
          bkup
      End If
    End If
    Exit Sub
sjbf_error:
    If Err = 70 Then
    MsgBox "数据库正在使用，请关闭所有数据窗口，从新开始备份", vbExclamation
    Else
    MsgBox Err.Description, vbExclamation
    End If
End Sub
Private Sub mnu_hfsj()
Dim i As String
    On Error Resume Next
        With cdlog1
        .DialogTitle = "数据恢复"
        .InitDir = App.Path
        .Filter = "(数据库)*.mdb|*.mdb"
        .CancelError = True
        .Flags = cdlOFNHideReadOnly Or cdlOFNFileMustExist
        .ShowOpen
        i = .filename
    End With
    ssource = i
    If Right$(App.Path, 1) <> "\" Then spath = App.Path & "\"
    sdest = spath & "mdb\ziliao.lbl"
         If Err.Number <> cdlCancel Then
        On Error GoTo sjh_error
         s = MsgBox("系统数据将全部丢失，确认要从数据文件" & i & "中恢复系统数据吗？", vbYesNo + vbQuestion)
         If s = 6 Then
          Dim db1 As Connection
          Set db1 = New Connection
          db1.CursorLocation = adUseClient
          db1.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & sdest
          
          sql1 = "delete * from book_v"
          db1.Execute sql1
          sql1 = "insert into book_v select * from book_v in  '" & i & "'"
          db1.Execute sql1
          
           sql1 = "delete * from bzzl_v"
          db1.Execute sql1
          sql1 = "insert into bzzl_v select * from bzzl_v in  '" & i & "'"
          db1.Execute sql1
          
           sql1 = "delete * from image_v"
          db1.Execute sql1
          sql1 = " insert into image_v select * from image_v in  '" & i & "'"
          db1.Execute sql1
          
          sql1 = "delete * from jy_jl"
          db1.Execute sql1
          sql1 = "insert into jy_jl select * from jy_jl in  '" & i & "'"
          db1.Execute sql1
          
          sql1 = "delete * from jygr_v"
          db1.Execute sql1
          sql1 = "insert into jygr_v select * from jygr_v in  '" & i & "'"
          db1.Execute sql1
          
           sql1 = "delete * from ml_v"
          db1.Execute sql1
          sql1 = "insert into ml_v select * from ml_v in  '" & i & "'"
          db1.Execute sql1
          
          sql1 = "delete * from wzzl_v"
          db1.Execute sql1
          sql1 = "insert into wzzl_v select * from wzzl_v in  '" & i & "'"
          db1.Execute sql1
          
          sql1 = "delete * from xfzl_lqdw"
          db1.Execute sql1
          sql1 = "insert into xfzl_lqdw select * from xfzl_lqdw in  '" & i & "'"
          db1.Execute sql1
          
          sql1 = "delete * from xfzl_v"
          db1.Execute sql1
          sql1 = "insert into xfzl_v select * from xfzl_v in  '" & i & "'"
          db1.Execute sql1
          
          sql1 = "delete * from xfzl_xf_jl"
          db1.Execute sql1
          sql1 = "insert into xfzl_xf_jl select * from xfzl_xf_jl in  '" & i & "'"
          db1.Execute sql1
          
          sql1 = "delete * from xfzl_xh_jl"
          db1.Execute sql1
          sql1 = "insert into xfzl_xh_jl select * from xfzl_xh_jl in  '" & i & "'"
          db1.Execute sql1
          MsgBox "数据恢复成功！", vbInformation
         End If
    End If
    Exit Sub
sjh_error:
    If Err = 70 Then
    MsgBox "数据库正在使用，请关闭所有数据窗口，从新开始恢复", vbExclamation
    Else
    MsgBox Err.Description, vbExclamation
    End If
End Sub
Private Sub mnu_qk()
On Error GoTo my_error:
 s = MsgBox("确认清空以前的数据记录！", vbYesNo + vbQuestion, "确认")
 If s = vbYes Then
 Dim db2 As Connection
 Set db2 = New Connection
 db2.CursorLocation = adUseClient
 db2.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & fullpath("mdb\ziliao.lbl")
 string1 = "delete from book_v"
 db2.Execute string1
 string1 = "delete from bzzl_v"
 db2.Execute string1
 string1 = "delete from image_v"
 db2.Execute string1
 string1 = "delete from jy_jl"
 db2.Execute string1
 string1 = "delete from wzzl_v"
 db2.Execute string1
 string1 = "delete from xfzl_v"
 db2.Execute string1
 string1 = "delete from xfzl_xf_jl"
 db2.Execute string1
 string1 = "delete from xfzl_xh_jl"
 db2.Execute string1
 MsgBox "数据记录清空成功!", vbInformation, "提示!"
End If
Exit Sub
my_error:
 MsgBox Err.Description, vbExclamation
  
End Sub
Private Sub StatusBar1()
    sbStatusBar.Visible = Not sbStatusBar.Visible
End Sub

Private Sub Toolbar1()
    tbToolBar.Visible = Not tbToolBar.Visible
End Sub

Private Sub tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "数据备份"
     Call mnu_bfsj
Case "数据恢复"
     Call mnu_hfsj
Case "借阅管理"
     Frm_jy_gl.Show vbModal
Case "添加下发"
     Frm_tjxf.Show vbModal
Case "下发管理"
     Frm_zlxf_gl.Show vbModal
 Case "基本目录"
     Frm_node.Show vbModal
Case "基本单位"
     FrmSet_lqdw.Show vbModal
Case "借阅个人"
     FrmSet_jygr.Show vbModal
Case "用户管理"
     frmuser.Show vbModal
Case "帮助"
     Shell "hh.exe " & fullpath("html\myhelp.chm"), vbNormalFocus
Case "关于程序"
     frmAbout.Show vbModal
Case "退出"
     Unload Me
End Select
End Sub

Private Sub CoolMenu1_MenuClick(MenuItemName As String)
    With CoolMenu1
    
    Select Case MenuItemName
         Case "mnuColor1"
            .MenuBarLeftColor = vbHighlight
            .MenuBarRightColor = vbMenuBar
        Case "mnuColor2"
            .MenuBarLeftColor = vbRed
            .MenuBarRightColor = vbMenuBar
        Case "mnuColor3"
            .MenuBarLeftColor = vbRed
            .MenuBarRightColor = vbYellow