modmt_smsm.bas

短信平台管理系统是一个短信收发的平台,用户可以找一些代理的短信平台(IP),在系统里修改一些设置就可以进行短信的收发,有短信服务器的IP,服务器端口.系统还有一些常用用户的设置,包括客户资料,客户分类

Attribute VB_Name = "modmt_smsm"
Public ins_opsmsm As New opsmsm

Public Sub TimeClist()
    If Not User.CanDo(2) Then Exit Sub
    'If Not User.ApplyTask(ACMAKERS, SysParas.BusDate + Time) Then Exit Sub
    'VEditUsers
    Dim frmx As New frmdatagrid
    With frmx
        .ListNo = "Vtimecontrol"
        .Show
    End With
End Sub

Public Function createTimeC() As Boolean
    If Not User.CanDo(2) Then Exit Function
    
    Dim value As New Smsmodel    'item
    Dim frmx As New frmTimeC 'item
    On Error GoTo errh
    
    Set frmx.value = value
inputstart:
        frmx.Show 1
        If frmx.ok = False Then
            createTimeC = False      'item
            Unload frmx
            Exit Function
        End If
    'check error
        If (checkTimeC(value) = False) Then GoTo inputstart 'item
        If (psaveTimeC(value)) = False Then     'item
            GoTo inputstart
        Else 'item
            If vbYes = MsgBox("成功创建一个时间控制（重新运行程序，新的时间设置生效），继续创建吗？ ", vbYesNo, "保存成功") Then GoTo inputstart
        End If
    'save sql
    Set value = Nothing
    Unload frmx
    
    
    createTimeC = True   'item
    
    Exit Function
errh:
        
    createTimeC = False   'item
    Unload frmx
    
    Set value = Nothing
End Function
Public Function modifyTimeC(t As Integer) As Boolean
    On Error GoTo errh
    Dim value As New timecontrol
    Dim frmx As New frmTimeC
    Dim rs As New Recordset
    With rs
    
        .ActiveConnection = cnnString
        .CursorLocation = adUseClient
        .CursorType = adOpenStatic
        .LockType = adLockReadOnly
        .Open "vwtimecontrol  WHERE (tid =" & t & ")"
        Set .ActiveConnection = Nothing
    End With
    If rs.BOF And rs.EOF Then
        MsgBox "不能修改时间控制, 记录不存在！", vbInformation, "修改"
        GoTo errh
    End If
    'NullToString (rs("modememo")), rs("bright"), rs("modeid"), rs("minute"), rs("hour")
    
    
    value.tid = rs("tid")
    value.bright = rs("bright")
    value.hour = (rs("hour"))
    value.minute = (rs("minute"))
    value.modeid = (rs("modeid"))
    value.modememo = NullToString(rs("modememo"))
    
    
    rs.Close
    releObject rs
    
    Set frmx.value = value
    
inputstart:
        frmx.Show 1
        If frmx.ok = False Then
            modifyTimeC = False
            Unload frmx
            Exit Function
        End If
    'check error
        If (checkTimeC(value) = False) Then GoTo inputstart
        If (pupdateTimeC(value)) = False Then
            GoTo inputstart
        End If
    'save sql
    
    MsgBox "成功地修改了控制信息（重新运行程序，新的时间设置生效）。 ", vbInformation, "保存成功"
    
    Set value = Nothing
    Unload frmx
    modifyTimeC = True
    
    Exit Function
errh:
    modifyTimeC = False
    Unload frmx
    
    Set value = Nothing
End Function

Public Function checkTimeC(value As timecontrol) As Boolean
    On Error GoTo errh
    checkTimeC = True
    If (value.bright < 0 Or value.bright > 100) Then
        checkTimeC = False
        MsgBox "亮度（0--100）输入错误，请检查！  ", vbCritical, "输入错误"
        
    End If
    If (value.hour < 0 Or value.hour > 23) Then
        checkTimeC = False
        MsgBox "时间值（0--23）输入错误，请检查！  ", vbCritical, "输入错误"
        
    End If

    If (value.minute < 0 Or value.minute > 59) Then
        checkTimeC = False
        MsgBox "分钟值（0--59）输入错误，请检查！  ", vbCritical, "输入错误"
        
    End If

'    If (NullToString(value.form1) = "") Then
'        checkTimeC = False
'        MsgBox "图片的文件名称输入错误，请检查！  ", vbCritical, "输入错误"
'
'    End If
    
    
    Exit Function
errh:
    MsgBox "控制信息输入错误，请检查！  ", vbCritical, "输入错误"
    checkTimeC = False
End Function
Public Function psaveTimeC(value As timecontrol) As Boolean
    Dim cnnx As New ADODB.Connection
    Dim strSql As String
    On Error GoTo errhand
    
    cnnx.ConnectionString = cnnString
    cnnx.Open
    

'hour, minute, modeid, bright
    
    strSql = "INSERT INTO TimeControl" _
        & "( hour, minute, modeid, bright) values (" _
        & "" & (value.hour) & "," _
        & "" & (value.minute) & "," _
        & "" & (value.modeid) & "," _
        & "" & (value.bright) & ")"
    

    

    cnnx.Execute strSql
    cnnx.Close
    releObject cnnx
    modpsave.psavelog User.userid, 5, "修改时间控制", Date + Time
    psaveTimeC = True
    

    Exit Function
errhand:
    If cnnx.State = adStateOpen Then
        cnnx.Close
    End If
    releObject cnnx
    psaveTimeC = False
    MsgBox "输入错误，不能保存控制信息，请检查！", vbInformation, "不能保存 "
End Function

Public Function pupdateTimeC(value As timecontrol) As Boolean
    Dim cnnx As New ADODB.Connection
    Dim strSql As String
    On Error GoTo errhand
    
    cnnx.ConnectionString = cnnString
    cnnx.Open
    
    'hour, minute, modeid, bright
    strSql = "update TimeControl set " _
        & "hour =" & (value.hour) & "," _
        & "minute =" & (value.minute) & "," _
        & " modeid =" & value.modeid & "," _
        & " bright =" & value.bright & " " _
        & "Where tid = " & value.tid
    

    

    cnnx.Execute strSql
    cnnx.Close
    releObject cnnx
    modpsave.psavelog User.userid, 6, "修改时间控制", Date + Time
    pupdateTimeC = True
    

    Exit Function
errhand:
    If cnnx.State = adStateOpen Then
        cnnx.Close
    End If
    releObject cnnx
    pupdateTimeC = False
    MsgBox "输入错误，不能保存图片的信息，请检查！", vbInformation, "不能保存 "
End Function

Public Function pdelTimeC(tid 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 TimeControl where  tid = " & tid

    cnnx.Execute strSql
    cnnx.Close
    releObject cnnx
    modpsave.psavelog User.userid, 7, "修改时间控制", Date + Time
    MsgBox "成功删除时间控制（重新运行程序，新的时间设置生效）", vbInformation, "删除成功"

   pdelTimeC = True
 

    Exit Function
errh:
    If cnnx.State = adStateOpen Then
        cnnx.Close
    End If
    releObject cnnx
    MsgBox "不能时间控制", vbInformation, "不能删除"
    
    pdelTimeC = False
    
End Function