rsclsuser.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "rsclsuser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "WizardYN" ,"Yes"
Attribute VB_Ext_KEY = "VBProjectName" ,"ban"
Attribute VB_Ext_KEY = "DEDesignerName" ,"DataEnvironment1"
Attribute VB_Ext_KEY = "ConnectionName" ,"bank"
Attribute VB_Ext_KEY = "CommandName" ,"Users"
Attribute VB_Ext_KEY = "ClassRootName" ,"user"
Attribute VB_Ext_KEY = "ClassType" ,"Data Class"
Attribute VB_Ext_KEY = "SelectCommandName" ,"Users"
Attribute VB_Ext_KEY = "FieldNullableUserID" ,"No"
Attribute VB_Ext_KEY = "FieldPKUserID" ,"Yes"
Attribute VB_Ext_KEY = "FieldNullableUserName" ,"No"
Attribute VB_Ext_KEY = "FieldPKUserName" ,"No"
Attribute VB_Ext_KEY = "FieldNullablePassword" ,"Yes"
Attribute VB_Ext_KEY = "FieldPKPassword" ,"No"
Attribute VB_Ext_KEY = "NumFKCommands" ,"0"
Attribute VB_Ext_KEY = "NumInterfaces" ,"1"
Attribute VB_Ext_KEY = "UseSelectCommand" ,"False"
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"


Private cnnx As New ADODB.Connection
Private rsuRights As New Recordset
Attribute rsuRights.VB_VarHelpID = -1
Private varUserID As Integer
Private varUserName As String
Private varPassword As String

Public Sub logout()
    varUserID = -1
    varUserName = ""
    varPassword = ""
End Sub
Public Function ReleaseTask(TaskID As Long, Datex As Date) As Boolean
'    Dim cmmx As New Command
'    If Not cnnx.State = adStateOpen Then
'        cnnx.Open
'    End If
'    Set cmmx.ActiveConnection = cnnx
'    With cmmx
'        .CommandType = adCmdStoredProc
'        .CommandText = "sreletask"
'        .Parameters(1).Type = adInteger
'        .Parameters(2).Type = adInteger
'        .Parameters(3).Type = adDate
'        .Parameters(1).Direction = adParamInput
'        .Parameters(2).Direction = adParamInput
'        .Parameters(3).Direction = adParamInput
'        .Parameters(1).Value = TaskID
'        .Parameters(2).Value = Me.userid
'        .Parameters(3).Value = dateX
'        .Execute
'        ReleaseTask = True
'    End With
'    releObject cmmx
End Function

Public Function ApplyTask(TaskID As Long, Datex As Date) As Boolean
'@actid int,
'@userid int,
'@date datetime,
'    Dim cmmx As New Command
'    If Not cnnx.State = adStateOpen Then
'        cnnx.Open
'    End If
'    Set cmmx.ActiveConnection = cnnx
'    With cmmx
'        .CommandType = adCmdStoredProc
'        .CommandText = "sapplytask"
'        .Parameters(1).Type = adInteger
'        .Parameters(2).Type = adInteger
'        .Parameters(3).Type = adDate
'        .Parameters(4).Type = adBoolean
'        .Parameters(1).Direction = adParamInput
'        .Parameters(2).Direction = adParamInput
'        .Parameters(3).Direction = adParamInput
'        .Parameters(4).Direction = adParamOutput
'        .Parameters(1).Value = TaskID
'        .Parameters(2).Value = Me.userid
'        .Parameters(3).Value = dateX
'        .Execute
'        ApplyTask = .Parameters(4).Value
'    End With
'    releObject cmmx

End Function

'The external interface Get and Let properties.
Public Property Get userid() As Integer
    userid = varUserID
End Property
Public Property Let userid(vUserID As Integer)
    If IsNull(vUserID) Then
        varUserID = Null
    Else
        varUserID = vUserID
    End If
    
    refreshRights
    
    'cnnx.Close
 
End Property
Public Sub refreshRights()
    On Error Resume Next
    rsuRights.Close
    If varUserID > 0 Then
        If Not rsuRights.State = adStateOpen Then
            If Not cnnx.State = adStateOpen Then
                cnnx.Open
            End If
            rsuRights.ActiveConnection = cnnx
            rsuRights.CursorType = adOpenStatic
            rsuRights.Open "select * from rights where userid=" & varUserID
            'rsuRights.ActiveConnection.Close
            'cnnx.Close
        End If
    End If
    
End Sub

Public Property Get username() As String
    username = varUserName
End Property
Public Property Let username(vUserName As String)
    If IsNull(vUserName) Then
        varUserName = Null
    Else
       varUserName = vUserName
    End If
End Property

Public Property Get password() As String
    password = varPassword
End Property
Public Property Let password(vPassword As String)
    If IsNull(vPassword) Then
        varPassword = Null
    Else
        varPassword = vPassword
    End If
End Property


Public Function CanDo(funID As Long, Optional isplay As Boolean = True) As Boolean
    On Error GoTo errhandler
    If varUserID = -1 Then
        CanDo = False
        If isplay Then
            MsgBox "你没有权限操作这项功能!", vbInformation, "提示"
        End If
        Exit Function
    End If
    If Not rsuRights.State = adStateOpen Then
        refreshRights
    End If
    
    rsuRights.MoveFirst
    rsuRights.Find "funid=" & funID
    If rsuRights.EOF Then
        CanDo = False
        If isplay Then MsgBox "你没有权限操作这项功能!", vbInformation, "提示"
    Else
        CanDo = True
    End If
    Exit Function
errhandler:
        CanDo = False
        If isplay Then MsgBox "你没有权限操作这项功能!", vbInformation, ""
End Function

Private Sub Class_Initialize()
    cnnx.ConnectionString = cnnString
    varUserID = -1
    
End Sub

Private Sub Class_Terminate()
    On Error Resume Next
    If cnnx.State = adStateOpen Then
        cnnx.Close
    End If
    rsuRights.Close
    cnnx.Close
    
    Set cnnx = Nothing
End Sub