以下是com组件
Private cn As New ADODB.Connection
Private rs As New ADODB.Recordset
Private recCount As Integer
Private saveRecCount As Integer
Private Sub Class_Initialize()
cn.Provider = "Microsoft.Jet.OLEDB.4.0"
cn.Open (App.Path & "\library.mdb")
rs.Open "Select * from popedom", cn, adOpenDynamic, adLockOptimistic
recCount = 0
Do While Not rs.EOF
rs.MoveNext
recCount = recCount + 1
Loop
If recCount > 0 Then rs.MoveFirst
End Sub
Private Sub Class_Terminate()
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
End Sub
Public Property Get myRecCount() As Integer
myRecCount = recCount
End Property
Public Property Get userName() As String
userName = rs.Fields(0)
End Property
Public Property Get userPassword() As String
userPassword = rs.Fields(1)
End Property
Public Property Get userType() As String
userType = rs.Fields(2)
End Property
Public Function userPrevious() As Integer
If recCount > 0 Then
rs.MovePrevious
If Not rs.BOF Then
myPrevious = 0
Else
rs.MoveFirst
userPrevious = -1
End If
Else
userPrevious = -1
End If
End Function
Public Function userNext() As Integer
If recCount > 0 Then
rs.MoveNext
If Not rs.EOF Then
userNext = 0
Else
rs.MoveLast
userNext = 1
End If
Else
userNext = 1
End If
End Function
Public Function userSearch(ByVal searchName As String) As Integer
rs.Filter = "User Like '" & searchName & "*'"
saveRecCount = recCount
recCount = 0
Do While Not rs.EOF
rs.MoveNext
recCount = recCount + 1
Loop
If recCount > 0 Then rs.MoveFirst
userSearch = recCount
End Function
Public Sub reSetRec()
rs.Filter = adFilterNone
recCount = saveRecCount
End Sub
Public Function userUpdate() As Integer
rs.Update
End Function
Public Function userDelete() As Integer
rs.Delete
rs.MovePrevious
End Function
Public Function userAdd() As Integer
rs.AddNew
End Function
Public Property Get myRec() As Recordset
Set myRec = rs
End Property
以下是页面代码:
Dim myData As paul.Class1
Private Function cmdAdd_onclick() As Boolean
txtUser.disabled = False
txtPassword.disabled = False
txtType.disabled = False
cmdNext.disabled = True
cmdPrevious.disabled = True
cmdModify.disabled = True
cmdDelete.disabled = True
cmdAdd.disabled = True
txtUser.focus
myData.userAdd
txtUser.Value = ""
txtPassword.Value = ""
txtType.Value = ""
End Function
Private Function cmdDelete_onclick() As Boolean
myData.userDelete
txtUser.Value = myData.userName
txtPassword.Value = myData.userPassword
txtType.Value = myData.userType
End Function
Private Function cmdUpdate_onclick() As Boolean
If txtUser.Value = "" Or txtPassword.Value = "" Or txtType.Value = "" Then
MsgBox "ÐÅÏ¢¶¼²»ÄÜΪ¿Õ£¬Çë¼ì²éÔÙÊäÈë¡£", , "Ìáʾ"
Else
myData.userUpdate
Let myData.myRec.Fields(0) = txtUser.Value
Let myData.myRec.Fields(1) = txtPassword.Value
Let myData.myRec.Fields(2) = txtType.Value
txtUser.disabled = True
txtPassword.disabled = True
txtType.disabled = True
cmdNext.disabled = False
cmdPrevious.disabled = False
cmdModify.disabled = False
cmdDelete.disabled = False
cmdAdd.disabled = False
End If
End Function
Private Function cmdGo_onclick() As Boolean
If txtSearchUser.Value <> "" Then
Dim i As Integer
i = myData.userSearch(txtSearchUser.Value)
If i > 0 Then
dspResult.innerText = "ÕÒµ½·ûºÏÌõ¼þµÄ¼Ç¼Êý£º" & i
txtUser.Value = myData.userName
txtPassword.Value = myData.userPassword
txtType.Value = myData.userType
Else
dspResult.innerText = "ûÓÐÕÒµ½·ûºÏÌõ¼þµÄ¼Ç¼¡£"
End If
Else
MsgBox "ÇëÊäÈëÒª²éÕҵĹؼü´Ê¡£", , "Ìáʾ"
End If
End Function
Private Function cmdModify_onclick() As Boolean
txtUser.disabled = False
txtPassword.disabled = False
txtType.disabled = False
cmdNext.disabled = True
cmdPrevious.disabled = True
cmdModify.disabled = True
cmdDelete.disabled = True
cmdAdd.disabled = True
txtUser.focus
End Function
Private Function cmdNext_onclick() As Boolean
If myData.userNext = 0 Then
txtUser.Value = myData.userName
txtPassword.Value = myData.userPassword
txtType.Value = myData.userType
End If
End Function
Private Function cmdPrevious_onclick() As Boolean
If myData.userPrevious = 0 Then
txtUser.Value = myData.userName
txtPassword.Value = myData.userPassword
txtType.Value = myData.userType
End If
End Function
Private Function cmdRecAll_onclick() As Boolean
If Not dspResult.innerText = "µ±Ç°¼Ç¼×ÜÊý£º" & myData.myRecCount Then
myData.reSetRec
dspResult.innerText = "µ±Ç°¼Ç¼×ÜÊý£º" & myData.myRecCount
txtUser.Value = myData.userName
txtPassword.Value = myData.userPassword
txtType.Value = myData.userType
Else
cmdRecAll.disabled = False
End If
End Function
Private Sub DHTMLPage_Load()
Set myData = New paul.Class1
dspResult.innerText = "µ±Ç°¼Ç¼×ÜÊý£º" & myData.myRecCount
txtUser.Value = myData.userName
txtPassword.Value = myData.userPassword
txtType.Value = myData.userType
End Sub
Private Sub DHTMLPage_Unload()
Set myData = Nothing
End Sub
[此贴子已经被作者于2006-12-8 10:01:21编辑过]