frmgetsome.frm

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

Dim pos2 As Integer         '记录第二个"/"在UserStr中的位置

    If UserStr = "" Then
        Exit Sub
    End If
    
    insBuildID = Trim(cmbBuild.List(cmbBuild.ListIndex))
    pos1 = InStr(1, UserStr, "/")
    If pos1 = 0 Then
        Exit Sub
    End If
    If Len(UserStr) <= pos1 Then
        Exit Sub
    End If
    pos2 = InStr(pos1 + 1, UserStr, "/")
    If pos2 = 0 Then
        Exit Sub
    End If
    
    temStr = Trim(Left(UserStr, pos1 - 1))
    If IsNumeric(temStr) Then
        insUserID = Val(temStr)
    Else
        Exit Sub
    End If
    
    insUserName = Trim(Mid(UserStr, pos1 + 1, pos2 - pos1 - 1))
    
    temStr = Trim(Right(UserStr, Len(UserStr) - pos2))
    If IsNumeric(temStr) Then
        insAddress = Val(temStr)
    Else
        Exit Sub
    End If
    
    datUser.Recordset.FindFirst "UserID=" + Format(insUserID) '+ " and Address=" + Format(insAddress)
    If Not datUser.Recordset.NoMatch Then
        Exit Sub
    End If
    datUser.Recordset.AddNew
    datUser.Recordset!BuildID = insBuildID
    datUser.Recordset!UserID = insUserID
    datUser.Recordset!userName = insUserName
    datUser.Recordset!Address = insAddress
    datUser.Recordset.Update
    datUser.Refresh
End Sub

Private Sub cmbBuild_Click()
Dim temUserStr As String
Dim curDoor As String
Dim curUnit As String
Dim curFloor As String
Dim curName As String
Dim curAddr As String

    SQL = "select * "
    SQL = SQL + "from UserMap "
    SQL = SQL + "where BuildID=""" + Trim(cmbBuild.List(cmbBuild.ListIndex)) + """ "
    SQL = SQL + "order by val(Unit) ASC,val(Floor) ASC,val(Door) ASC "
    Set rcTemUserMap = dbCbb.OpenRecordset(SQL)
    
    lstUser.Clear
    lblSum = ""
    Do While Not rcTemUserMap.EOF

        If IsNull(curUnit) Then
            curUnit = ""
        Else
            curUnit = Trim(rcTemUserMap!Unit)
        End If
        If IsNull(rcTemUserMap!Floor) Then
            curFloor = ""
        Else
            curFloor = Trim(rcTemUserMap!Floor)
        End If
        If IsNull(rcTemUserMap!Door) Then
            curDoor = ""
        Else
            curDoor = Trim(rcTemUserMap!Door)
        End If
        If IsNull(rcTemUserMap!userName) Then
            curName = ""
        Else
            curName = Trim(rcTemUserMap!userName)
        End If
        If IsNull(rcTemUserMap!Address) Then
            curAddr = ""
        Else
            curAddr = Format(rcTemUserMap!Address)
        End If
        
        temUserStr = curUnit + "单元/" + curFloor + "层/" + curDoor + "号/" + curName + "/" + curAddr
        lstUser.AddItem temUserStr
        rcTemUserMap.MoveNext
    Loop
    lblSum = Format(rcTemUserMap.RecordCount) + " 户"
End Sub



Sub cmdAdd_Click()
    If lstUser.SelCount > 0 Then
        For i = 0 To lstUser.ListCount - 1
            If lstUser.Selected(i) Then
                InsertUser (i)
                DoEvents
            End If
        Next i
    End If
End Sub

Private Sub cmdAddAll_Click()
Dim i As Long

    For i = 0 To lstUser.ListCount - 1
        lstUser.Selected(i) = True
    Next i
    cmdAdd_Click
End Sub

Private Sub cmdCancel_Click()
    CancelCollect = True
    DelayCancel = True
    Unload frmGetSome
End Sub

Private Sub cmdDel_Click()
    If Not datUser.Recordset.EOF Then
        datUser.Recordset.Delete
        datUser.Recordset.MoveNext
        If datUser.Recordset.EOF Then
            If datUser.Recordset.RecordCount > 0 Then
                datUser.Recordset.MoveFirst
            End If
        End If
    End If
End Sub

Private Sub cmdDelAll_Click()
    SQL = "delete * from temUser"
    dbCbb.Execute SQL
    datUser.Refresh
End Sub

Private Sub cmdOK_Click()
Dim temUserIDStr As String
Dim rcTemUserData As Recordset
    gblnCollecting = True
    If BrowInfo = True Then
        frmMainInfo.lstStatus.ListItems.Clear
    End If
    gblnCollected = True
    CollectUser
    If CancelCollect Then
        gblnCollecting = False
        'Done
        Exit Sub
    End If
    QData = "temUserData"
    Set rcTemUserData = dbCbb.OpenRecordset("temuserdata", dbOpenSnapshot)
    If rcTemUserData.EOF Then
        gblnCollecting = False
        MsgBox "没有用户采集成功", , "指定用户采集"
        Exit Sub
    End If
    temUserIDStr = ""
    Do While Not rcTemUserData.EOF
        temUserIDStr = temUserIDStr + Format(rcTemUserData!UserID) + ","
        rcTemUserData.MoveNext
    Loop
    If temUserIDStr <> "" Then
        temUserIDStr = Left(temUserIDStr, Len(temUserIDStr) - 1)
    Else
        gblnCollecting = False
        Exit Sub
    End If
    SQL = "select * from UserMap "
    SQL = SQL + "where UserID in (" + temUserIDStr + ")"
    Set rcQUser = dbCbb.OpenRecordset(SQL)
    If rcQUser.EOF Then
        gblnCollecting = False
        Exit Sub
    End If
    QDate1 = Date
    QDate2 = 0
    
    showType = 2
    DevName = "所有"
    Load frmShowAll
    frmShowAll.cmdSave.Visible = True
    frmShowAll.lblLastDate.Visible = True
    frmShowAll.lblCurDate.Visible = True
    frmShowAll.cmdPrePrint.Enabled = False
    frmShowAll.cmdPrint.Enabled = False
    gblnCollecting = False
End Sub

Private Sub Command1_Click()
openDev Val(Text1.Text), Val(Text2.Text)
Delay 1, Val(Text3.Text)
closeDev Val(Text1.Text)
Delay 1, 5
closeCard
End Sub

Private Sub Command2_Click()
    captest = 1
    CollectUser
End Sub

Private Sub Command3_Click()
    captest = 2
    CollectUser
End Sub

Private Sub datUser_Reposition()
Dim rcUser As Recordset

    lblDetail = ""
    If datUser.Recordset.RecordCount > 0 Then
        If Not datUser.Recordset.EOF Then
            If datUser.Recordset.AbsolutePosition <> -1 Then
                If Not IsNull(datUser.Recordset!UserID) Then
                    datUser.Caption = datUser.Recordset.RecordCount
                    Set rcUser = dbCbb.OpenRecordset("UserMap", dbOpenSnapshot)
                    rcUser.FindFirst "UserID=" + Format(datUser.Recordset!UserID)
                    If Not rcUser.NoMatch Then
                        lblDetail = "用户号:" + Format(rcUser!UserID) + " --- " + Trim(rcUser!Unit) + "单元 " + Trim(rcUser!Floor) + "层 " + "电话:" + Trim(rcUser!Tel)
                    End If
                End If
            End If
        End If
    End If
End Sub

Private Sub Form_Load()
    captest = 0
    
    If UBound(curForm) > 0 Then
        
        curForm(UBound(curForm)).Enabled = False
    End If
    ReDim Preserve curForm(UBound(curForm) + 1)
    Set curForm(UBound(curForm)) = Me

    datUser.DatabaseName = App.Path & "\data\cbb.mdb"
    ExitFlag = False
Dim rcBuildMap As Recordset

    SQL = "delete * from temUser"
    dbCbb.Execute SQL
    SQL = "delete * from temuserdata"
    dbCbb.Execute SQL
    
    SQL = "select BuildID from BuildMap order by FrameID ASC,BuildID ASC "
    Set rcBuildMap = dbCbb.OpenRecordset(SQL)
    Do While Not rcBuildMap.EOF
        cmbBuild.AddItem Trim(rcBuildMap!BuildID)
        rcBuildMap.MoveNext
    Loop
    rcBuildMap.Close
    
    If cmbBuild.ListCount > 0 Then
        cmbBuild.Text = cmbBuild.List(0)
    End If
    
    f_frmGetSome_Visible = True
    DoEvents
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
    f_frmGetSome_Visible = False
End Sub


Private Sub lstUser_Click()
    lblDetail = ""
    If lstUser.SelCount > 0 Then
        For i = 0 To lstUser.ListCount - 1
            If lstUser.Selected(i) Then
                If rcTemUserMap.RecordCount > i Then
                    rcTemUserMap.AbsolutePosition = i
                    lblDetail = "用户号:" + Format(rcTemUserMap!UserID) + " --- " + Trim(rcTemUserMap!Unit) + "单元   " + Trim(rcTemUserMap!Floor) + "层   " + "电话:" + Trim(rcTemUserMap!Tel)
                    Exit Sub
                End If
                InsertUser (Trim(lstUser.List(i)))
            End If
        Next i
    End If
End Sub

Private Sub lstUser_DblClick()
    If lstUser.SelCount > 0 Then
        For i = 0 To lstUser.ListCount - 1
            If lstUser.Selected(i) Then
                InsertUser (i)
            End If
        Next i
    End If
End Sub