vc_customer.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_customer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Implements vc_in

Public Ins_c_customer As c_customer





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



Private Sub vc_in_listall()

    
    Dim frmx As New frmdatagrid
    
    With frmx
        Set .ins_vc_in = Me
        .ListNo = "v_customer"
        .Show
    End With
End Sub
Private Function vc_in_createrec() As Boolean

   
    
    Dim value As New m_customer     'item
    Dim frmx As New frmCustomer '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_customer.addrec(value.birth, value.cname, value.sex, value.mobile, value.phone, value.memo)) = 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_customer
    Dim frmx As New frmCustomer
    
    Set value = Me.Ins_c_customer.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_customer.updaterec(value.cid, value.birth, value.cname, value.sex, value.mobile, value.phone, value.memo)) = 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_customer) As Boolean
    On Error GoTo errh
    checkvalid = True
    If (Len(Trim(value.mobile)) = 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_customer.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_customer.openrs rs
End Sub

Private Function vc_in_Ref() As spListHeaders
    Dim rsRef As New Recordset
    Dim frmx As New frmref
    Dim sps As New spListHeaders
    Dim i As Integer
    vc_in_openrs rsRef
    With sps
        .isTwoS = False
        .other = "all"
        .vName = "客户资料"
        .ViewNo = "v_customer"
        .ReadOnly = False
        .Add "编号", "cid", 500, "@", , , , , , , , , 1, , 1, , , False
        .Add "手机", "mobile", 2500, "@", , , , , , , , , 1, , 1, , , True
        .Add "客户名称", "cname", 2500, "@", , , , , , , , , 2, , 1, , , True
        .Add "生日", "birth", 2500, "@", , , , , , , , , 3, , 1, , , True
        .Add "电话", "phone", 2500, "@", , , , , , , , , 5, , 1, , , True
        .Add "性别", "sex", 2500, "@", , , , , , , , , 6, , 1, , , True
        .Add "备注", "memo", 2500, "@", , , , , , , , , 7, , 1, , , True


        For i = 1 To .Count
            sps(i).Other1 = ""
        Next

    End With


    With frmx


        Set .sps = sps
        Set .rsRef = rsRef

        .Show 1


    End With

    Unload frmx
    rsRef.Close
    releObject rsRef
    Set vc_in_Ref = sps
End Function

Private Sub vc_in_search(sps As spListHeaders, rs As Recordset)
    'me.Ins_c_customer
End Sub