usermaintain.bas

短信平台管理系统是一个短信收发的平台,用户可以找一些代理的短信平台(IP),在系统里修改一些设置就可以进行短信的收发,有短信服务器的IP,服务器端口.系统还有一些常用用户的设置,包括客户资料,客户分类

Attribute VB_Name = "usermaintain"


Public Function createuser() As Boolean
    Dim value As New User  'item
    Dim frmx As New frmuser 'item
    On Error GoTo errh
    
    Set frmx.value = value
inputstart:
        frmx.Show 1
        If frmx.ok = False Then
            createuser = False      'item
            Unload frmx
            Exit Function
        End If
    'check error
        If (checkuser(value) = False) Then GoTo inputstart 'item
        If (saveuser(value)) = False Then    'item
            GoTo inputstart
        Else 'item
            If vbYes = MsgBox("成功创建一个新的用户，是否继续? ", vbYesNo, "创建成功") Then GoTo inputstart
        End If
    'save sql
    Set value = Nothing
    Unload frmx
    
    
    createuser = True   'item
    
    Exit Function
errh:
        
    createuser = False   'item
    Unload frmx
    
    Set value = Nothing
End Function
Public Function modifyuser(id As Long) As Boolean
    On Error GoTo errh
    Dim value As New User
    Dim frmx As New frmuser
    Dim rs As New Recordset
    With rs
    
        .ActiveConnection = cnnString
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Open "SELECT [userid], [username], [password] FROM Users where userid=" & id
        Set .ActiveConnection = Nothing
    End With
    If rs.BOF And rs.EOF Then
        MsgBox "不能修改已经存在的用户", vbInformation, "修改错误"
        GoTo errh
    End If
    
    value.id = rs("userid")
    value.username = rs("username")
    value.password = rs("password")
    rs.Close
    releObject rs
    
    Set frmx.value = value
    
inputstart:
        frmx.Show 1
        If frmx.ok = False Then
            modifyuser = False
            Unload frmx
            Exit Function
        End If
    'check error
        If (checkuser(value) = False) Then GoTo inputstart
        If (updateuser(value)) = False Then
            GoTo inputstart
        End If
    'save sql
    
    MsgBox "成功修改了用户的信息", vbInformation, "保存成功"
    
    Set value = Nothing
    Unload frmx
    modifyuser = True
    
    Exit Function
errh:
    modifyuser = False
    Unload frmx
    
    Set value = Nothing
End Function

Public Function checkuser(value As User) As Boolean
    On Error GoTo errh
    If (NullToString(value.username) = "") Then
        checkuser = False
        MsgBox "用户名称输入错误请检查！", vbCritical, "输入错误"
        Exit Function
    End If
    If (value.password <> value.conpassword) Then
        checkuser = False
        MsgBox "用户口令输入错误！ ", vbCritical, "输入错误"
        Exit Function
    End If
    checkuser = True
    Exit Function
errh:
    MsgBox "输入错误请检查", vbCritical, "输入错误"
    checkuser = False
End Function
Public Function saveuser(value As User) As Boolean
    Dim cnnx As New ADODB.Connection
    Dim strSql As String
    On Error GoTo errhand
    
    cnnx.ConnectionString = cnnString
    cnnx.Open
    
'    INSERT INTO ProductCatalog ( provider, user )
'    SELECT ProductCatalog.provider, ProductCatalog.user
'    FROM ProductCatalog;

    
    strSql = "INSERT INTO users ( username,password ) values (" _
     & "'" & value.username & "'," _
     & "'" & NullToString(value.password) & "'" _
     & ")"
    

    

    cnnx.Execute strSql
    cnnx.Close
    releObject cnnx
    'modpsave.psavelog User.userid, 8, value.username, Date + Time

    saveuser = True
    

    Exit Function
errhand:
    If cnnx.State = adStateOpen Then
        cnnx.Close
    End If
    releObject cnnx
    saveuser = False
    MsgBox "输入错误，操作员不能保存！", vbInformation, "不能保存"
End Function

Public Function updateuser(value As User) As Boolean
    Dim cnnx As New ADODB.Connection
    Dim strSql As String
    On Error GoTo errhand
    
    cnnx.ConnectionString = cnnString
    cnnx.Open
    
'UPDATE ProductCatalog SET ProductCatalog.userid = "",
'ProductCatalog.provider = "", ProductCatalog.user = "", ProductCatalog.productclass = "";


    
    strSql = "update users set username='" & value.username & "', password ='" & value.password & "' where userid=" & value.id
    

    

    cnnx.Execute strSql
    cnnx.Close
    releObject cnnx
    modpsave.psavelog User.userid, 9, str(value.id) & ": " & value.username, Date + Time
    updateuser = True
    

    Exit Function
errhand:
    If cnnx.State = adStateOpen Then
        cnnx.Close
    End If
    releObject cnnx
    updateuser = False
    MsgBox "输入错误，操作员不能保存！", vbInformation, "不能保存"
End Function


Public Function deluser(id As Long) As Boolean
    On Error GoTo errh
    Dim cnnx As New ADODB.Connection
    Dim strSql As String
    

    cnnx.ConnectionString = cnnString
    cnnx.Open
    strSql = "delete from users where userid=" & id

    cnnx.Execute strSql
    cnnx.Close
    releObject cnnx
    modpsave.psavelog User.userid, 10, str(id), Date + Time
    MsgBox "成功删除操作员，编号为:" & id, vbInformation, "删除成功"

    

    Exit Function
errh:
    If cnnx.State = adStateOpen Then
        cnnx.Close
    End If
    releObject cnnx
    MsgBox "不能删除操作员，编号为:" & id, vbInformation, "删除错误"
    
    deluser = True
    
End Function