frmsuper.frm

这是一个Web短信平台后台部分中的预付费管理系统,采用SQL Server数据库,主要是对短信服务的注册用户进得后台充值预付费管理。用到了第三方控件 VideoSoft Active Controls

      BackColorBkg    =   8421504
      BackColorAlternate=   -2147483643
      GridColor       =   -2147483633
      GridColorFixed  =   -2147483632
      TreeColor       =   -2147483632
      FloodColor      =   192
      SheetBorder     =   -2147483642
      FocusRect       =   1
      HighLight       =   1
      AllowSelection  =   -1  'True
      AllowBigSelection=   -1  'True
      AllowUserResizing=   0
      SelectionMode   =   0
      GridLines       =   1
      GridLinesFixed  =   2
      GridLineWidth   =   1
      Rows            =   5000
      Cols            =   10
      FixedRows       =   1
      FixedCols       =   0
      RowHeightMin    =   0
      RowHeightMax    =   0
      ColWidthMin     =   0
      ColWidthMax     =   0
      ExtendLastCol   =   0   'False
      FormatString    =   ""
      ScrollTrack     =   0   'False
      ScrollBars      =   3
      ScrollTips      =   0   'False
      MergeCells      =   0
      MergeCompare    =   0
      AutoResize      =   -1  'True
      AutoSizeMode    =   0
      AutoSearch      =   0
      MultiTotals     =   -1  'True
      SubtotalPosition=   1
      OutlineBar      =   0
      OutlineCol      =   0
      Ellipsis        =   0
      ExplorerBar     =   0
      PicturesOver    =   0   'False
      FillStyle       =   0
      RightToLeft     =   0   'False
      PictureType     =   0
      TabBehavior     =   0
      OwnerDraw       =   0
      Editable        =   0   'False
      ShowComboButton =   -1  'True
      WordWrap        =   0   'False
      TextStyle       =   0
      TextStyleFixed  =   0
      OleDragMode     =   0
      OleDropMode     =   0
      DataMode        =   0
      VirtualData     =   -1  'True
   End
End
Attribute VB_Name = "frmSuper"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************
'*    模 块 名 称 :管理员管理
'*    功 能 描 述 :
'*    程序员姓名  :谭怀志
'*    最后修改人  :谭怀志
'*    最后修改时间:2003/6/26
'*    备        注:
'*******************************************************

Option Explicit

Private Sub Form_Load()
    
    On Error GoTo VBError
    
    '初始化网格
    With Gridbrowser
     
        .RowHeight(0) = 350
        .ColAlignment(0) = flexAlignLeftCenter
        .Cols = 3
        .FixedRows = 1
        .SelectionMode = flexSelectionListBox
        .AllowUserResizing = flexResizeColumns
        .ExplorerBar = flexExSort
        
        .ColWidth(0) = 1500
        .ColWidth(1) = 3000
        
        .TextMatrix(0, 0) = "管理员ID"
        .TextMatrix(0, 1) = "管理员姓名"
        .TextMatrix(0, 2) = ""

        .ColHidden(2) = True
        
        .Rows = .FixedRows
        .Redraw = False
        
    End With
    
    On Error GoTo ADOError
    
    '显示所有管理员
    strQry = "select * from JFoperator"
    Set rstCustomers = GetRecordSet(cnnConnection, strQry)
    
    While Not rstCustomers.EOF
        
        With Gridbrowser
            
            .AddItem ""
            .RowHeight(.Rows - 1) = 350
            .TextMatrix(.Rows - 1, 0) = rstCustomers!OperID
            .TextMatrix(.Rows - 1, 1) = rstCustomers!Name
            .TextMatrix(.Rows - 1, 2) = Cipher(CODEPASSWORD, rstCustomers!password)
            
        End With
        
        rstCustomers.MoveNext
        
    Wend
    
    Gridbrowser.Redraw = True
    
    Exit Sub
    
VBError:
    DisplayVBError
    Exit Sub
ADOError:
    DisplayADOError cnnConnection

End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)

    Dim i As Long
    
    On Error GoTo VBError
    
    Select Case Button.Key
    Case "add"
        
        '新增管理员
        Load frmSuperEdit
        frmSuperEdit.Tag = "AddNew"
        frmSuperEdit.Show vbModal
        
    Case "modify"
    
        '修改管理员
        If Gridbrowser.TextMatrix(Gridbrowser.RowSel, 0) <> "" And Gridbrowser.RowSel > 0 Then
        
            If Gridbrowser.TextMatrix(Gridbrowser.RowSel, 0) <> strOperatorID Then
                MsgBox "禁止修改其它管理员的资料！", vbCritical, ERRCAPTION
                Exit Sub
            End If
            
            Load frmSuperEdit
            
            With Gridbrowser
            
                frmSuperEdit.Tag = "Modify"
                frmSuperEdit!txtOperID.Text = .TextMatrix(.RowSel, 0)
                frmSuperEdit!txtName.Text = .TextMatrix(.RowSel, 1)
                frmSuperEdit!txtFirstPass.Text = .TextMatrix(.RowSel, 2)
                frmSuperEdit!txtSecPass.Text = .TextMatrix(.RowSel, 2)
            
            End With
            
            frmSuperEdit.Show vbModal
            
        End If
        
    Case "del"
        
        '删除管理员
        On Error GoTo ADOError
        
        '无选中项目时退出子过程
        If Gridbrowser.TextMatrix(Gridbrowser.RowSel, 0) = "" Or Gridbrowser.RowSel < 1 Then
            Exit Sub
        End If
        
        If MsgBox("确定删除所选的管理员吗？", vbOKCancel + vbDefaultButton2, SYSCAPTION) = vbNo Then
            Exit Sub
        End If
            
        For i = Gridbrowser.Rows - 1 To 1 Step -1
                
            If Gridbrowser.IsSelected(i) Then
                    
                If Gridbrowser.TextMatrix(i, 0) = strOperatorID Then
                
                    '当前管理员不允许删除
                    MsgBox "当前管理员不能删除！", vbCritical, ERRCAPTION
                Else
                    strQry = "select OperID from RFDorig where OperID='" & Gridbrowser.TextMatrix(i, 0) & "'"
                    Set rstCustomers = GetRecordSet(cnnConnection, strQry)
                            
                    If rstCustomers.RecordCount <> 0 Then
                    
                        '已经使用的管理员不能删除
                        MsgBox "不能删除已经使用的管理员！", vbCritical, ERRCAPTION
                    Else
                        cnnConnection.Execute ("delete from JFoperator where OperID='" & Gridbrowser.TextMatrix(i, 0) & "'")
                        Gridbrowser.RemoveItem i
                    End If
                            
                End If
                        
            End If
                    
        Next i
        
    Case "close"
    
        Unload Me
        
    End Select
    
    Exit Sub
    
VBError:
    DisplayVBError
    Exit Sub
ADOError:
    DisplayADOError cnnConnection
        
End Sub