frmoweset.frm

有线电视收费软件 数据库密码winter

VERSION 5.00
Begin VB.Form frmOweSet 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "当年欠费结转"
   ClientHeight    =   4695
   ClientLeft      =   1095
   ClientTop       =   330
   ClientWidth     =   6135
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   4695
   ScaleWidth      =   6135
   Begin VB.TextBox txtYear 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   3960
      TabIndex        =   0
      Top             =   1230
      Width           =   1755
   End
   Begin VB.Frame Frame1 
      Caption         =   "提示："
      Height          =   3975
      Left            =   300
      TabIndex        =   3
      Top             =   420
      Width           =   2835
      Begin VB.TextBox Text1 
         BackColor       =   &H80000000&
         BorderStyle     =   0  'None
         CausesValidation=   0   'False
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000001&
         Height          =   3135
         Left            =   240
         Locked          =   -1  'True
         MultiLine       =   -1  'True
         TabIndex        =   4
         Text            =   "frmOweSet.frx":0000
         Top             =   480
         Width           =   2355
      End
   End
   Begin VB.CommandButton cmdOweSet 
      Caption         =   "欠费结转(O)"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   510
      Left            =   4020
      TabIndex        =   2
      Top             =   2250
      Width           =   1716
   End
   Begin VB.CommandButton cmdClose 
      Cancel          =   -1  'True
      Caption         =   "关闭(&C)"
      CausesValidation=   0   'False
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   510
      Left            =   4020
      TabIndex        =   1
      Top             =   3630
      Width           =   1716
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "年份："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   240
      Left            =   3930
      TabIndex        =   5
      Top             =   840
      Width           =   720
   End
End
Attribute VB_Name = "frmOweSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim adoPrimaryRS As New ADODB.Recordset
'进行欠费结转
Private Sub cmdOweSet_Click()
    
    If MsgBox("您是否确定进行欠费结转？", vbYesNo, "欠费结转提示") = vbNo Then
        Exit Sub
    End If
    
    Dim rsOwe As New ADODB.Recordset
    Dim rsTmp As New ADODB.Recordset
    Dim cMonRent As Currency
    Dim cTotal As Currency
    Dim iMonStop As Integer
    Dim iYear As Integer
    Dim sDate As String
    Dim sSQL As String
    Dim sUserID As String
    
    
    On Error GoTo Owe_Err
    
    Me.MousePointer = vbHourglass
    iYear = Val(txtYear.Text)
    sDate = iYear & "/12/31"     '统计年份的交费截止日期
    
    '从数据库中取出当年月租费
    sSQL = "SELECT 月租费 FROM 年月租费表 WHERE 年份='" & iYear & "'"
    rsTmp.Open sSQL, CN1, adOpenForwardOnly, adLockReadOnly, adCmdText
    If rsTmp.BOF And rsTmp.EOF Then
        '未设定，则默认月租费为 12.00 元
        cMonRent = 12#
    Else
        cMonRent = rsTmp![月租费]
    End If
    
    '打开当年未交费用户的记录集
    sSQL = "SELECT 用户编号" _
         & " FROM 用户基本信息表" _
         & " WHERE 报停情况='正常'" _
         & " AND 开通起始日期<='" & Format(sDate, "yyyy/mm/dd") & "'" _
         & " AND 用户编号 NOT IN" _
         & " (SELECT 用户编号 FROM 用户交费表" _
         & "  WHERE 本次截止='" & Format(sDate, "yyyy/mm/dd") & "')"
    rsOwe.Open sSQL, CN1, adOpenStatic, adLockReadOnly, adCmdText
    If rsOwe.BOF And rsOwe.EOF Then
        rsOwe.Close
        Me.MousePointer = vbDefault
        Exit Sub
    End If
    Do While Not rsOwe.EOF
        sUserID = rsOwe![用户编号]
        '取出当前用户，指定年度得报停月份
        sSQL = " SELECT 报停日期,复通日期" _
             & " FROM 用户报停表" _
             & " WHERE 用户编号='" & rsOwe![用户编号] & "'" _
             & " AND (YEAR(报停日期)<=" & iYear _
             & " OR YEAR(复通日期)>=" & iYear & ")"

        Set rsTmp = Nothing
        rsTmp.Open sSQL, CN1, adOpenStatic, adLockReadOnly, adCmdText
        If rsTmp.BOF And rsTmp.EOF Then
            '该用户在指定年度从未报停
            iMonStop = 0
        Else
            If IsNull(rsTmp![报停日期]) Then
                MsgBox "用户报停表中的报停日期非法！", "欠费结转提示"
                Exit Sub
            Else
                '当用户在指定的当年报停
                If Year(rsTmp![报停日期]) = iYear Then
                    '当用户未复通时的当年报停月数
                    If IsNull(rsTmp![复通日期]) Then
                        iMonStop = 12 - Month(rsTmp![报停日期])
                    Else
                        iMonStop = Month(rsTmp![复通日期]) - Month(rsTmp![报停日期])
                    End If
                Else
                '当用户未在指定的当年报停（则认为在当年之前报停）
                    '当用户未复通时的当年报停月数
                    If IsNull(rsTmp![复通日期]) Then
                        iMonStop = 12
                    Else
                        iMonStop = Month(rsTmp![复通日期])
                    End If
                End If
            End If
        End If
             
        '查看用户当年交费情况，并计算当年欠费（不允许跨年度）
        sSQL = " SELECT 用户编号,交费金额,本次起始,本次截止" _
             & " FROM 用户交费表" _
             & " WHERE 用户编号='" & rsOwe![用户编号] & "'" _
             & " AND YEAR(本次截止)=" & iYear
             
        Set rsTmp = Nothing
        rsTmp.Open sSQL, CN1, adOpenForwardOnly, adLockReadOnly, adCmdText
        If rsTmp.BOF And rsTmp.EOF Then
            '该用户在指定年度从未交过费
            cTotal = cMonRent * (12 - iMonStop)
'            cTotal = cMonRent * 12
        Else
            cTotal = cMonRent * (Month(rsTmp![本次截止]) - Month(rsTmp![本次起始]) - iMonStop)
            If cTotal < 0 Then
                cTotal = 0
            End If
'            cTotal = cMonRent * (Month(rsTmp![本次截止]) - Month(rsTmp![本次起始]))
        End If
        rsTmp.Close
        
        '将欠费记入欠费表，欠费不累计，分项
        sSQL = " SELECT 用户编号,欠费金额,欠费起始,欠费截止,补交否,操作时间,操作员" _
             & " FROM 用户欠费表" _
             & " WHERE 用户编号='" & rsOwe![用户编号] & "'"
        rsTmp.Open sSQL, CN1, adOpenDynamic, adLockOptimistic, adCmdText
        '该用户以前未有欠费
        If cTotal > 0 Then
            rsTmp.AddNew
            rsTmp![用户编号] = Format(rsOwe![用户编号], "@@@@@@@@@@@@@@")
            If Len(Trim(rsTmp![用户编号])) < 14 Then
'                MsgBox "用户编号长度不足"
                Open "ErrorFile.err" For Append As #1   ' 打开输出文件。
                Write #1, "用户编号：" & rsOwe![用户编号], Err.Description    ' 写入以逗号隔开的数据。
                Close #1
            End If
            rsTmp![欠费金额] = cTotal
            rsTmp![欠费起始] = Format(iYear & "/01/01", "yyyy/mm/dd")
            rsTmp![欠费截止] = Format(iYear & "/12/31", "yyyy/mm/dd")
            rsTmp![补交否] = False
            rsTmp![操作时间] = Date
            rsTmp![操作员] = sOperator
            rsTmp.Update
        End If
        rsTmp.Close
        rsOwe.MoveNext
    Loop
    rsTmp.Close
    rsOwe.Close
    Me.MousePointer = vbDefault
    Exit Sub
Owe_Err:
    
    Open "ErrorFile.err" For Append As #1   ' 打开输出文件。
    Write #1, "用户编号：" & sUserID, Err.Description     ' 写入以逗号隔开的数据。
    Close #1
    Select Case Err.Number
    Case &H80040E2F
'        MsgBox "您结转的欠费记录已存在！请检查正确后重新输入!", vbOKOnly, "操作提示"
        Resume Next
    Case Else
'        MsgBox Err.Description
        Resume Next
    End Select
    Me.MousePointer = vbDefault
End Sub

'窗体载入，进行初始化
Private Sub Form_Load()
    With Me
        .Move (frmMDI.Width - .Width) / 2, (frmMDI.Height - .Height - frmMDI!Toolbar1.Height) / 2
    End With
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - 1600 - Me.Height) / 2
End Sub
'窗体卸载
Private Sub Form_Unload(Cancel As Integer)
    Screen.MousePointer = vbDefault
End Sub

'关闭本窗体
Private Sub cmdClose_Click()
    Unload Me
End Sub

'年度有效性验证
Private Sub txtYear_Validate(Cancel As Boolean)
    Dim iYear As Integer
    
    iYear = Val(txtYear.Text)
    If iYear < 1999 Or iYear > 2050 Then
        MsgBox "您指定的年份无效，建议您重新输入！", "结转提示"
        txtYear.SetFocus
    End If
End Sub