frmfledit.frm

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

VERSION 5.00
Begin VB.Form frmFLedit 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "新增费率"
   ClientHeight    =   3675
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3795
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   9
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmFLedit.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3675
   ScaleWidth      =   3795
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.TextBox txtFLid 
      Appearance      =   0  'Flat
      Enabled         =   0   'False
      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            =   1305
      TabIndex        =   0
      Top             =   315
      Width           =   2085
   End
   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            =   2610
      TabIndex        =   6
      Top             =   3195
      Width           =   915
   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            =   1575
      TabIndex        =   5
      Top             =   3195
      Width           =   915
   End
   Begin VB.TextBox txtFLname 
      Appearance      =   0  'Flat
      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            =   1305
      TabIndex        =   1
      Top             =   855
      Width           =   2085
   End
   Begin VB.TextBox txtUnit 
      Appearance      =   0  'Flat
      Enabled         =   0   'False
      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            =   1305
      TabIndex        =   3
      Text            =   "1"
      Top             =   2055
      Width           =   2085
   End
   Begin VB.TextBox txtQuan 
      Appearance      =   0  'Flat
      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            =   1305
      TabIndex        =   4
      Top             =   2625
      Width           =   2085
   End
   Begin VB.ComboBox cboJFtype 
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   315
      ItemData        =   "frmFLedit.frx":000C
      Left            =   1305
      List            =   "frmFLedit.frx":0016
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   1440
      Width           =   2085
   End
   Begin VB.Label Label1 
      Caption         =   "费率ID："
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   405
      TabIndex        =   11
      Top             =   315
      Width           =   735
   End
   Begin VB.Label Label5 
      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          =   240
      Left            =   405
      TabIndex        =   10
      Top             =   900
      Width           =   915
   End
   Begin VB.Label Label4 
      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          =   240
      Left            =   405
      TabIndex        =   9
      Top             =   2655
      Width           =   825
   End
   Begin VB.Label Label3 
      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          =   240
      Left            =   405
      TabIndex        =   8
      Top             =   2070
      Width           =   915
   End
   Begin VB.Label Label2 
      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          =   240
      Left            =   405
      TabIndex        =   7
      Top             =   1485
      Width           =   915
   End
End
Attribute VB_Name = "frmFLedit"
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 blnPoint As Boolean

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()
    
    '检查费率设置的正确性
    If Trim(txtQuan.Text) = "" Then
        MsgBox "计费额必须填写!", vbCritical, ERRCAPTION
        txtQuan.SetFocus
        Exit Sub
    End If
    
    If Trim(txtFLname.Text) = "" Then
        MsgBox "费率名称必须填写！", vbCritical, ERRCAPTION
        txtFLname.SetFocus
        Exit Sub
    End If
    
    On Error GoTo ADOError
    
    If m_WhichFunction = "New" Then
        
        '新增一个费率
        strQry = "insert into FLlist(FLid,JFtype,JFunit,JFquan,status,FLname) values(" & txtFLid.Text & "," & Trim(Str(cboJFtype.ListIndex)) & "," & txtUnit.Text & "," & txtQuan.Text & ",0,'" & txtFLname.Text & "')"
        cnnConnection.Execute strQry
        
        With frmRate!Gridbrowser
        
            .AddItem ""
            .RowHeight(.Rows - 1) = 350
            .TextMatrix(.Rows - 1, 0) = txtFLid.Text
            .TextMatrix(.Rows - 1, 1) = txtFLname.Text
            .TextMatrix(.Rows - 1, 2) = txtUnit.Text
            .TextMatrix(.Rows - 1, 3) = Format(Val(txtQuan.Text), "########0.00")
            .TextMatrix(.Rows - 1, 4) = ""
            .TextMatrix(.Rows - 1, 5) = Trim(Str(cboJFtype.ListIndex))
            
        End With
        
    Else
        
        If Val(frmRate!Gridbrowser.TextMatrix(frmRate!Gridbrowser.RowSel, 5)) <> cboJFtype.ListIndex Then
            
            '费率的计费方式改变，提示用户是否保存
            If MsgBox("该费率的计费方式已经改变,是否保存设置?", vbYesNo + vbDefaultButton2, SYSCAPTION) = vbNo Then
                Exit Sub
            Else
                strQry = "update JFsetting set StartDate=Null,EndDate=Null where FLid=" & txtFLid.Text
                cnnConnection.Execute strQry
                strQry = "select UserID from JFsetting where FLid=" & txtFLid.Text
                Set rstCustomers = GetRecordSet(cnnConnection, strQry)
                
                While Not rstCustomers.EOF
                    strQry = "update MsgJF set SendFlag=1,SendableNum=0,Cmoney=0 where UserID='" & rstCustomers!UserID & "'"
                    cnnConnection.Execute strQry
                    rstCustomers.MoveNext
                Wend
                
                strQry = "update FLlist set JFtype= " & Trim(Str(cboJFtype.ListIndex)) & ",JFquan=" & txtQuan.Text & ",FLname='" & txtFLname & "' where FLid=" & txtFLid.Text
                cnnConnection.Execute strQry
            End If
            
        Else
        
            strQry = "update FLlist set JFtype= " & Trim(Str(cboJFtype.ListIndex)) & ",JFquan=" & txtQuan.Text & ",FLname='" & txtFLname & "' where FLid=" & txtFLid.Text
            cnnConnection.Execute strQry
            
            If cboJFtype.ListIndex = 0 Then
                strQry = "select UserID from JFsetting where FLid=" & txtFLid.Text
                Set rstCustomers = GetRecordSet(cnnConnection, strQry)
                                  
                '费率改变后，检查相关的用户是否可发送短信
                While Not rstCustomers.EOF
                    strQry = "select SendableNum,SendFlag,Cmoney from MsgJF Where UserID='" & rstCustomers!UserID & "'"
                    Set TrstCustomers = GetRecordSet(cnnConnection, strQry)
                    
                    If TrstCustomers!Cmoney > 0 Then
                        TrstCustomers!SendableNum = Int(TrstCustomers!Cmoney / (Val(txtQuan.Text) / Val(txtUnit.Text)))
                        If TrstCustomers!SendableNum > 0 Then
                            TrstCustomers!SendFlag = 0
                        Else
                            TrstCustomers!SendFlag = 1
                        End If
                        TrstCustomers.Update
                    End If
                    
                    rstCustomers.MoveNext
                Wend
                
            End If
            
        End If
        
        With frmRate!Gridbrowser
        
            .TextMatrix(.RowSel, 1) = txtFLname.Text
            .TextMatrix(.RowSel, 3) = Format(Val(txtQuan.Text), "########0.00")
            .TextMatrix(.Rows - 1, 5) = Trim(Str(cboJFtype.ListIndex))
            
        End With
        
    End If
        
    Unload Me
    
    Exit Sub
    
VBError:
    DisplayVBError
    Exit Sub
ADOError:
    DisplayADOError cnnConnection
    
End Sub

Private Sub Form_Resize()

    Dim lngMax As Long
    
    If m_WhichFunction = "New" Then
        
        '新增费率时，获取费率ID
        strQry = "select intMax=max(FLid) from FLlist"
        Set rstCustomers = GetRecordSet(cnnConnection, strQry)
        
        If rstCustomers!intMax > 0 Then
            lngMax = rstCustomers!intMax + 1
        Else
            lngMax = 1
        End If
        
        txtFLid.Text = Trim(Str(lngMax))
        Me.Caption = "新增费率"
        cboJFtype.ListIndex = 0
        
    Else
        txtFLid.Enabled = False
        Me.Caption = "修改费率"
    End If
    
    blnPoint = False
    
End Sub

Private Sub txtQuan_Change()

    If InStr(txtQuan.Text, ".") > 0 Then
        blnPoint = True
    Else
        blnPoint = False
    End If
    
End Sub

Private Sub txtQuan_KeyPress(KeyAscii As Integer)
    
    '输入金额时，将无效的输入屏蔽
    If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) And KeyAscii <> 8 And KeyAscii <> 13 And KeyAscii <> Asc(".") Then
        KeyAscii = 0
        Exit Sub
    End If
    
    '不是第一次输入小数点是时，将输入屏蔽掉
    If KeyAscii = Asc(".") And blnPoint Then
        KeyAscii = 0
        Exit Sub
    End If
  
End Sub