opsmsm.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 = "c_smsm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Public cnnstr As String

Public Sub openrs(rs As Recordset)
    With rs
    
        .ActiveConnection = Me.cnnstr
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Open "SELECT mid, text From smsmodels"
        Set .ActiveConnection = Nothing
    End With
    
End Sub

Public Sub searchsms(str As String, rs As Recordset)
    rs.Open "SELECT mid, text From m_smsmodels where text like '" & str & "'"
End Sub


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

    Dim rs As New Recordset
    With rs
    
        .ActiveConnection = Me.cnnstr
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Open "SELECT mid, text From smsmodels where mid=" & id
        Set .ActiveConnection = Nothing
    End With
    If rs.BOF And rs.EOF Then
        GoTo errh
    End If
    
    value.mid = rs("mid")
    value.text = rs("text")
    
    
    rs.Close
    releObject rs
    Set getrec = value
    Exit Function
errh:
    Set value = Nothing
    Set getrec = Nothing

End Function


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

    
    strSql = "INSERT INTO smsmodels (text) values ('" & ptext & "')"
    

    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(ptext As String, pmid 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 smsmodels set text='" & ptext & "' where mid=" & pmid
    

    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 smsmodels where mid=" & 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