frmshowall.frm

一个功能比较完善的远程抄表软件

    SQL = "select * from DevsMap order by TypeID ASC "
    Set rcDevsMap = dbCbb.OpenRecordset(SQL)
    If rcDevsMap.EOF Then
        Exit Sub
    End If
    Set curGrid = grdData1
    paintGrd
    rcDevsMap.Close
End Sub
Private Sub cmdOK_Click()
    frmGetSome.Enabled = True
    Unload frmShowAll
End Sub

Private Sub cmdPrePrint_Click()
On Error GoTo ProcError
    If Dir$(App.Path & "\data\userdata.rpt", 0) = "" Then
'status
        AppendStatusInfo "找不到系统报表文件""DATA\USERDATA.RPT"",无法进行打印预览", icoRED
        SaveLog "找不到系统报表文件""DATA\USERDATA.RPT"",无法进行打印预览", 1
        MsgBox "找不到系统报表文件""DATA\USERDATA.RPT""" + Chr(10) + "无法进行打印预览", 48, "打印预览"
        Exit Sub
    End If
'status
    AppendStatusInfo "生成CBB系统计费结算预览", icoBLUE
    SaveLog "生成CBB系统计费结算预览", 0
    rptUserData.ReportFileName = App.Path & "\data\userdata.rpt"
    rptUserData.DataFiles(0) = App.Path & "\data\cbb.mdb"
    rptUserData.WindowTitle = "CBB系统计费结算预览"
    rptUserData.Destination = 0
    If DevName <> "所有" Then
        rptUserData.SelectionFormula = "{DevsMap.Name}='" & DevName & "'"
    Else
        rptUserData.SelectionFormula = ""
    End If
    rptUserData.Action = 1
    DoEvents
    Exit Sub
ProcError:
    ProcErr
End Sub

Private Sub cmdPrint_Click()
On Error GoTo ProcError
    If Dir$(App.Path & "\data\userdata.rpt", 0) = "" Then
'status
        AppendStatusInfo "找不到系统报表文件""DATA\USERDATA.RPT"",无法进行打印", icoRED
        SaveLog "找不到系统报表文件""DATA\USERDATA.RPT"",无法进行打印", 1
        MsgBox "找不到系统报表文件""DATA\USERDATA.RPT""" + Chr(10) + "无法进行打印", 48, "打印"
        Exit Sub
    End If
'status
    AppendStatusInfo "打印CBB系统计费结算", icoBLUE
    SaveLog "打印CBB系统计费结算", 0
    rptUserData.ReportFileName = App.Path & "\data\userdata.rpt"
    rptUserData.DataFiles(0) = App.Path & "\data\cbb.mdb"
    rptUserData.WindowTitle = "CBB系统计费结算预览"
    rptUserData.Destination = 1
    If DevName <> "所有" Then
        rptUserData.SelectionFormula = "{DevsMap.Name}='" & DevName & "'"
    Else
        rptUserData.SelectionFormula = ""
    End If
    rptUserData.Action = 1
    DoEvents
    Exit Sub
ProcError:
    ProcErr
    End Sub

Private Sub cmdSave_Click()
On Error GoTo ProcError
    frmSaveDate.Show 1
    If Not g_IsSaveData Then Exit Sub
    
Dim rcTemUserData As Recordset
Dim rcTemUserID As Recordset
Dim rcUserData As Recordset
Dim rcUserDatas As Recordset
Dim rcUserMap As Recordset
Dim fSaveAll As Boolean
Dim temUserAddress As Long
    temUserAddress = 0

'status
    AppendStatusInfo "保存指定用户采集数据", icoBLUE
    SaveLog "保存指定用户采集数据", 0

    fSaveAll = True
    
    FOveride = 2        'frmOveride返回码(0-Yes,1-YesToAll,2-No,3-Cancel)
    Set rcTemUserData = dbCbb.OpenRecordset("temUserdata", dbOpenSnapshot)
    Set rcUserData = dbCbb.OpenRecordset("UserData", dbOpenDynaset)
    Set rcUserData2 = dbCbb.OpenRecordset("UserData2", dbOpenDynaset)
    Set rcUserMap = dbCbb.OpenRecordset("userMap", dbOpenSnapshot)
    
    SQL = "select distinct UserId from temUserData "
    Set rcTemUserID = dbCbb.OpenRecordset(SQL)
    Do While Not rcTemUserID.EOF
        rcUserData.FindFirst "UserID=" & Format(rcTemUserID!UserID) _
            & " and format(Date,""yyyy-mm-dd"")=""" & Format(g_SelDate, "yyyy-mm-dd") & """"
'status
        AppendStatusInfo "保存用户" & rcTemUserID!UserID _
            & "日期" & g_SelDate & "数据", icoBLUE
        SaveLog "保存用户" & rcTemUserID!UserID _
            & "日期" & g_SelDate & "数据", 0
        If Not rcUserData.NoMatch Then
'status
            AppendStatusInfo "发现用户" & rcTemUserID!UserID _
                & "日期" & g_SelDate & "数据已存在", icoYELLOW
            SaveLog "发现用户" & rcTemUserID!UserID _
                & "日期" & g_SelDate & "数据已存在", 2
            If FOveride <> 1 Then
                Load frmOveride
                frmOveride.lblUser.Caption = "用户" _
                    & Format(rcTemUserID!UserID) & ",日期" _
                    & Format(g_SelDate, "yyyy-mm-dd") & "的数据已经存在,是否覆盖?"
                frmOveride.Show 1
            End If
            Select Case FOveride
                Case 0, 1           '要覆盖,从UserData中清除数据
'status
                    AppendStatusInfo "覆盖用户" & rcTemUserID!UserID _
                        & "日期" & Format(g_SelDate, "yyyy-mm-dd") & "数据", icoYELLOW
                    SaveLog "覆盖用户" & rcTemUserID!UserID _
                        & "日期" & Format(g_SelDate, "yyyy-mm-dd") & "数据", 2
                    
                    SQL = "delete * from UserData "
                    SQL = SQL & "where UserID=" & Format(rcTemUserID!UserID) _
                        & " and format(Date,""yyyy-mm-dd"")=""" & Format(g_SelDate, "yyyy-mm-dd") & """"
                    dbCbb.Execute SQL
                    Set rcUserData = dbCbb.OpenRecordset("UserData", dbOpenDynaset)
                    
                    SQL = "delete * from UserData2 "
                    SQL = SQL & "where UserID=" & Format(rcTemUserID!UserID) _
                        & " and format(Date,""yyyy-mm-dd"")=""" & Format(g_SelDate, "yyyy-mm-dd") & """"
                    dbCbb.Execute SQL
                    Set rcUserData2 = dbCbb.OpenRecordset("UserData2", dbOpenDynaset)
                    
                    GoTo SaveData
                Case 2              '选择No跳过此用户
'status
                    AppendStatusInfo "跳过不覆盖用户" & rcTemUserID!UserID _
                        & "日期" & Format(g_SelDate, "yyyy-mm-dd") & "数据", icoYELLOW
                    SaveLog "跳过不覆盖用户" & rcTemUserID!UserID _
                        & "日期" & Format(g_SelDate, "yyyy-mm-dd") & "数据", 2
                    fSaveAll = False
                    GoTo NextUser
                Case 3              '选择Cancel取消之后的所有操作
                    fSaveAll = False
            End Select
        Else
SaveData:                   '保存当前用户数据
            rcTemUserData.FindFirst "UserID=" & Format(rcTemUserID!UserID)
            Do While Not rcTemUserData.NoMatch
                rcUserData.AddNew
                rcUserData!UserID = rcTemUserData!UserID
                rcUserData!devID = rcTemUserData!devID
                rcUserData!Value = rcTemUserData!Value
                rcUserData!Date = g_SelDate
                rcUserData!Status = 0
                rcUserData.Update
                
                rcUserData2.AddNew
                rcUserData2!UserID = rcTemUserData!UserID
                rcUserData2!devID = rcTemUserData!devID
                rcUserData2!Value = rcTemUserData!Value
                rcUserData2!Date = g_SelDate
                rcUserData2!Status = 0
                rcUserData2.Update
                
'                rcUserMap.FindFirst "UserID=" & rcTemUserData!UserID
'                If Not rcUserMap.NoMatch Then
'                    temUserAddress = rcUserMap!Address
'                Else
'                    temUserAddress = 0
'                End If
                
                UpdateUserFee rcTemUserData!UserID, _
                    rcTemUserData!devID, rcTemUserData!Value
                
                rcTemUserData.FindNext "UserID=" & Format(rcTemUserID!UserID)
            Loop

        End If
'status
'        AppendStatusInfo "更新用户计费", icoBLUE
'        SaveLog "", 0
NextUser:
        rcTemUserID.MoveNext
    Loop
'status
    AppendStatusInfo "另存数据完成", icoBLUE
    SaveLog "另存数据完成", 0
    MsgBox "另存数据完成!", 64, "另存数据"
    FreshUserStatus
    
    If fSaveAll Then
        cmdPrePrint.Enabled = True
        cmdPrint.Enabled = True
    End If
    Exit Sub
ProcError:
    ProcErr
End Sub


Private Sub Form_Load()
On Error GoTo ProcError
    If UBound(curForm) > 0 Then
        curForm(UBound(curForm)).Enabled = False
    End If
    ReDim Preserve curForm(UBound(curForm) + 1)
    Set curForm(UBound(curForm)) = Me
    
    Dim rcData As Recordset
    If BrowInfo = True Then
        frmMainInfo.Enabled = False
    End If
    
    CancelBrowse = False

    lblCurDate = "当前日期:" + Format(Date, "yyyy/m/d")
    Set rcData = dbCbb.OpenRecordset("UserData", dbOpenSnapshot)
    If Not (rcData.RecordCount > 0) Then
        lblLastDate = ""
    Else
        SQL = "select max(Date) as maxDate from UserData"
        Set rcDate = dbCbb.OpenRecordset(SQL)
        If Not rcDate.EOF Then
            If IsNull(rcDate.Fields(0)) Then
                GoTo No_Date
            End If
            LatestDate = rcDate.Fields(0)
            lblLastDate.Caption = "最近数据日期:" + Format(LatestDate, "yyyy/m/d")
        Else
No_Date:
            LatestDate = Date
            lblLastDate.Caption = ""
        End If
    End If
    
'---------------------------------------------------------------------
    frmShowAll.Width = 8670
    frmShowAll.Height = 5670
    frmShowAll.Left = 405
    frmShowAll.Top = 0
    
    If QDate1 = 0 And QDate2 = 0 Then
        MsgBox "没有指定有效的数据日期", , "查询用户数据"
        Exit Sub
    End If
    DateLater = IIf(QDate1 >= QDate2, QDate1, QDate2)
    DateFormer = IIf(QDate1 = QDate2, 0, IIf(QDate1 < QDate2, QDate1, QDate2))

    prePaint        '布置表单
'status
    AppendStatusInfo "查看用户数据,日期一:" & DateLater & " 日期二:" & DateFormer, icoBLUE
    SaveLog "查看用户数据,日期一:" & DateLater & " 日期二:" & DateFormer, 0

    If rcQUser.EOF Then
        MsgBox "没有找到符合条件的数据", , "用户数据查询"
        Unload frmShowAll
    Else
        frmShowAll.Show
        
        frmWait.Show
        MousePointer = 11
        
        frmWait.prgCollected.Value = 0
        fillUserRpt
        FillgrdData1
          
        If CancelBrowse Then
            GoTo EndLoad
        End If
        
        Unload frmWait
        
        lblUserSum = "用户数:" + Format(grdData1.Rows - 1)
    End If
EndLoad:
    MousePointer = 0
    Set rcUserMap = dbCbb.OpenRecordset("UserMap", dbOpenSnapshot)
    DoEvents
    Exit Sub
ProcError:
    ProcErr
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ReDim Preserve curForm(UBound(curForm) - 1)
    If UBound(curForm) > 0 Then
        curForm(UBound(curForm)).Enabled = True
    End If
    If gJPGShow Then
        Unload frmJPG
    End If
End Sub

Private Sub grdData1_Click()
On Error GoTo ProcError
Dim temCol As Integer
Dim curUserID As Integer
Dim curStatus As Integer

    If grdData1.Row > 0 Then
        temCol = grdData1.Col
        grdData1.Col = 0
        curUserID = Val(grdData1.Text)
        rcUserMap.FindFirst "UserID=" + Format(curUserID)
        If Not rcUserMap.NoMatch Then
            If IsNull(rcUserMap!Status) Then
                curStatus = 0
            Else
                curStatus = rcUserMap!Status
            End If
            lblUserInfo.Caption = "用户号:" + Trim(rcUserMap!UserID) + "  " + Trim(rcUserMap!BuildID) + "楼  " + Trim(rcUserMap!Unit) + "单元  " + Trim(rcUserMap!Floor) + "层  " + "  地址:" + Format(rcUserMap!Address) + "  状态:" + getStatusStr(curStatus)
        Else
            lblUserInfo.Caption = ""
        End If
        grdData1.Col = temCol
    End If
    Exit Sub
ProcError:
    ProcErr
End Sub