frmflset.frm

由VB编写的一个实用短信计费系统。主要模块包括（1）计费管理子系统：用户入费；错单处理；用户费率管理；费率管理；用户分析（2）系统维护子系统：管理员登录、管理员管理、数据库设置等（3）计费引擎子系统

VERSION 5.00
Begin VB.Form frmFLset 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "费率设置"
   ClientHeight    =   4275
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   2640
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmFLset.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4275
   ScaleWidth      =   2640
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   1620
      TabIndex        =   2
      Top             =   3780
      Width           =   825
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   285
      Left            =   720
      TabIndex        =   1
      Top             =   3780
      Width           =   825
   End
   Begin VB.ListBox lstFL 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   3375
      Left            =   180
      TabIndex        =   0
      Top             =   180
      Width           =   2265
   End
End
Attribute VB_Name = "frmFLset"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*******************************************************
'*    模 块 名 称 :选择费率
'*    功 能 描 述 :
'*    程序员姓名  :谭怀志
'*    最后修改人  :谭怀志
'*    最后修改时间:2003/6/26
'*    备        注:
'*******************************************************

Private m_WhichFunction As String
Private lngType() As Long

Public Property Let WhichFunction(ByVal NewValue As String)

     m_WhichFunction = NewValue
     
End Property

Private Sub cmdCancel_Click()

    Unload Me

End Sub

Private Sub cmdOK_Click()
    
    Dim i As Long
    Dim lngUnit As Long
    Dim sigQuan As Single
    
    If lstFL.ListIndex = -1 Then
        MsgBox "没有选择费率！", vbCritical, ERRCAPTION
        Exit Sub
    End If
    
    On Error GoTo ADOError
    
    Select Case m_WhichFunction
    Case "Default"
        
        If MsgBox("系统的默认费率设置为 “" & lstFL.List(lstFL.ListIndex) & "” 吗？”", vbYesNo + vbDefaultButton2, SYSCAPTION) = vbYes Then
        
            '更改默认费率
            strQry = "update FLlist set Status=0 "
            cnnConnection.Execute strQry
            strQry = "update FLlist set status=1 where FLid=" & Trim(Str(lstFL.ItemData(lstFL.ListIndex)))
            cnnConnection.Execute strQry
        End If
        
        Unload Me
        
    Case "User"     '用户费率设置
        
        With frmUserRate!Gridbrowser
        
            For i = 1 To .Rows - 1
            
                If .IsSelected(i) Then
                
                    If .TextMatrix(i, 3) <> "" And Val(.TextMatrix(i, 3)) <> lngType(lstFL.ListIndex) Then
                        
                        '现在设置的费率和原费率不同
                        If MsgBox("“" & .TextMatrix(i, 1) & "” 原费率为 “" & .TextMatrix(i, 2) & "” ，是否改为 “" & lstFL.List(lstFL.ListIndex) & "”？", vbOKCancel + vbDefaultButton2, SYSCAPTION) = vbOK Then
                            strQry = "update jfsetting set FLid=" & Trim(Str(lstFL.ItemData(lstFL.ListIndex))) & " where UserID='" & .TextMatrix(i, 0) & "'"
                            cnnConnection.Execute strQry
                            .TextMatrix(i, 2) = lstFL.List(lstFL.ListIndex)
                            .TextMatrix(i, 3) = Trim(Str(lngType(lstFL.ListIndex)))
                            
                            If .TextMatrix(i, 3) <> "" Then
                                strQry = "update MsgJF set SendFlag=1,SendableNum=0,Cmoney=0 where UserID='" & .TextMatrix(i, 0) & "'"
                                cnnConnection.Execute strQry
                                strQry = "update JFsetting set StartDate=Null,EndDate=Null where UserID='" & .TextMatrix(i, 0) & "'"
                                cnnConnection.Execute strQry
                            End If
                            
                        End If
                        
                    Else
                    
                        If Val(.TextMatrix(i, 3)) = lngType(lstFL.ListIndex) Then
                        
                            strQry = "update jfsetting set FLid=" & Trim(Str(lstFL.ItemData(lstFL.ListIndex))) & " where UserID='" & .TextMatrix(i, 0) & "'"
                            cnnConnection.Execute strQry
                            .TextMatrix(i, 2) = lstFL.List(lstFL.ListIndex)
                                
                            If lngType(lstFL.ListIndex) = 0 Then
                                
                                '单条用户
                                strQry = "select JFquan,JFunit from FLlist where FLid=" & Trim(Str(lstFL.ItemData(lstFL.ListIndex)))
                                Set rstCustomers = GetRecordSet(cnnConnection, strQry)
                                lngUnit = rstCustomers!JFunit
                                sigQuan = rstCustomers!JFquan
                                strQry = "select * from MsgJF where UserID='" & .TextMatrix(i, 0) & "'"
                                Set rstCustomers = GetRecordSet(cnnConnection, strQry)
                                  
                                '改变费率后，检测用户否可发送短信
                                If rstCustomers!Cmoney > 0 Then
                                    rstCustomers!SendableNum = Int(rstCustomers!Cmoney / (sigQuan / lngUnit))
                                    
                                    If rstCustomers!SendableNum > 0 Then
                                        rstCustomers!SendFlag = 0
                                    Else
                                        rstCustomers!SendFlag = 1
                                    End If
                                    
                                    rstCustomers.Update
                                End If
                                
                            End If
                            
                        End If
                        
                    End If
                    
                End If
                
            Next i
            
        End With
        
        Unload Me
        
    End Select
    
    Exit Sub
    
VBError:
    DisplayVBError
    Exit Sub
ADOError:
    DisplayADOError cnnConnection
    
End Sub


Private Sub Form_Resize()
    
    Dim i As Long
    
    On Error GoTo ADOError
    
    '列出所有费率
    strQry = "select FLid,FLname,JFtype from FLlist"
    Set rstCustomers = GetRecordSet(cnnConnection, strQry)
    
    If rstCustomers.RecordCount <> 0 Then
        ReDim lngType(rstCustomers.RecordCount - 1)
    Else
        ReDim lngType(0)
    End If
    
    While Not rstCustomers.EOF
    
        lstFL.AddItem rstCustomers!FLname
        lstFL.ItemData(lstFL.NewIndex) = rstCustomers!FLid
        lngType(i) = rstCustomers!JFtype
        i = i + 1
        rstCustomers.MoveNext
        
    Wend
    
    Exit Sub
    
VBError:
    DisplayVBError
    Exit Sub
ADOError:
    DisplayADOError cnnConnection
    
End Sub