frmmain.frm

朋友给的

         Enabled         =   0   'False
      End
      Begin VB.Menu mnuMnuE3 
         Caption         =   "参数设置"
         Enabled         =   0   'False
      End
      Begin VB.Menu mnuMnuE4 
         Caption         =   "数据备份"
         Enabled         =   0   'False
      End
      Begin VB.Menu mnuMnuE5 
         Caption         =   "数据恢复"
         Enabled         =   0   'False
      End
      Begin VB.Menu mnuMnuE6 
         Caption         =   "注销"
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub MDIForm_Load()
    StatusBar1.Panels(2).Text = "上海泽安保险代理" 'gUnit
    StatusBar1.Panels(6).Text = gUser_Name
'===========菜单选项===============
Dim i As Integer
Dim rs As New ADODB.Recordset
Dim strS As String
Set rs = New ADODB.Recordset
    rs.Open "select 菜单名称_E from qxlb where 用户代码='" & gUser & "'", gCnn, adOpenStatic, adLockReadOnly
    For i = 0 To rs.RecordCount - 1
        strS = Trim(rs.Fields(0))
        If strS = "mnuMnuA1" Then: frmMain.mnuMnuA1.Enabled = True
        'If strS = "mnuMnuA2" Then: frmMain.mnuMnuA2.Enabled = True
        If strS = "mnuMnuA4" Then: frmMain.mnuMnuA4.Enabled = True
        If strS = "mnuMnuA6" Then: frmMain.mnuMnuA6.Enabled = True
        If strS = "mnuMnuA7" Then: frmMain.mnuMnuA7.Enabled = True
        If strS = "mnuMnuA8" Then: frmMain.mnuMnuA8.Enabled = True
        If strS = "mnuMnuA9" Then: frmMain.mnuMnuA9.Enabled = True
        If strS = "mnuMnuA10" Then: frmMain.mnuMnuA10.Enabled = True
        If strS = "mnuMnuA11" Then: frmMain.mnuMnuA11.Enabled = True
        If strS = "mnuMnuA14" Then: frmMain.mnuMnuA14.Enabled = True
        If strS = "mnuMnuA15" Then: frmMain.mnuMnuA15.Enabled = True
        If strS = "mnuMnuA16" Then: frmMain.mnuMnuA16.Enabled = True
        If strS = "mnuMnuA17" Then: frmMain.mnuMnuA17.Enabled = True
        
        
        
        If strS = "mnuMnuB1" Then: frmMain.mnuMnuB1.Enabled = True
        If strS = "mnuMnuB2" Then: frmMain.mnuMnuB2.Enabled = True
        If strS = "mnuMnuB3" Then: frmMain.mnuMnuB3.Enabled = True
        If strS = "mnuMnuB4" Then: frmMain.mnuMnuB4.Enabled = True
        
        
        
        
        If strS = "mnuMnuC1" Then: frmMain.mnuMnuC1.Enabled = True
        If strS = "mnuMnuC2" Then: frmMain.mnuMnuC2.Enabled = True
        If strS = "mnuMnuC3" Then: frmMain.mnuMnuC3.Enabled = True
        
        
        
        
        If strS = "mnuMnuD1" Then: frmMain.mnuMnuD1.Enabled = True
        If strS = "mnuMnuD2" Then: frmMain.mnuMnuD2.Enabled = True
        If strS = "mnuMnuD3" Then: frmMain.mnuMnuD3.Enabled = True
        
        
        If strS = "mnuMnuE1" Then: frmMain.mnuMnuE1.Enabled = True
        If strS = "mnuMnuE2" Then: frmMain.mnuMnuE2.Enabled = True
        If strS = "mnuMnuE3" Then: frmMain.mnuMnuE3.Enabled = True
        If strS = "mnuMnuE4" Then: frmMain.mnuMnuE4.Enabled = True
        If strS = "mnuMnuE5" Then: frmMain.mnuMnuE5.Enabled = True
        If strS = "mnuMnuE7" Then: frmMain.mnuMnuE7.Enabled = True
        If strS = "mnuMnuE8" Then: frmMain.mnuMnuE8.Enabled = True
        If strS = "mnuMnuE9" Then: frmMain.mnuMnuE9.Enabled = True
        
        If strS = "mnuMnuF1" Then: frmMain.mnuMnuF1.Enabled = True
        If strS = "mnuMnuF2" Then: frmMain.mnuMnuF2.Enabled = True
        If strS = "mnuMnuF3" Then: frmMain.mnuMnuF3.Enabled = True
        If strS = "mnuMnuF4" Then: frmMain.mnuMnuF4.Enabled = True
        If strS = "mnuMnuF5" Then: frmMain.mnuMnuF5.Enabled = True
        If strS = "mnuMnuF6" Then: frmMain.mnuMnuF6.Enabled = True
        If strS = "mnuMnuF8" Then: frmMain.mnuMnuF8.Enabled = True
        If strS = "mnuMnuF7" Then: frmMain.mnuMnuF7.Enabled = True
        If strS = "mnuMnuF9" Then: frmMain.mnuMnuF9.Enabled = True
        
        
        
        
        
        
        
        rs.MoveNext
    Next
    
End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim i As Integer
    If MsgBox("您要退出当前系统吗？", vbYesNo + vbInformation, "退出系统") = vbNo Then
        Cancel = True
        blnLogout = False
    Else
        blnLogout = True
        For i = Forms.count - 1 To 0 Step -1
            Unload Forms(i)
        Next
    End If
End Sub

Private Sub mnuMnuA1_Click()
    frmBXGXGL.Show
   ' frmywgl.Show
End Sub

Private Sub mnuMnuA12_Click()
    frmDZLY.Show
End Sub

Private Sub mnuMnuA13_Click()
    frmDZFF.Show
End Sub

Private Sub mnuMnuA14_Click()
        gStlx = "T_单证发放"
    frmQuery.Show

End Sub

Private Sub mnuMnuA15_Click()
    frmGRCBKH.Show
End Sub

Private Sub mnuMnuA16_Click()
        frmQYCBKH.Show

End Sub

Private Sub mnuMnuA17_Click()
    gStlx = "viewbd1"
    frmQuery.Show
End Sub

Private Sub mnuMnuA2_Click()
    'frmSELECTKH.Show
    'frmYWEDIT.Show
End Sub

Private Sub mnuMnuA4_Click()
frmYWEDIT.Show
'frmbdysyf.Show
End Sub

Private Sub mnuMnuA5_Click()
    'frmBXGXGL.Show
End Sub

Private Sub mnuMnuA6_Click()
    gStlx = "viewtbgr"
    frmQuery.Show
End Sub

Private Sub mnuMnuA7_Click()
    gStlx = "viewtbqy"
    frmQuery.Show

End Sub

Private Sub mnuMnuA8_Click()
    gStlx = "viewbxgs"
    frmQuery.Show

End Sub

Private Sub mnuMnuA9_Click()
    gStlx = "viewbd"
    frmQuery.Show
End Sub

Private Sub mnuMnuB1_Click()
    
    frmGRKH.Show
End Sub

Private Sub mnuMnuB2_Click()
    frmTDKH.Show
End Sub

Private Sub mnuMnuB3_Click()
    frmTDZGKH.Show
End Sub

Private Sub mnuMnuB4_Click()
    frmGzxz.Show
End Sub

Private Sub mnuMnuC1_Click()
    frmYGXXGL.Show
End Sub

Private Sub mnuMnuC2_Click()
    frmKQ.Show
End Sub

Private Sub mnuMnuC3_Click()
    gStlx = "VIEWYGXX"
    frmQuery.Show
End Sub

Private Sub mnuMnuD1_Click()
    frmcwys.Show
End Sub

Private Sub mnuMnuD2_Click()
    frmCWYF.Show
End Sub

Private Sub mnuMnuD3_Click()
    frmCBHS1.Show
End Sub

Private Sub mnuMnuE1_Click()
    frmTDGL.Show
End Sub

Private Sub mnuMnuE2_Click()
    frmUser.Show
End Sub

Private Sub mnuMnuE3_Click()
    frmInit.Show
End Sub

Private Sub mnuMnuE4_Click()
    Call BackUpBase

End Sub

Private Sub mnuMnuE5_Click()
    Call RestoreBase

End Sub

Private Sub mnuMnuE6_Click()
    Dim i As Long
    For i = Forms.count - 1 To 0 Step -1
        If i > 0 Then
            Unload Forms(i)
        Else
            
        End If
    Next
    If blnLogout Then frmLogin.Show vbModal
End Sub

Private Sub mnuMnuE7_Click()
    frmYWLBSZ.Show
End Sub

Private Sub mnuMnuE8_Click()
    frmBMGL.Show
End Sub

Private Sub mnuMnuE9_Click()
    frmKHSZ.Show
End Sub

Private Sub mnuMnuF1_Click()
    sjstate = 2
    frmSJedit.Show

End Sub

Private Sub mnuMnuF2_Click()
    frmSJGL.Show
End Sub

Private Sub mnuMnuF3_Click()
    frmQYCBKHEDIT.Show
End Sub

Private Sub mnuMnuF4_Click()
    frmGRZKHEDIT.Show
End Sub

Private Sub mnuMnuF5_Click()
    frmSRTX.Show
End Sub

Private Sub mnuMnuF6_Click()
    frmJHSADD.Show
End Sub

Private Sub mnuMnuF8_Click()
    gStlx = "viewqy"
    frmQuery.Show

End Sub

Private Sub mnuMnuF9_Click()
    gStlx = "viewgr"
    frmQuery.Show

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "tolJsq"
            Shell "calc.exe shell32.dll", vbNormalFocus
        Case "tolNote"
            Shell "notepad.exe", vbNormalFocus
        Case "tolExit"
            Unload Me
    End Select
End Sub
Public Sub BackUpBase()
Dim strFileName As String
Dim fso As New FileSystemObject
On Error Resume Next
   
    If Forms.count > 2 Then MsgBox "请关闭所有在用窗体，数据备份时必须保证没有人在使用数据库！", vbCritical, "系统提示": Exit Sub
    If MsgBox("你确定要备份现有数据库吗？", vbInformation + vbOKCancel, "系统提示") = vbCancel Then Exit Sub
    strFileName = App.Path & "\Working.avi"
'    If Not fso.FileExists(strFileName) Then MsgBox "动画文件(Working.avi)不存在！", vbCritical, "系统提示": Exit Sub
    
    StatusBar1.Panels(2) = "正在备份数据库，需要几分钟时间，请梢候......"
    frmProcBar.Caption = "数据库备份"
    frmProcBar.Show
    frmProcBar.Animation1.Open strFileName
    frmProcBar.Animation1.Play
    DoEvents
    
    gCnn.Execute "BackUp DataBase jxsdatabase To Disk='d:\ComputerBase' with Init"
    Sleep 1000
    
    frmProcBar.Animation1.Close
    Unload frmProcBar
    MsgBox "数据库备份成功，备份数据保存在服务器的“D：\ComputerBase”中！", vbInformation, "系统提示"
    Set fso = Nothing
    StatusBar1.Panels(2) = "数据库备份完毕！"

End Sub

Public Sub RestoreBase()
Dim strFileName As String
Dim fso As New FileSystemObject
On Error GoTo errlabell
    If Forms.count > 2 Then MsgBox "请关闭所有在用窗体，数据恢复时必须保证没有人在使用数据库！", vbCritical, "系统提示": Exit Sub
    If MsgBox("你确定要恢复数据库改变现有数据吗？", vbInformation + vbOKCancel, "系统提示") = vbCancel Then Exit Sub
    strFileName = App.Path & "\Working.avi"
    If Not fso.FileExists(strFileName) Then MsgBox "动画文件(Working.avi)不存在！", vbCritical, "系统提示": Exit Sub
    
    StatusBar1.Panels(2) = "正在恢复数据库，需要几分钟时间，请梢候......"
    frmProcBar.Caption = "数据库恢复"
    frmProcBar.Show
    frmProcBar.Animation1.Open strFileName
    frmProcBar.Animation1.Play
    DoEvents
   
    gCnn.Execute "Use Master"
    gCnn.Execute "Restore DataBase jxsdatabase from Disk='d:\ComputerBase' "
    gCnn.Execute "Use " & clsCnt.Database
    
    frmProcBar.Animation1.Close
    Unload frmProcBar
    StatusBar1.Panels(2) = "数据库恢复完毕！"
    Set fso = Nothing
    Exit Sub
errlabell:
    MsgBox "数据库恢复失败，数据库可能已损坏，请与管理员联系！" & Err.Description, vbCritical, "严重错误"
    
    StatusBar1.Panels(2) = "数据库恢复失败，数据库可能已损坏，请与管理员联系！" & Err.Description
    Unload frmProcBar

End Sub