adovb.frm

vb下数据库的读取范例

   '--------------
   ' Field Object
   '--------------
   
   List1.AddItem "*** *** *** *** *** Dumping contents of the Properties Collection for the Field object *** *** *** *** ***"

   For i = 0 To Rs1.Fields(0).Properties.Count - 1
      List1.AddItem vbTab & "Name = " & Rs1.Fields(0).Properties(i).Name
      List1.AddItem vbTab & "       Type = " & GetType(Rs1.Fields(0).Properties(i).Type)
      List1.AddItem vbTab & "       Value = " & Rs1.Fields(0).Properties(i).Value
      List1.AddItem vbTab & "       Attributes = " & GetPropertyAttributes(Rs1.Fields(0).Properties(i).Attributes)
   Next

   ' Successful Shutdown
   List1.AddItem "*** Success! ***"
   Rs1.Close
   Conn1.Close

Done:
   '----------------------------------
   ' Miscellaneous (graceful) Cleanup
   ' with quiet error trapping
   '----------------------------------
   
   On Error Resume Next
      
   Set Rs1 = Nothing
   Set Cmd1 = Nothing
   Set Conn1 = Nothing
   
   Exit Sub
   
' ADO Error/Exception Handler
AdoError:
   ErrNumber = Err.Number
   ErrSource = Err.Source
   ErrDescription = Err.Description

   AdoErrorEx List1, Conn1
   
' Non-ADO Native error/exception handler
VbError:
   VbErrorEx List1, ErrNumber, ErrSource, ErrDescription
   GoTo Done

End Sub

Private Sub cmdTemplate_Click()
   ' Using the helper routines, this shows what a typical
   ' code fragment using ADO would need in order to provide
   ' accurate error handling.  Storage of the Err object
   ' members is needed, in this case, because the ERR object
   ' gets refreshed in the process of displaying an ADO raised
   ' error.
   
   Dim Conn1 As ADODB.Connection
   Dim Cmd1 As ADODB.Command
   Dim Rs1 As ADODB.Recordset
   
   ' Trap (non-ADO) error/exceptions
   On Error GoTo VbError
   
   '------------------------
   ' Open Connection Object
   '------------------------
   
   ' Warm & Fuzzy for user
   List1.Clear
   List1.AddItem "ADO Code Template..."
   
   ' Create Connection Object (using early binding)
   Set Conn1 = New ADODB.Connection
   
   ' Trap any error/exception now that we have a conneciton object
   On Error GoTo AdoError
   
   Conn1.ConnectionString = AccessConnect
   Conn1.Open
   
   ' Successful Shutdown
   Conn1.Close
   
   '----------------------
   ' YOUR CODE GOES HERE!
   ' (in this case a little dummy code to throw some errors
   '----------------------
   List1.AddItem "...delibratly generating a dummy error"
   
   Dim Conn2 As New ADODB.Connection
   Conn2.Open
   
Done:
   '----------------------------------
   ' Miscellaneous (graceful) Cleanup
   ' with quiet error trapping
   '----------------------------------
   
   On Error Resume Next
      
   Set Rs1 = Nothing
   Set Conn2 = Nothing
   Set Conn1 = Nothing
   
   Exit Sub
   
' ADO Error/Exception Handler
AdoError:
   ErrNumber = Err.Number
   ErrSource = Err.Source
   ErrDescription = Err.Description

   AdoErrorEx List1, Conn1
   
' Non-ADO Native error/exception handler
VbError:
   VbErrorEx List1, ErrNumber, ErrSource, ErrDescription
   GoTo Done

End Sub


Private Sub cmdSQLServer_Click()
   Dim Conn1 As ADODB.Connection
   Dim Cmd1 As ADODB.Command
   Dim Param1 As ADODB.Parameter
   Dim Param2 As ADODB.Parameter
   Dim Param3 As ADODB.Parameter
   Dim Rs1 As ADODB.Recordset
   
   Dim SQLServerName As String
   
   Dim SQLDrop As String
   Dim SQLCreate As String
   
   Dim i As Integer
   Dim l As Long
   Dim strTmp As String
      
   ' Trap (non-ADO) error/exceptions
   On Error GoTo VbError
   
   '----------------------------------------
   ' Define Connection string to SQL Server
   '----------------------------------------
      
   SQLServerName = InputBox("Enter name of SQL Server on your network:", _
                          "Select SQL Server", _
                          "SpringHill")
                          
   If (Len(SQLServerName) = 0) Then
      GoTo Done
   End If
      
   SQLServerConnect = "driver={sql server};" & _
                      "server=" & SQLServerName & ";" & _
                      "Database=pubs;" & _
                      "PWD=;UID=sa;"
   
   '------------------------
   ' Open Connection Object
   '------------------------
   
   ' Warm & Fuzzy for user
   List1.Clear
   List1.AddItem "Demonstrating Return, Input and Output parameters..."
   List1.AddItem vbTab & "...Assumes SQL Server named " & SQLServerName
   List1.AddItem vbTab & "...With Error Handling Using Connection Object"
   List1.AddItem vbTab & "...uses stored procedure sp_AdoTest"
   
   ' Create Connection Object and open it
   Set Conn1 = New ADODB.Connection
   
   ' Trap any error/exception
   On Error GoTo AdoError
   
   Conn1.ConnectionString = SQLServerConnect
   Conn1.Open

   '--------------------------
   ' Create Stored Procedures
   '--------------------------
   
   ' Define stored procedures the rest of this sample will use
   SQLDrop = "if exists " & _
               "(select * from sysobjects where " & _
               "id = object_id('dbo.sp_AdoTest') and " & _
               "sysstat & 0xf = 4)" & _
               "drop procedure dbo.sp_AdoTest"
   SQLCreate = "create proc sp_AdoTest( @InParam int, @OutParam int OUTPUT ) " & _
               "as " & _
               "select @OutParam = @InParam + 10SELECT * FROM Authors WHERE " & _
               "State <> 'CA' " & _
               "return @OutParam +10"
   
   List1.AddItem "Creating Stored Procedure..."
   
   Set Rs1 = Conn1.Execute(SQLDrop, l, adCmdText)
   Set Rs1 = Nothing
   
   Set Rs1 = Conn1.Execute(SQLCreate, l, adCmdText)
   Set Rs1 = Nothing

   '-----------------------------------
   ' Open Parameterized Command Object
   '-----------------------------------
   
   List1.AddItem "Opening a ForwardOnly Recordset from a Parameterized Command Object..."
   List1.AddItem "...creating command object"
     
   Set Cmd1 = New ADODB.Command
   Cmd1.ActiveConnection = Conn1
   Cmd1.CommandText = "{?=call sp_AdoTest(?, ?)}"
   
   ' Note that order of parameters collection for direction MUST match the order
   ' of parameters given in our CommandText property(!)
   List1.AddItem "...filling parameters collection"
   
   Set Param1 = Cmd1.CreateParameter(, adInteger, adParamReturnValue)
   Cmd1.Parameters.Append Param1
   
   Set Param2 = Cmd1.CreateParameter(, adInteger, adParamInput)
   Param2.Value = 10
   Cmd1.Parameters.Append Param2
   
   Set Param3 = Cmd1.CreateParameter(, adInteger, adParamOutput)
   Cmd1.Parameters.Append Param3
   
   List1.AddItem "...opening Recordset"
   Set Rs1 = Cmd1.Execute()
   
   ' Display Parameters Collection
   
   List1.AddItem "...Dumping Recordset"

   ' Dump the recordset
   While (Rs1.EOF = False)
      strTmp = ""
      For i = 0 To Rs1.Fields.Count - 1
         If (Len(strTmp) > 0) Then
            strTmp = strTmp & " | "
         End If
         
         ' Empty string in case value is empty
         strTmp = strTmp & Rs1(i) & ""
      Next i
      
      List1.AddItem vbTab & strTmp
      
      Rs1.MoveNext
   Wend
         
   Set Rs1 = Nothing
   
   List1.AddItem "...Dumping value of parameters after setting recordset variable to nothing"
   List1.AddItem "    NOTE:  Reading the value property of Pameter 0 or 2 before destroying "
   List1.AddItem "    the recordset would have resulted in thier being incorrectly assigned "
   List1.AddItem "    to a null value.  You have to destroy the recordset before checking the "
   List1.AddItem "    value of Output or Return parameters(!)"

   List1.AddItem vbTab & "RetVal Param = " & Cmd1.Parameters(0).Value
   List1.AddItem vbTab & "Input  Param = " & Cmd1.Parameters(1).Value
   List1.AddItem vbTab & "Output Param = " & Cmd1.Parameters(2).Value
      
   ' Successful Shutdown
   List1.AddItem "*** Success! ***"
   Conn1.Close
   
Done:
   '----------------------------------
   ' Miscellaneous (graceful) Cleanup
   ' with quiet error trapping
   '----------------------------------
   
   On Error Resume Next
      
   Set Rs1 = Nothing
   Set Param1 = Nothing
   Set Param2 = Nothing
   Set Param3 = Nothing
   Set Conn1 = Nothing
   
   Exit Sub

' ADO Error/Exception Handler
AdoError:
   ErrNumber = Err.Number
   ErrSource = Err.Source
   ErrDescription = Err.Description

   AdoErrorEx List1, Conn1
   
' Non-ADO Native error/exception handler
VbError:
   VbErrorEx List1, ErrNumber, ErrSource, ErrDescription
   GoTo Done

End Sub