form_main.frm

宇迪ｅｒｐ,企业erp模块一

      End
      Begin VB.Menu P 
         Caption         =   "套帐属性"
      End
      Begin VB.Menu Del 
         Caption         =   "删除套帐"
      End
      Begin VB.Menu ssd 
         Caption         =   "-"
      End
      Begin VB.Menu Bak 
         Caption         =   "备份"
         Shortcut        =   ^B
      End
      Begin VB.Menu Restore 
         Caption         =   "恢复"
      End
      Begin VB.Menu ctj 
         Caption         =   "-"
      End
      Begin VB.Menu Cjuser 
         Caption         =   "创建数据库用户"
      End
   End
   Begin VB.Menu TZ 
      Caption         =   "套帐(&A)"
      Begin VB.Menu Setup 
         Caption         =   "设置"
         Shortcut        =   ^S
      End
      Begin VB.Menu Start 
         Caption         =   "启用"
      End
      Begin VB.Menu sds 
         Caption         =   "-"
      End
      Begin VB.Menu User 
         Caption         =   "用户"
         Shortcut        =   ^U
      End
      Begin VB.Menu log 
         Caption         =   "上机日志"
      End
   End
   Begin VB.Menu BZ 
      Caption         =   "帮助(&H)"
      Begin VB.Menu Help 
         Caption         =   "帮助主题"
      End
      Begin VB.Menu dfg 
         Caption         =   "-"
      End
      Begin VB.Menu about 
         Caption         =   "关于"
         Shortcut        =   ^A
      End
   End
End
Attribute VB_Name = "Form_main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mitem As ListItem

Private Sub about_Click()
    XT_frmAbout.Show 1
End Sub

Private Sub Bak_Click()
    If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
    Frm_Bakdatabase.Text1.Tag = List_data.SelectedItem.SubItems(2)
    Frm_Bakdatabase.Text2.Text = List_data.SelectedItem.SubItems(2)
    Frm_Bakdatabase.Caption = "套帐备份---" & List_data.SelectedItem.SubItems(1)
    Frm_Bakdatabase.Show 1
End Sub

Private Sub cjuser_Click()
    On Error Resume Next
    Conn_System.Execute "EXEC sp_addlogin 'HXXD', '123'"
    Conn_System.Execute "EXEC sp_addsrvrolemember 'HXXD', 'sysadmin'"
    If Trim(Err.Description) = "" Then
       MsgBox "创建成功！  ", 48
       Else
       MsgBox Err.Description, 16
    End If
End Sub

Private Sub Del_Click()
    If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
    YesNoStr = MsgBox("你是否要删除编号为(" & List_data.SelectedItem.Text & ")的套帐！  ", vbYesNo + 32)
    If YesNoStr = vbNo Then Exit Sub
    Dele_CountingRoom List_data.SelectedItem.Key
End Sub

Private Sub Edit_Click()
    Frm_Password.Show 1
End Sub

Private Sub Exit_Click()
    Unload Me
End Sub

Public Sub Form_Load()
    On Error Resume Next
    Dim aDo_DataBase As New Recordset
    Set aDo_DataBase = Conn_System.Execute("select * from HDSystem_DataBases")
     List_data.ListItems.Clear
    With aDo_DataBase
    Do While Not .EOF
        Set mitem = List_data.ListItems.Add()
        mitem.Text = !Number
        mitem.SmallIcon = "l"
        mitem.Icon = "l"
        mitem.SubItems(1) = !CountingRoomName
        mitem.SubItems(2) = !DataBasesName
        mitem.SubItems(3) = !NewDate
        mitem.SubItems(4) = "" & !BackupDate
        mitem.SubItems(5) = Trim("" & !ServerName)
        mitem.SubItems(6) = Trim("" & !DatabaseType)
        mitem.Key = !DataBasesName
       
        .MoveNext
    Loop
    .Close
    Set aDo_DataBase = Nothing
    End With
End Sub

Private Sub Help_Click()
    MsgBox "帮助文档正在整理中……", vbExclamation, "南通易博科技资讯"
End Sub

Private Sub log_Click()
    If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
    Frm_Log.Tag = List_data.SelectedItem.SubItems(2)
    Frm_Log.Caption = Frm_Log.Caption & "---" & List_data.SelectedItem.SubItems(1)
    Frm_Log.Show 1
End Sub

Private Sub NewDatabase_Click()
    Frm_Newdatabase.Show 1
End Sub

Private Sub P_Click()
     If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
    With Frm_Newdatabase
     .Text1(0).Enabled = False: .Text1(1).Enabled = False: .Text1(2).Enabled = False: .Text1(3).Enabled = False
     .Text2(0).Enabled = False: .Text2(1).Enabled = False: .Text2(2).Enabled = False
     .Text1(0).Text = List_data.SelectedItem.Text
     .Text1(1).Text = List_data.SelectedItem.SubItems(1)
     .Text1(2).Text = List_data.SelectedItem.SubItems(2)
     .Command1(0).Enabled = False
     .Command2.Enabled = False
     .Text1(3).Text = ""
     .Show 1
    End With
End Sub

Private Sub Refresh_Click()
    Form_Load
End Sub

Private Sub Restore_Click()
    Frm_RestoerDatabase.Show 1
End Sub

Private Sub Setup_Click()
   If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
  Frm_DateCoInfo.Text1(0).Tag = List_data.SelectedItem.SubItems(2)
  Frm_DateCoInfo.Caption = Frm_DateCoInfo.Caption & "---" & List_data.SelectedItem.SubItems(1)
  Frm_DateCoInfo.Show 1
End Sub

Private Sub Start_Click()
On Error Resume Next
    If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
    Dim Ssql  As String
    Dim aDo_Rows As New Recordset
    
    YesNoStr = MsgBox("你是否要启用此套帐?  ", vbYesNo + 32)
    If YesNoStr = vbNo Then Exit Sub
    Ssql = "select * from HDSystem_DataBases where DataBasesName='" & List_data.SelectedItem.SubItems(2) & "'"
    Set aDo_Rows = Conn_System.Execute(Ssql)
    If Trim("" & aDo_Rows!YNUse) = "1" Then MsgBox "套帐已经在使用! ", 16: aDo_Rows.Close: Set aDo_Rows = Nothing: Exit Sub
    If Trim("" & aDo_Rows!CoName) = "" Then MsgBox "套帐设置公司名称错误,套帐不能被启用! ", 16: aDo_Rows.Close: Set aDo_Rows = Nothing: Exit Sub
    aDo_Rows.Close
    
    Ssql = "select * from " & List_data.SelectedItem.SubItems(2) & ".dbo.Gy_kjrlb"
    Set aDo_Rows = Conn_System.Execute(Ssql)
    aDo_Rows.Close: Set aDo_Rows = Nothing
    
    Ssql = "update HDSystem_DataBases set YNuse='1' where DataBasesName='" & List_data.SelectedItem.SubItems(2) & "'"
    Conn_System.Execute Ssql
    MsgBox "套帐启用成功! ", 48
End Sub

Private Sub Tool_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
       Case "New"
       
            Frm_Newdatabase.Show 1
            
       Case "Property"
             If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
           With Frm_Newdatabase
            .Text1(0).Enabled = False: .Text1(1).Enabled = False: .Text1(2).Enabled = False: .Text1(3).Enabled = False
            .Text2(0).Enabled = False: .Text2(1).Enabled = False: .Text2(2).Enabled = False
            .Text1(0).Text = List_data.SelectedItem.Text
            .Text1(1).Text = List_data.SelectedItem.SubItems(1)
            .Text1(2).Text = List_data.SelectedItem.SubItems(2)
            .Command1(0).Enabled = False
            .Command2.Enabled = False
            .Text1(3).Text = ""
            .Show 1
           End With
       Case "Bak"
             If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
            Frm_Bakdatabase.Text1.Tag = List_data.SelectedItem.SubItems(2)
            Frm_Bakdatabase.Text2.Text = List_data.SelectedItem.SubItems(2)
            Frm_Bakdatabase.Caption = "套帐备份---" & List_data.SelectedItem.SubItems(1)
            Frm_Bakdatabase.Show 1
       Case "Del"
             If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
            YesNoStr = MsgBox("你是否要删除编号为(" & List_data.SelectedItem.Text & ")的套帐！  ", vbYesNo + 32)
            If YesNoStr = vbNo Then Exit Sub
            Dele_CountingRoom List_data.SelectedItem.Key
       Case "Restore"
             Frm_RestoerDatabase.Show 1
       Case "Setup"
               If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
             Frm_DateCoInfo.Text1(0).Tag = List_data.SelectedItem.SubItems(2)
             Frm_DateCoInfo.Caption = Frm_DateCoInfo.Caption & "---" & List_data.SelectedItem.SubItems(1)
             
             Frm_DateCoInfo.Show 1
       Case "User"
              If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
             Frm_GroupUser.Caption = Frm_GroupUser.Caption & "---" & List_data.SelectedItem.SubItems(1)
             Frm_GroupUser.ListView1.Tag = List_data.SelectedItem.SubItems(2)
             Frm_GroupUser.Show 1
       Case "Start"
             Start_Click
       Case "Exit"
            Unload Me
End Select
End Sub

Private Sub User_Click()
    If List_data.ListItems.Count <= 0 Then MsgBox "请选中一个套帐！  ", 16: Exit Sub
    Frm_GroupUser.Caption = Frm_GroupUser.Caption & "---" & List_data.SelectedItem.SubItems(1)
    Frm_GroupUser.ListView1.Tag = List_data.SelectedItem.SubItems(2)
    Frm_GroupUser.Show 1
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    List_data.Width = Me.Width - 100
    List_data.Height = Me.Height - Tool.Height - StatusBar.Height - 680
End Sub

Private Sub Dele_CountingRoom(DataBaseName As String)
    On Error GoTo Exit_err
        Class.StatusBar "正在删除套帐信息...", False
        Me.MousePointer = 12
        Conn_System.Execute "Drop Database " & DataBaseName
        Conn_System.Execute "delete HDSystem_DataBases where DataBasesName='" & DataBaseName & "'"
        Form_Load
        Class.StatusBar "", True
        Me.MousePointer = 0
        Exit Sub
    
Exit_err:
    Form_Load
    Class.StatusBar "", True
    Me.MousePointer = 0
    MsgBox Err.Description & "(" & Err.Number & ")", 16
End Sub