vc_group.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 = "vc_group"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Option Explicit
Implements vc_in

Public Ins_c_group As c_group




Private Function vc_in_getidstring() As String
     vc_in_getidstring = "gid"
End Function

Private Sub vc_in_listall()
    Dim frmx As New frmdatagrid
    With frmx
        Set .ins_vc_in = Me
        .ListNo = "v_group"
        .Show
    End With
End Sub

Private Function vc_in_createrec() As Boolean
    
    Dim value As New m_group       'item
    Dim frmx As New frmGroup 'item
    On Error GoTo errh
    
    Set frmx.value = value
inputstart:
        frmx.Show 1
        If frmx.ok = False Then
            vc_in_createrec = False      'item
            Set value = Nothing
            Unload frmx
            Exit Function
        End If
    'check error
        If (checkvalid(value) = False) Then GoTo inputstart 'item
        If (Me.Ins_c_group.addrec(value.cid, value.ccid)) = False Then       'item
            MsgBox "输入错误，不能保存客户分组信息，请检查！", vbInformation, "不能保存 "
            GoTo inputstart
        Else 'item
            If vbYes = MsgBox("成功创建一个客户分组信息，继续创建吗？ ", vbYesNo, "保存成功") Then GoTo inputstart
        End If
    'save sql
    Set value = Nothing
    Unload frmx
    vc_in_createrec = True   'item
    Exit Function
errh:
        
    vc_in_createrec = False   'item
    Unload frmx
    Set value = Nothing
End Function
Private Function vc_in_modifyrec(t As Integer) As Boolean
    On Error GoTo errh
    Dim value As m_group
    Dim frmx As New frmGroup
    
    Set value = Me.Ins_c_group.getrec(t)
    If value Is Nothing Then
        MsgBox "不能修改客户分组, 记录不存在！", vbInformation, "修改"
        GoTo errh
    End If
    Set frmx.value = value
    
inputstart:
        frmx.Show 1
        If frmx.ok = False Then
            Set value = Nothing
            vc_in_modifyrec = False
            Unload frmx
            Exit Function
        End If
    'check error
        If (checkvalid(value) = False) Then GoTo inputstart
        If (Me.Ins_c_group.updaterec(value.gid, value.cid, value.ccid)) = False Then
            MsgBox "修改了客户分组不成功。 ", vbInformation, "不成功"
            GoTo inputstart
        End If
    'save sql
    
    MsgBox "成功地修改了客户分组。 ", vbInformation, "保存成功"
    
    Set value = Nothing
    Unload frmx
    vc_in_modifyrec = True
    
    Exit Function
errh:
    vc_in_modifyrec = False
    Unload frmx
    Set value = Nothing
End Function

Private Function checkvalid(value As m_group) As Boolean
    On Error GoTo errh
    checkvalid = True
    If (value.cid = 0 And value.ccid = 0) Then
        checkvalid = False
        MsgBox "输入的客户分组太长错误，请检查！  ", vbCritical, "输入错误"

    End If
    Exit Function
errh:
    MsgBox "控制信息输入错误，请检查！  ", vbCritical, "输入错误"
    checkvalid = False
End Function


Private Function vc_in_deleterec(tid As Integer) As Boolean

    
    If Me.Ins_c_group.deleterec(tid) Then
  
        MsgBox "成功删除客户分组", vbInformation, "删除成功"

        vc_in_deleterec = True
 
    Else
        MsgBox "不能删除客户分组", vbInformation, "不能删除"
    
        vc_in_deleterec = False
    End If
    
End Function


Private Sub vc_in_openrs(rs As Recordset)
    Me.Ins_c_group.openrs rs
End Sub




Private Function vc_in_Ref() As spListHeaders

    Set vc_in_Ref = Nothing
End Function

Private Sub vc_in_search(sps As spListHeaders, rs As Recordset)
   ' Me.Ins_c_group.search( )
End Sub