form_newuser.frm

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

      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "组名:"
         Height          =   180
         Index           =   0
         Left            =   -74760
         TabIndex        =   3
         Top             =   630
         Width           =   450
      End
   End
End
Attribute VB_Name = "Frm_NewUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Group_ID As Integer
Dim TF As Boolean
Dim Item2czbm(): Dim Item1czbm()
Private Sub Command1_Click(Index As Integer)
On Error GoTo error_exit

Dim Ssql As String
Dim i As Integer
If Index = 1 Then Unload Me: Exit Sub

If Me.Tag = "G" Or Me.Tag = "GE" Then
        Dim aDo_GroupRow As New Recordset
        If Trim(Text2(0).Text) = "" Then MsgBox "组名不能为空!   ", 16: Text2(0).SetFocus: Exit Sub
        If Me.Tag = "G" Then
           Set aDo_GroupRow = Conn_System.Execute("select * from " & SSTab.Tag & ".dbo.System_UserGroup where GroupName='" & Trim(Text2(0).Text) & "'")
           If aDo_GroupRow.RecordCount > 0 Then MsgBox "组名不能重复!   ", 16: Exit Sub
        Else
          Set aDo_GroupRow = Conn_System.Execute("select * from " & SSTab.Tag & ".dbo.System_UserGroup where GroupName='" & Trim(Text2(0).Text) & "'" _
                                               & " and  GroupName<>'" & Text2(0).Tag & "'")
          If aDo_GroupRow.RecordCount > 0 Then MsgBox "组名不能重复!   ", 16: Exit Sub
        End If


       Select Case Me.Tag
           Case "G"
                Conn_System.Execute "insert into " & SSTab.Tag & ".dbo.System_UserGroup(GroupName,Explain) " _
                         & "VALUES('" & Trim(Text2(0).Text) & "','" & Trim(Text2(1).Text) & "')"
                
                Dim aDo_Groupid As New Recordset
                
                Set aDo_Groupid = Conn_System.Execute("select * from " & SSTab.Tag & ".dbo.System_UserGroup " _
                              & " WHERE GroupName='" & Trim(Text2(0).Text) & "'")
                Group_ID = aDo_Groupid!Groupid
                aDo_Groupid.Close
                Set aDo_Groupid = Nothing
                
           Case "GE"
                Ssql = "UPDATE " & SSTab.Tag & ".dbo.System_UserGroup " _
                                    & "SET GroupName='" & Trim(Text2(0).Text) & "',Explain='" & Trim(Text2(1).Text) & "'" _
                                    & " WHERE GroupName='" & Text2(0).Tag & "'"
                Conn_System.Execute Ssql
            '-----------------
    End Select
    '-----------------
    
     Conn_System.Execute "delete " & SSTab.Tag & ".dbo.System_UserGroupInfo where GroupId=" & Group_ID
    For i = 0 To List1.ListCount - 1
        Conn_System.Execute "insert into " & SSTab.Tag & ".dbo.System_UserGroupInfo(GroupId,UserId)VALUES(" & Group_ID & ",'" & Item1czbm(i) & "')"
    Next
    
    Frm_GroupUser.UserGroupName = Trim(Text2(0).Text)
    Frm_GroupUser.Explain = Trim(Text2(1).Text)
    
End If
 '-----------------

If Me.Tag = "U" Or Me.Tag = "UE" Then
   Dim User_id As String
   If Trim(Text1(0).Text) = "" Then MsgBox "用户名不能为空!   ", 16: Text1(0).SetFocus: Exit Sub
   If Trim(Text1(1).Text) <> Trim(Text1(2).Text) Then MsgBox "口令验证错误!  ", 16: Text1(2).SetFocus: Exit Sub
   Dim aDo_UserRows As New Recordset
    If Me.Tag = "U" Then
      Set aDo_UserRows = Conn_System.Execute("select * from " & SSTab.Tag & ".dbo.Gy_Czygl where czymc='" & Trim(Text1(0).Text) & "'")
      If aDo_UserRows.RecordCount > 0 Then MsgBox "用户名不能重复!  ", 16: Text1(0).SetFocus: Exit Sub
      Frm_GroupUser.UserId = Trim(UserCode.Text)
      User_id = Trim(UserCode.Text)
      aDo_UserRows.Close
      Ssql = "insert into " & SSTab.Tag & ".dbo.Gy_Czygl(czybm,czymc,czmm,Explain) VALUES('" _
             & User_id & "','" & Trim(Text1(0).Text) & "','" & Mmjm(Trim(Text1(1).Text)) & "','" & Trim(Text1(3).Text) & "')"
      Conn_System.Execute Ssql

    '---------------------
    Else
   
      Set aDo_UserRows = Conn_System.Execute("select * from " & SSTab.Tag & ".dbo.Gy_Czygl where czymc='" & Trim(Text1(0).Text) & "' and czybm<>'" & Mid(Text1(0).Tag, 2, Len(Text1(0).Tag)) & "'")
      If aDo_UserRows.RecordCount > 0 Then MsgBox "用户名不能重复!  ", 16: Text1(0).SetFocus: Exit Sub
      If Text1(2).Tag = "T" Then
         Ssql = "update " & SSTab.Tag & ".dbo.Gy_Czygl set czymc='" & Trim(Text1(0).Text) & "',czmm='" & Mmjm(Trim(Text1(1).Tag)) & "',explain='" & Trim(Text1(3).Text) _
                & "' where czybm='" & Mid(Text1(0).Tag, 2, Len(Text1(0).Tag)) & "'"
         Else
         Ssql = "update " & SSTab.Tag & ".dbo.Gy_Czygl set czymc='" & Trim(Text1(0).Text) & "',explain='" & Trim(Text1(3).Text) _
                & "' where czybm='" & Mid(Text1(0).Tag, 2, Len(Text1(0).Tag)) & "'"
      End If
      Conn_System.Execute Ssql
      User_id = Mid(Text1(0).Tag, 2, Len(Text1(0).Tag))
    End If
    Conn_System.Execute "delete " & SSTab.Tag & ".dbo.System_UserGroupInfo where UserId='" & User_id & "'"
    For i = 0 To List3.ListCount - 1
        Conn_System.Execute "insert into " & SSTab.Tag & ".dbo.System_UserGroupInfo(GroupId,UserId)VALUES(" & List3.ItemData(i) & ",'" & User_id & "')"
    Next
    
    
    Frm_GroupUser.UserGroupName = Trim(Text1(0).Text)
    Frm_GroupUser.Explain = Trim(Text1(3).Text)
End If
           


Unload Me
Exit Sub

error_exit:
If Err.Number = -2147217873 Then MsgBox "编码不能重复！  ", 16: Exit Sub
MsgBox Err.Description, 16
End Sub

Private Sub Command2_Click(Index As Integer)
Dim i As Integer
Select Case Index
    Case 0
        If List2.ListIndex > -1 Then
            List1.AddItem List2.Text
            Item1czbm(List1.ListCount - 1) = Item2czbm(List2.ListIndex)
            For i = List2.ListIndex To List2.ListCount - 1
                Item2czbm(i) = Item2czbm(i + 1)
            Next i
            List2.RemoveItem (List2.ListIndex)
            
        End If
    Case 1
        If List1.ListIndex > -1 Then
            List2.AddItem List1.Text
            Item2czbm(List2.ListCount - 1) = Item1czbm(List1.ListIndex)
            For i = List1.ListIndex To List1.ListCount - 1
                Item1czbm(i) = Item1czbm(i + 1)
            Next i
            List1.RemoveItem (List1.ListIndex)
        End If
   Case 2
        For i = 0 To List2.ListCount - 1
            List2.ListIndex = i
            List1.AddItem List2.Text
            Item1czbm(List1.ListCount - 1) = Item2czbm(i)
        Next
        List2.Clear
   Case 3
        
        For i = 0 To List1.ListCount - 1
            List1.ListIndex = i
            List2.AddItem List1.Text
            Item2czbm(List2.ListCount - 1) = Item1czbm(i)
        Next
        List1.Clear
End Select

End Sub

Private Sub Command3_Click(Index As Integer)
Dim i As Integer
Select Case Index
    Case 0
        If List4.ListIndex > -1 Then
        List3.AddItem List4.Text
        List3.ItemData(List3.ListCount - 1) = List4.ItemData(List4.ListIndex)
        List4.RemoveItem (List4.ListIndex)
        End If
    Case 2
        If List3.ListIndex > -1 Then
        List4.AddItem List3.Text
        List4.ItemData(List4.ListCount - 1) = List3.ItemData(List3.ListIndex)
        List3.RemoveItem (List3.ListIndex)
        End If
   Case 1
        For i = 0 To List4.ListCount - 1
            List4.ListIndex = i
            List3.AddItem List4.Text
            List3.ItemData(List3.ListCount - 1) = List4.ItemData(i)
        Next
        List4.Clear
   Case 3
        
        For i = 0 To List3.ListCount - 1
            List3.ListIndex = i
            List4.AddItem List3.Text
            List4.ItemData(List4.ListCount - 1) = List3.ItemData(i)
        Next
        List3.Clear
End Select
End Sub

Private Sub Command4_Click()
TF = True
Form_Userpassword.Show 1
End Sub

Private Sub Form_Activate()
If TF = True Then TF = False: Exit Sub
Dim aDo_User As New Recordset

Dim i As Integer: i = 0
Frm_GroupUser.UserGroupName = ""
Frm_GroupUser.Explain = ""
If Me.Tag = "G" Or Me.Tag = "GE" Then
   '-------------------
   If Me.Tag = "G" Then
      
      Set aDo_User = Conn_System.Execute("select * from " & SSTab.Tag & ".dbo.Gy_Czygl")
      ReDim Item2czbm(aDo_User.RecordCount)
      ReDim Item1czbm(aDo_User.RecordCount)
      Do While Not aDo_User.EOF
        List2.AddItem aDo_User!czymc
        Item2czbm(i) = Trim(aDo_User!czybm)
        i = i + 1
        aDo_User.MoveNext
      Loop
      aDo_User.Close
      Set aDo_User = Nothing
   End If
   
   If Me.Tag = "GE" Then
      '-------------------
        Set aDo_User = Conn_System.Execute("select * from " & SSTab.Tag & ".dbo.Gy_Czygl")
        ReDim Item2czbm(aDo_User.RecordCount)
        ReDim Item1czbm(aDo_User.RecordCount)
        aDo_User.Close
        '------------------
        Set aDo_User = Conn_System.Execute("select * from " & SSTab.Tag & ".dbo.System_UserGroup " _
                                        & " WHERE GroupName='" & Text2(0).Tag & "'")
        Group_ID = aDo_User!Groupid
        aDo_User.Close
        Set aDo_User = Nothing
      '------------------
        Dim Ssql As String
        Ssql = "select * from " & SSTab.Tag & ".dbo.Gy_Czygl " _
             & "where czybm not IN (select UserId  from " & SSTab.Tag & ".dbo.system_UserGroupInfo where groupid=" & Group_ID & ")"
        Set aDo_User = Conn_System.Execute(Ssql)
        Do While Not aDo_User.EOF
            List2.AddItem aDo_User!czymc
            'List2.ItemData(i) = aDo_User!czybm
            Item2czbm(i) = Trim(aDo_User!czybm)
            i = i + 1
            aDo_User.MoveNext
        Loop
        aDo_User.Close
        Set aDo_User = Nothing
      '--------------------
        Ssql = "select * from " & SSTab.Tag & ".dbo.system_UserGroupInfo A," & SSTab.Tag & ".dbo.Gy_Czygl" _
                & " B where A.groupid=" & Group_ID & " and  a.userid=b.czybm"
        Set aDo_User = Conn_System.Execute(Ssql)
        i = 0
        Do While Not aDo_User.EOF
            List1.AddItem aDo_User!czymc
            Item1czbm(i) = Trim(aDo_User!czybm)
            i = i + 1
            aDo_User.MoveNext
        Loop
        aDo_User.Close
        Set aDo_User = Nothing
   End If
   
   '---------
   SSTab.Tab = 1
   SSTab.TabEnabled(0) = False
End If
'------------------


If Me.Tag = "U" Or Me.Tag = "UE" Then
    If Me.Tag = "U" Then
      Command4.Visible = False
      Text1(1).Enabled = True: Text1(2).Enabled = True: UserCode.Enabled = True
      Set aDo_User = Conn_System.Execute("select * from " & SSTab.Tag & ".dbo.System_UserGroup")
      Do While Not aDo_User.EOF
        List4.AddItem aDo_User!GroupName
        List4.ItemData(i) = aDo_User!Groupid
        i = i + 1
        aDo_User.MoveNext
      Loop
      aDo_User.Close
      Set aDo_User = Nothing
    End If
   '----------------------------
      If Me.Tag = "UE" Then
      '-------------------
      Command4.Visible = True
      Text1(2).Tag = ""
      Text1(1).Enabled = False: Text1(2).Enabled = False: UserCode.Enabled = False
      Ssql = "select * from " & SSTab.Tag & ".dbo.Gy_Czygl " _
            & " WHERE czybm='" & Mid(Text1(0).Tag, 2, Len(Text1(0).Tag)) & "'"
      
      Set aDo_User = Conn_System.Execute(Ssql)
      Text1(1).Text = "" & Trim(aDo_User!czmm)
      Text1(2).Text = "" & Trim(aDo_User!czmm)
      aDo_User.Close
      Set aDo_User = Nothing
      '------------------
      Ssql = "select * from " & SSTab.Tag & ".dbo.system_UserGroup " _
             & "where Groupid not IN (select Groupid  from " & SSTab.Tag & ".dbo.system_UserGroupInfo where userid='" & Mid(Text1(0).Tag, 2, Len(Text1(0).Tag)) & "')"
      Set aDo_User = Conn_System.Execute(Ssql)
      Do While Not aDo_User.EOF
        List4.AddItem aDo_User!GroupName
        List4.ItemData(i) = aDo_User!Groupid
        i = i + 1
        aDo_User.MoveNext
      Loop
      aDo_User.Close
      Set aDo_User = Nothing
      '--------------------
      Ssql = "select * from " & SSTab.Tag & ".dbo.system_UserGroupInfo A," & SSTab.Tag & ".dbo.system_UserGroup" _
             & " B where A.groupid=b.groupid and  a.userid='" & Mid(Text1(0).Tag, 2, Len(Text1(0).Tag)) & "'"
      Set aDo_User = Conn_System.Execute(Ssql)
      i = 0
      Do While Not aDo_User.EOF
        List3.AddItem aDo_User!GroupName
        List3.ItemData(i) = aDo_User!Groupid
        i = i + 1
        aDo_User.MoveNext
      Loop
      aDo_User.Close
      Set aDo_User = Nothing
   End If
   '----------------------------
   SSTab.Tab = 0
   SSTab.TabEnabled(1) = False
End If
End Sub

Private Sub List1_DblClick()
Command2_Click 1
End Sub

Private Sub List2_DblClick()
Command2_Click 0
End Sub

Private Sub List3_DblClick()
Command3_Click 2
End Sub

Private Sub List4_DblClick()
Command3_Click 0
End Sub

'Private Function Mmjm1(Srmm As String) As String                  '密码加密模块
'   Dim Zfcte As Integer
'   Mmjm1 = ""
'   For Jsqte = 1 To Len(Srmm)
'       Zfcte = Asc(Mid(Srmm, Jsqte, 1)) + Len(Srmm) + Jsqte
'       Mmjm1 = Mmjm1 + Mid(Trim(Str(1000 + Zfcte)), 2, 3)
'   Next Jsqte
'End Function
'Private Function Mmjm2(Srmm As String) As String                  '密码解密模块
'   Dim Zfcte As Integer
'   Mmjm2 = ""
'   For Jsqte = 1 To Int(Len(Srmm) / 3)
'       Zfcte = Val(Mid(Srmm, (Jsqte - 1) * 3 + 1, 3)) - Int(Len(Srmm) / 3) - Jsqte
'       Mmjm2 = Mmjm2 + Chr(Zfcte)
'   Next Jsqte
'End Function

Public Function Mmjm(Srmm As String) As String                                              '密码加密对照模块
   Dim Zfcte As Integer
   Mmjm = ""
   For jsqte = 1 To Len(Srmm)
       Zfcte = Asc(Mid(Srmm, jsqte, 1)) + Asc(Mid(Srmm, Len(Srmm) - jsqte + 1, 1)) + Len(Srmm) + jsqte
       Mmjm = Mmjm + Trim(str(Zfcte))
   Next jsqte
End Function