c_group.cls

来自「短信平台管理系统是一个短信收发的平台,用户可以找一些代理的短信平台(IP),在系」· CLS 代码 · 共 168 行

CLS
168
字号
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "c_group"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Public cnnstr As String

'SELECT cid, ccid, gid From dbo.cgroup
'SELECT gid, ccid, cid, cname, cusname, mobile
'From dbo.vwgroup

Public Sub openrs(rs As Recordset)
    With rs
    
        .ActiveConnection = Me.cnnstr
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Open "SELECT * From vwgroup order by ccid"
        Set .ActiveConnection = Nothing
    End With
    
End Sub

Public Sub searchsms(str As String, rs As Recordset)
    rs.Open "SELECT * From vwgroup"
End Sub


Public Function getrec(id As Integer) As m_group
    On Error GoTo errh
    Dim value As New m_group

    Dim rs As New Recordset
    With rs
    
        .ActiveConnection = Me.cnnstr
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Open "SELECT * From vwgroup where gid=" & id
        Set .ActiveConnection = Nothing
    End With
    If rs.BOF And rs.EOF Then
        GoTo errh
    End If
    value.gid = rs("gid")
    value.cid = rs("cid")
    value.ccid = rs("ccid")
    
    value.cname = rs("cname")
    value.cusname = rs("cusname")
    value.mobile = rs("mobile")

    rs.Close
    releObject rs
    Set getrec = value
    Exit Function
errh:
    Set value = Nothing
    Set getrec = Nothing

End Function


        'SELECT mid, text
        'From dbo.m_groups
Public Function addrec(cid As Integer, ccid As Integer) As Boolean
    Dim cnnx As New ADODB.Connection
    Dim strSql As String
    On Error GoTo errhand
    
    cnnx.ConnectionString = cnnstr
    cnnx.Open
    

    
    strSql = "INSERT INTO cgroup (cid, ccid) values (" & cid & "" _
    & "," & ccid _
    & ")"
    

    cnnx.Execute strSql
    cnnx.Close
    releObject cnnx
    addrec = True
    Exit Function
errhand:
    If cnnx.State = adStateOpen Then
        cnnx.Close
    End If
    releObject cnnx
    addrec = False
End Function



Public Function updaterec(gid As Integer, cid As Integer, ccid As Integer) As Boolean
    Dim cnnx As New ADODB.Connection
    Dim strSql As String
    On Error GoTo errhand
    
    cnnx.ConnectionString = cnnString
    cnnx.Open
    
    strSql = "update cgroup set cid=" & cid & "" _
    & ",ccid=" & ccid & "" _
    & " where gid=" & gid
    

    cnnx.Execute strSql
    cnnx.Close
    releObject cnnx
    updaterec = True
    

    Exit Function
errhand:
    If cnnx.State = adStateOpen Then
        cnnx.Close
    End If
    releObject cnnx
    updaterec = False
End Function


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

    cnnx.ConnectionString = cnnString
    cnnx.Open
    strSql = "delete from cgroup where gid=" & id

    cnnx.Execute strSql
    cnnx.Close
    releObject cnnx


    deleterec = True

    Exit Function
errh:
    If cnnx.State = adStateOpen Then
        cnnx.Close
    End If
    releObject cnnx
    
    deleterec = False
    
End Function






⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?