frmgroupnew.frm

OA编程 源代码

VERSION 5.00
Begin VB.Form frmGroupNew 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "添加新组"
   ClientHeight    =   4485
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7170
   Icon            =   "frmGroupNew.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4485
   ScaleWidth      =   7170
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton CmdDel 
      Caption         =   "删除  ->"
      Height          =   375
      Left            =   2940
      TabIndex        =   4
      Top             =   2970
      Width           =   1215
   End
   Begin VB.CommandButton CmdAdd 
      Caption         =   "<-  添加"
      Height          =   375
      Left            =   2940
      TabIndex        =   3
      Top             =   2370
      Width           =   1215
   End
   Begin VB.ListBox List2 
      Height          =   2400
      Left            =   4500
      MultiSelect     =   2  'Extended
      TabIndex        =   5
      Top             =   1770
      Width           =   2415
   End
   Begin VB.ListBox List1 
      Height          =   2400
      ItemData        =   "frmGroupNew.frx":08CA
      Left            =   180
      List            =   "frmGroupNew.frx":08CC
      MultiSelect     =   2  'Extended
      TabIndex        =   2
      Top             =   1770
      Width           =   2415
   End
   Begin VB.CommandButton CmdCancel 
      Caption         =   "取消"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   5880
      TabIndex        =   7
      Top             =   840
      Width           =   1035
   End
   Begin VB.CommandButton CmdOk 
      Caption         =   "确定"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   5880
      TabIndex        =   6
      Top             =   360
      Width           =   1035
   End
   Begin VB.TextBox TxtGroup 
      Height          =   375
      Left            =   1200
      TabIndex        =   1
      Top             =   360
      Width           =   3975
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "非成员:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   4620
      TabIndex        =   9
      Top             =   1410
      Width           =   735
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "成员:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   300
      TabIndex        =   8
      Top             =   1410
      Width           =   525
   End
   Begin VB.Label LblGroup 
      Caption         =   "组名:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   450
      TabIndex        =   0
      Top             =   420
      Width           =   975
   End
End
Attribute VB_Name = "frmGroupNew"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub CmdAdd_Click()
Dim i As Integer
Dim flag As Boolean
flag = False

If List2.ListCount < 1 Then Exit Sub
If List2.ListIndex >= 0 Then
Do Until flag = True
    If List2.ListCount < 1 Then Exit Sub
    For i = 0 To List2.ListCount - 1
        If List2.Selected(i) = True Then
            flag = False
            Exit For
        Else
            flag = True
        End If
    Next
    If flag = False Then
        List2.ListIndex = i
        List1.AddItem List2.Text
        List2.RemoveItem i
    End If
Loop
End If

End Sub

Private Sub CmdCancel_Click()
    Unload frmGroupNew
    
End Sub

Private Sub CmdDel_Click()
Dim i As Integer
Dim flag As Boolean
flag = False
If List1.ListCount < 1 Then Exit Sub
If List1.ListIndex >= 0 Then
Do Until flag = True
    If List1.ListCount < 1 Then Exit Sub
    For i = 0 To List1.ListCount - 1
        If List1.Selected(i) = True Then
            flag = False
            Exit For
        Else
            flag = True
        End If
    Next
    If flag = False Then
        List1.ListIndex = i
        List2.AddItem List1.Text
        List1.RemoveItem i
    End If
Loop
End If
End Sub

Private Sub CmdOk_Click()
Dim i As Integer
Dim str As String
Dim rstUserTemp As ADODB.Recordset

If Trim(TxtGroup.Text) = "" Then
    MsgBox "组名不能为空", 48, "系统提示"
    Exit Sub
End If

If lstrlen(Trim(TxtGroup.Text)) > 50 Then
    MsgBox "组名最多只能输入25个汉字!", 48, "用户管理器"
    Exit Sub
End If

If List1.ListCount < 1 Then
    MsgBox "一个组内至少应有一个成员!", 48, "系统提示"
    Exit Sub
End If
str = "select distinct groupname from groupuser where groupname='" & Trim(TxtGroup.Text) & "'"
Set RstUser = Pubsaconn.Execute(str)
If Not RstUser.EOF Then
    MsgBox "用户组已存在,请重新输入!", 48, "用户组管理"
    Exit Sub
End If
Set rstUserTemp = New ADODB.Recordset
For i = 1 To List1.ListCount
    List1.ListIndex = i - 1
    str = "select distinct username,deparment_c,username_c,password,phoneNo from groupuser where username='" & List1.Text & "'"
    Set RstUser = Pubsaconn.Execute(str)
    str = "insert into groupuser (groupname,username,deparment_C,username_c,password,phoneno ,arrangeorder,tagpsw,field1) values ('" & Trim(TxtGroup.Text) & "','"
    str = str & RstUser(0) & "','" & RstUser(1) & "','" & RstUser(2) & "','"
    str = str & RstUser(3) & "','" & RstUser(4) & "',0,'','')"
    Set rstUserTemp = Pubsaconn.Execute(str)
    RstUser.Close
Next
Set rstUserTemp = Nothing
Unload Me

End Sub

Private Sub Form_Load()
    Dim str As String
    Dim i As Integer
    'List1.AddItem "Administrator", 0
    'List1.Selected(0) = True
    str = "select distinct username from groupuser"
    Set RstUser = Pubsaconn.Execute(str)
    Do Until RstUser.EOF
        For i = 0 To RstUser.Fields.Count - 1
            List2.AddItem RstUser("username"), i
        Next
        RstUser.MoveNext
    Loop
        '换皮肤
    Call LoadSkin(Me)
End Sub

Private Sub Form_Unload(Cancel As Integer)
SetGride frmUserMain.GrdUser, frmUserMain.GrdGroup
End Sub