modbank.bas

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

Attribute VB_Name = "modBank"
Public Ins_vc_smsm As New vc_smsm
Public Ins_vc_cusclass As New vc_cusclass
Public Ins_vc_customer As New vc_customer
Public Ins_vc_parameter As New vc_parameter
Public Ins_vc_group As New vc_group
Public Ins_vc_sendsms As New vc_sendsms
Public Ins_vc_gsendsms As New vc_gsendsms
Public Ins_vc_recvedsms As New vc_recvedsms




Public Ins_c_smsm As New c_smsm
Public Ins_c_cusclass As New c_cusclass
Public Ins_c_customer As New c_customer
Public Ins_c_parameter As New c_parameter
Public Ins_c_group As New c_group
Public Ins_c_sendsms As New c_sendsms
Public Ins_c_gsendsms As New c_gsendsms
Public Ins_c_recvedsms As New c_recvedsms

Public smses As New m_sendsmses


Public User As rsclsuser

Public fMainForm As frmMain
Public cnnString As String

Public strserver As String

Public Sub releObject(obj As Object)
    If Not obj Is Nothing Then
        Set obj = Nothing
    End If
End Sub
Public Sub releAllObj()
    On Error Resume Next
    releObject User

'    getledcConn.Close
'    releObject getledcConn
End Sub
Public Sub users()
    If Not User.CanDo(1) Then Exit Sub
    'If Not User.ApplyTask(ACMAKERS, SysParas.BusDate + Time) Then Exit Sub
    'VEditUsers
    Dim frmx As New frmdatagrid
    With frmx
        .ListNo = "VUsers"
        .Show
    End With
End Sub

'setServer
Public Sub setServer()
    If Not User.CanDo(1) Then Exit Sub

    With frmserver
        .Show 1
        If .ok Then
            MsgBox "服务器已经设置好，下次进入系统才可生效！", vbInformation, "系统提示"
        End If
    End With

End Sub

Public Sub sysLogs()
    If Not User.CanDo(1) Then Exit Sub
    Dim frmx As New frmdatagrid
    With frmx
        .ListNo = "vLogs"
        .Show
    End With
End Sub

Sub Main()
    On Error GoTo errh

    
'    strserver = GetSetting(App.Title, "Settings", "connection", "")
'    If strserver = "" Then
'        frmserver.Show 1
'        If frmserver.ok Then
'            strserver = GetSetting(App.Title, "Settings", "connection", "")
'        Else
'            Exit Sub
'        End If
'    End If
    cnnString = "PROVIDER=Microsoft.Jet.OLEDB.3.51;Data Source=" & App.Path & "\sms.old.mdb;"
    'cnnString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=led;Data Source=" & strserver ';Locale Identifier=2052;Connect Timeout=15;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096"
    SaveSetting App.Title, "Settings", "connection", strserver
    
    
    Set User = New rsclsuser
    
    
    
    
    frmLogin.Show vbModal
    If Not frmLogin.ok Then
        'Login Failed so exit app
        releAllObj
        End
    End If
    Unload frmLogin
    
    Set Ins_vc_smsm.Ins_c_smsm = Ins_c_smsm
    Ins_c_smsm.cnnstr = cnnString
    
    'Ins_vc_cusclass
    
    Set Ins_vc_cusclass.Ins_c_cusclass = Ins_c_cusclass
    Ins_c_cusclass.cnnstr = cnnString
    
    Set Ins_vc_customer.Ins_c_customer = Ins_c_customer
    Ins_c_customer.cnnstr = cnnString
    
    Set Ins_vc_parameter.Ins_c_parameter = Ins_c_parameter
    Ins_c_parameter.cnnstr = cnnString
    
    Set Ins_vc_group.Ins_c_group = Ins_c_group
    Ins_c_group.cnnstr = cnnString
    
    Set Ins_vc_sendsms.Ins_c_sendsms = Ins_c_sendsms
    Ins_c_sendsms.cnnstr = cnnString
    Set Ins_vc_gsendsms.Ins_c_gsendsms = Ins_c_gsendsms
    Ins_c_gsendsms.cnnstr = cnnString
    Set Ins_vc_recvedsms.Ins_c_recvedsms = Ins_c_recvedsms
    Ins_c_recvedsms.cnnstr = cnnString
    

    frmSplash.Show , frmMain
    frmSplash.Refresh
'    Set fMainForm = New frmMain
'    Load fMainForm
'    Dim obj As Object
'    Dim xx As vc_smsm
'    Set obj = Ins_vc_smsm
'    Set xx = Ins_vc_smsm 'obj
'    xx.Ins_c_smsm = Ins_c_smsm
'    obj.Ins_c_smsm = Ins_c_smsm
    

    
    frmMain.Show
    
    
    frmSplash.Hide
    Unload frmSplash


    'fMainForm.Show
    Exit Sub
errh:
    MsgBox "error!"
End Sub

Public Function toNull(VARx As String) As Variant
    If Trim(VARx) = vbNullString Then
        toNull = "null"
    Else
        toNull = "'" & VARx & "'"
    End If
End Function
Public Function NullToString(VARx As Variant) As Variant
    If IsNull(VARx) Then
        NullToString = ""
    Else
        NullToString = VARx
        NullToString = Trim(NullToString)
    End If
End Function
Public Function DATETODB(d As Variant) As String
    DATETODB = Format(d, "yyyy/mm/dd hh:mm:ss")
    
End Function

    
Public Function setsqlserver() As Boolean
    Dim strs As String
    strs = GetSetting(App.Title, "Settings", "sserver", "ss")
    If strs = "ss" Then
       frmserver.Show 1
       setsqlserver = frmserver.ok
    Else
        setsqlserver = True
    End If
    
End Function

'Sub dkCalRate()
'    CalOutRate
'End Sub
Public Sub rights()
    If Not User.CanDo(1) Then Exit Sub
    
    frmRights.Show 1
End Sub