frmrwcard.frm

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

'status
            AppendStatusInfo "读终端" & curTerm & "卡用户" & rcTemUser!CardUserID & "数据", icoBLUE
            SaveLog "读终端" & curTerm & "卡用户" & rcTemUser!CardUserID & "数据", 0
            CardValue = GetCardData(i, rcTemUser!CardUserID)
            If CardValue < 0 Then
'status
                AppendStatusInfo "读终端" & curTerm & "卡用户" & _
                    rcTemUser!CardUserID & "数据" & _
                    "(无效数据)", icoRED
                SaveLog "读终端" & curTerm & "卡用户" & _
                    rcTemUser!CardUserID & "数据" & _
                    "(无效数据)", 1
                ReadCard = False
                Exit Function
            End If
            rcDevsMap.FindFirst "TypeID=" + Format(rcTemUser!DevType)
            If rcDevsMap.NoMatch Then
                curDevName = ""
            Else
                curDevName = rcDevsMap!Name
            End If
            
            datCard.Recordset.AddNew
            datCard.Recordset!BuildID = rcTemUser!BuildID
            datCard.Recordset!Unit = rcTemUser!Unit
            datCard.Recordset!Door = rcTemUser!Door
            datCard.Recordset!CardTermID = curTerm
            datCard.Recordset!CardUserID = rcTemUser!CardUserID
            datCard.Recordset!Value = CardValue
            datCard.Recordset!DevTypeID = rcTemUser!DevType
            datCard.Recordset!DevType = curDevName
            datCard.Recordset.Update
            rcTemUser.AbsolutePosition = curCardUserID
        Next curCardUserID
Next_Term:
    Next i
    
    If cmbTermID.ListCount > 0 Then
        cmbTermID.Text = cmbTermID.List(0)
    Else
        cmbTermID.Text = ""
    End If
    ReloadGrid
    
    ReadCard = True
End Function

Sub ReloadGrid()
Dim SQL As String
Dim cond As String

    SQL = "select * from temCardData "
    If cmbTermID.ListCount <= 0 Then
        curTerm = ""
        SQL = ""
    Else
        If Trim(cmbTermID.List(cmbTermID.ListIndex)) = "全部" Then
            cond = ""
        Else
            cond = "where CardTermID=" + Trim(cmbTermID.List(cmbTermID.ListIndex)) + " "
        End If
        SQL = SQL + cond + "order by CardTermID,CardUserID "
    End If
    
    datCard.RecordSource = SQL
    datCard.Refresh
    grdCard.Refresh
End Sub

Sub SaveCardData()
Dim rcUserData As Recordset
Dim rcUserData2 As Recordset
Dim rcUserDev As Recordset
Dim SQL As String
Dim saveValue As Long

    Set rcUserData = dbCbb.OpenRecordset("UserData", dbOpenDynaset)
    Set rcUserData2 = dbCbb.OpenRecordset("UserData2", dbOpenDynaset)
    SQL = "select DevID from UserDev "
    SQL = SQL + "where UserDev.UserID=" + Format(curUserID) + " "
    SQL = SQL + "order by DevID "
    Set rcUserDev = dbCbb.OpenRecordset(SQL)
    
    If rcUserDev.EOF Or rcUserDev.RecordCount <= 0 Then
        Exit Sub
    End If
    
    rcUserDev.MoveFirst
    Do While Not rcUserDev.EOF
        If rcUserDev!devID = curDevID Then
            saveValue = datCard.Recordset!Value
        Else
            saveValue = 0
        End If
        
        rcUserData.FindFirst "UserID=" + Format(curUserID) + " and DevID=" + Format(rcUserDev!devID) + " and Date=#" + g_SelDate + "#"
        If rcUserData.NoMatch Then
            rcUserData.AddNew
            rcUserData!UserID = curUserID
            rcUserData!devID = rcUserDev!devID
            rcUserData!Value = saveValue
            rcUserData!Date = CDate(g_SelDate)
            rcUserData!Status = 1
            rcUserData.Update
        Else
            If rcUserDev!devID = curDevID Then
                rcUserData.Edit
                rcUserData!UserID = curUserID
                rcUserData!devID = rcUserDev!devID
                rcUserData!Value = saveValue
                rcUserData!Date = CDate(g_SelDate)
                rcUserData!Status = 1
                rcUserData.Update
            End If
        End If
    
        rcUserData2.FindFirst "UserID=" + Format(curUserID) + " and DevID=" + Format(rcUserDev!devID) + " and Date=#" + g_SelDate + "#"
        If rcUserData2.NoMatch Then
            rcUserData2.AddNew
            rcUserData2!UserID = curUserID
            rcUserData2!devID = rcUserDev!devID
            rcUserData2!Value = saveValue
            rcUserData2!Date = CDate(g_SelDate)
            rcUserData2!Status = 1
            rcUserData2.Update
        Else
            If rcUserDev!devID = curDevID Then
                rcUserData2.Edit
                rcUserData2!UserID = curUserID
                rcUserData2!devID = rcUserDev!devID
                rcUserData2!Value = saveValue
                rcUserData2!Date = CDate(g_SelDate)
                rcUserData2!Status = 1
                rcUserData2.Update
            End If
        End If
        
        rcUserDev.MoveNext
    Loop
    Set rcUserData = Nothing
    Set rcUserData2 = Nothing
End Sub
Private Sub cmbTermID_Click()
    ReloadGrid
End Sub


Private Sub cmdClear_Click()
    If MsgBox("确定要清空当前数据卡吗?", 32 + 4, "清空数据卡") = 7 Then
        Exit Sub
    End If
    If Not InitICDev Then
        Exit Sub
    End If
    
    ClearCard
End Sub

Private Sub cmdRead_Click()
Dim SQL As String
    SQL = "delete all * from temCardData "
    dbCbb.Execute SQL
    datCard.Refresh
    
    If Not InitICDev Then
        Exit Sub
    End If
    If Not chkDataCard Then
        Exit Sub
    End If
    
    If Not ReadCard Then
        Exit Sub
    End If
    
    cmdSave.Enabled = True
End Sub

Private Sub cmdReturn_Click()
    Unload frmRWCard
End Sub

Private Sub cmdSave_Click()
    msgBack1 = 1
    If datCard.Recordset.RecordCount <= 0 Then
        MsgBox "没有读入任何有效数据" + Chr(10) + Chr(13) + "保存操作没有进行!", , "保存数据"
        Exit Sub
    End If
    
    frmSaveDate.Show
    If g_SelDate = "" Then
        MsgBox "没有选择有效的保存日期" + Chr(10) + Chr(13) + "保存操作未进行!", , "保存数据"
        Exit Sub
    Else
        If Not IsDate(CDate(g_SelDate)) Then
            MsgBox "没有选择有效的保存日期" + Chr(10) + Chr(13) + "保存操作未进行!", , "保存数据"
            Exit Sub
        End If
    End If
    
Dim curBuild As String
Dim curUnit As String
Dim curDoor As String
Dim curType As Integer
Dim curTypeName As String
Dim rcUserMap As Recordset
Dim rcUserDev As Recordset
Dim rcUserData As Recordset

'status
    AppendStatusInfo "保存卡内数据至数据库", icoBLUE
    SaveLog "保存卡内数据至数据库", 0
    
    Set rcUserMap = dbCbb.OpenRecordset("UserMap", dbOpenSnapshot)
    Set rcUserDev = dbCbb.OpenRecordset("UserDev", dbOpenSnapshot)
    Set rcUserData = dbCbb.OpenRecordset("UserData", dbOpenDynaset)
    
    datCard.Recordset.MoveFirst
    Do While Not datCard.Recordset.EOF
        curBuild = Trim(datCard.Recordset!BuildID)
        curUnit = Trim(datCard.Recordset!Unit)
        curDoor = Trim(datCard.Recordset!Door)
        curType = datCard.Recordset!DevTypeID
        curTypeName = Trim(datCard.Recordset!DevType)
'FIND 'curUserID'
        rcUserMap.FindFirst "trim(BuildID)=""" + curBuild + """ and trim(Unit)=""" + curUnit + """ and trim(Door)=""" + curDoor + """"
        If rcUserMap.NoMatch Then
'status
            AppendStatusInfo "没有找到符合条件的用户---楼:" + curBuild + "/单元:" + curUnit + "/门牌:" + curDoor, icoRED
            SaveLog "没有找到符合条件的用户---楼:" + curBuild + "/单元:" + curUnit + "/门牌:" + curDoor, 1
            If MsgBox("没有找到符合条件的用户" + Chr(10) + "楼:" + curBuild + "/单元:" + curUnit + "/门牌:" + curDoor + Chr(10) + "是否跳过该用户继续?", 48 + 4, "保存数据") = 7 Then
                Exit Do
            Else
                GoTo NextUser
            End If
        End If
        curUserID = rcUserMap!UserID
        
'FIND 'curDevID'
        rcUserDev.FindFirst "UserID=" + Format(curUserID) + " and devType=" + Format(curType)
        If rcUserDev.NoMatch Then
'status
            AppendStatusInfo "该用户设置中没有此种表---楼:" + curBuild + "/单元:" + curUnit + "/门牌:" + curDoor, icoRED
            SaveLog "该用户设置中没有此种表---楼:" + curBuild + "/单元:" + curUnit + "/门牌:" + curDoor, 1
            If MsgBox("该用户设置中没有此种表" + Chr(10) + "楼:" + curBuild + "/单元:" + curUnit + "/门牌:" + curDoor + Chr(10) + "是否跳过该用户继续?", 48 + 4, "保存数据") = 7 Then
                Exit Do
            Else
                GoTo NextUser
            End If
        End If
        curDevID = rcUserDev!devID
        
        rcUserData.FindFirst "UserID=" + Format(curUserID) + " and DevID=" + Format(curDevID) + " and Date=#" + g_SelDate + "#"
        If rcUserData.NoMatch Then
            SaveCardData
        Else
            If msgBack1 <> 2 Then
                msgSave = "楼:" + curBuild + "/单元:" + curUnit + "/门牌:" + curDoor + "/用户号:" + Format(curUserID) + "/表型:" + Trim(curTypeName) + "/日期:" + g_SelDate
                frmSaveMsg1.Show 1
            End If
            Select Case msgBack1
                Case 1, 2
                    SaveCardData
                Case 3
                    GoTo NextUser
                Case 4
                    Exit Do
            End Select
        End If
NextUser:
        datCard.Recordset.MoveNext
    Loop
'status
    AppendStatusInfo "数据保存操作完成", icoBLUE
    SaveLog "数据保存操作完成", 0
    MsgBox "数据保存操作完成!", , "保存数据"
    
    Set rcUserMap = Nothing
    Set rcUserDev = Nothing
    Set rcUserData = Nothing
End Sub


Private Sub Form_Load()
    If UBound(curForm) > 0 Then
        curForm(UBound(curForm)).Enabled = False
    End If
    ReDim Preserve curForm(UBound(curForm) + 1)
    Set curForm(UBound(curForm)) = Me
    
    
    datCard.DatabaseName = App.Path & "\data\cbb.mdb"
'IC卡初始化值
    IC_DataPage = 8
    IC_BytesPerPage = 256
    IC_BaseAddr = (IC_DataPage - 1) * IC_BytesPerPage
    icdev = -1
    
Dim SQL As String
    SQL = "delete all * from temCardData "
    dbCbb.Execute SQL
    
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 icdev > 0 Then
        IC_ExitComm (icdev)
    End If
Dim SQL As String
    SQL = "delete all * from temCardData "
    dbCbb.Execute SQL
End Sub