c_sendsms.cls

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

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_sendsms"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Public cnnstr As String

'SELECT smsid, mobile, cid, sms, sendisok, rtime, stime,  smsfrom, imsend,cname
'From dbo.vwsendsms

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

Public Sub searchsms(ses As m_sendsmses)
    Dim t As Date
    Dim rs As New Recordset
    t = Date + Time
    With rs
    
        .ActiveConnection = Me.cnnstr
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Open "SELECT  * From vwsendsms where sendisok=0 and stime < #" & DATETODB(t) & "#"
        
    End With
    While Not rs.EOF
        If ses.Item("s" & rs("smsid")) Is Nothing Then
            ses.Add "d", Date, Date, False, rs("sms"), 1, rs("mobile"), rs("smsid")
        End If
        rs.MoveNext
    Wend
    Set rs.ActiveConnection = Nothing
    rs.Close
    releObject rs
    
End Sub


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

    Dim rs As New Recordset
    With rs
    
        .ActiveConnection = Me.cnnstr
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Open "SELECT * From vwsendsms where smsid=" & id
        Set .ActiveConnection = Nothing
    End With
    If rs.BOF And rs.EOF Then
        GoTo errh
    End If
    value.smsid = rs("smsid")
    value.mobile = rs("mobile")
    value.cid = rs("cid")
    value.sms = rs("sms")
    value.sendisok = rs("sendisok")
    value.rtime = CDate(rs("rtime"))
    value.stime = CDate(rs("stime"))
    
    value.cname = rs("cname")
    value.smsfrom = rs("smsfrom")
    value.imsend = rs("imsend")

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

End Function


        'SELECT mid, text
        'From dbo.m_sendsmss
Public Function addrec(mobile As String, cid As Integer, sms As String, sendisok As Boolean, rtime As Date, stime As Date _
, smsfrom As Boolean, imsend As Boolean) As Boolean
    Dim cnnx As New ADODB.Connection
    Dim strSql As String
    On Error GoTo errhand
    
    cnnx.ConnectionString = cnnstr
    cnnx.Open
    

    
    strSql = "INSERT INTO sendsms (mobile,  sms,cid, sendisok,  smsfrom, imsend, rtime, stime) values ('" & mobile & "'" _
    & ",'" & sms & "'" _
    & "," & cid & "" _
    & "," & CInt(sendisok) & "" _
    & "," & CInt(smsfrom) & "" _
    & "," & CInt(imsend) & "" _
    & ",'" & DATETODB(rtime) & "'" _
    & ",'" & DATETODB(stime) _
    & "')"
    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(smsid As Integer, mobile As String, cid As Integer, sms As String, stime As Date) As Boolean
    Dim cnnx As New ADODB.Connection
    Dim strSql As String
    On Error GoTo errhand
    
    cnnx.ConnectionString = cnnString
    cnnx.Open
    
    strSql = "update sendsms set mobile='" & mobile & "'" _
    & ",sms='" & sms & "'" _
    & ",cid=" & cid & "" _
    & ",stime='" & DATETODB(stime) & "" _
    & "' where smsid=" & smsid
    

    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 sendsms where smsid=" & 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




Public Function sended(smsid 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 sendsms set sendisok=-1  where smsid=" & smsid
    

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

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