adovbex.bas

vb下数据库的读取范例

Attribute VB_Name = "AdoVBEx"
Sub AdoErrorEx(List1 As ListBox, Conn1 As ADODB.Connection)

   Dim Errs1 As ADODB.Errors
   Dim errLoop As Error
   Dim i As Long
   
   i = 1
   On Error Resume Next
   
   ' For any error condition, show results to user
   List1.AddItem "*** ADO ERROR CONDITION! ***"
   
   ' Enumerate Errors collection and display properties of each Error object.
   Set Errs1 = Conn1.Errors
   For Each errLoop In Errs1
      With errLoop
         List1.AddItem "ADO Error #" & i & ":"
         List1.AddItem vbTab & "ADO Error   #" & .Number
         List1.AddItem vbTab & "Description  " & .Description
         List1.AddItem vbTab & "Source       " & .Source
         List1.AddItem vbTab & "HelpFile     " & .HelpFile
         List1.AddItem vbTab & "HelpContext  " & .HelpContext
         List1.AddItem vbTab & "NativeError  " & .NativeError
         List1.AddItem vbTab & "SQLState     " & .SQLState
         i = i + 1
      End With
   Next

End Sub

' VB Specific Error Handling

Sub VbErrorEx(List1 As ListBox, ErrNumber As String, ErrSource As String, ErrDescription As String)
   ' For any error condition, show results to user
   List1.AddItem "*** ERROR CONDITION! ***"
   
   List1.AddItem "VB Error # " & ErrNumber
   List1.AddItem vbTab & "Generated by " & ErrSource
   List1.AddItem vbTab & "Description  " & ErrDescription

End Sub
   
Function GetPropertyAttributes(e As PropertyAttributesEnum) As String

   Dim strTmp As String
   strTmp = ""

   If (e And adPropNotSupported) Then strTmp = strTmp + "NotSupported "
   If (e And adPropRequired) Then strTmp = strTmp + "Required "
   If (e And adPropOptional) Then strTmp = strTmp + "Optional "
   If (e And adPropRead) Then strTmp = strTmp + "Read "
   If (e And adPropWrite) Then strTmp = strTmp + "Write "

   GetPropertyAttributes = strTmp

End Function

Function GetType(e As Integer) As String

   Select Case e
   Case adBigInt
      GetType = "(adBigInt) An 8-byte signed integer"
   Case adBinary
      GetType = "(adBinary) A binary value"
   Case adBoolean
      GetType = "(adBoolean) A Boolean value"
   Case adBSTR
      GetType = "(adBSTR) A null-terminated character string (Unicode)"
   Case adChar
      GetType = "(adChar) A String value"
   Case adCurrency
      GetType = "(adCurrency) A currency value (8-byte signed integer scaled by 10,000)"
   Case adDate
      GetType = "(adDate) A Date value"
   Case adDBDate
      GetType = "(adDBDate) A date value (yyyymmdd)"
   Case adDBTime
      GetType = "(adDBTime) A time value (hhmmss)"
   Case adDBTimeStamp
      GetType = "(adDBTimeStamp) A date-time stamp (yyyymmddhhmmss plus a fraction in billionths)"
   Case adDecimal
      GetType = "(adDecimal) An exact numeric value with a fixed precision and scale"
   Case adDouble
      GetType = "(adDouble) A double-precision floating point value"
   Case adEmpty
      GetType = "(adEmpty) No value was specified"
   Case adError
      GetType = "(adError) A 32-bit error code"
   Case adGUID
      GetType = "(adGUID) A globally unique identifier (GUID)"
   Case adIDispatch
      GetType = "(adIDispatch) A pointer to an IDispatch interface on an OLE object"
   Case adInteger
      GetType = "(adInteger) A 4-byte signed integer"
   Case adIUnknown
      GetType = "(adIUnknown) A pointer to an IUnknown interface on an OLE object"
   Case adLongVarBinary
      GetType = "(adLongVarBinary) A long binary value (Parameter object only)"
   Case adLongVarChar
      GetType = "(adLongVarChar) A long String value (Parameter object only)"
   Case adLongVarWChar
      GetType = "(adLongVarWChar) A long null-terminated string value (Parameter object only)"
   Case adNumeric
      GetType = "(adNumeric) An exact numeric value with a fixed precision and scale"
   Case adSingle
      GetType = "(adSingle) A single-precision floating point value"
   Case adSmallInt
      GetType = "(adSmallInt) A 2-byte signed integer"
   Case adTinyInt
      GetType = "(adTinyInt) A 1-byte signed integer"
   Case adUnsignedBigInt
      GetType = "(adUnsignedBigInt) An 8-byte unsigned integer"
   Case adUnsignedInt
      GetType = "(adUnsignedInt) A 4-byte unsigned integer"
   Case adUnsignedSmallInt
      GetType = "(adUnsignedSmallInt) A 2-byte unsigned integer"
   Case adUnsignedTinyInt
      GetType = "(adUnsignedTinyInt) A 1-byte unsigned integer"
   Case adUserDefined
      GetType = "(adUserDefined) A user-defined variable"
   Case adVarBinary
      GetType = "(adVarBinary) A binary value (Parameter object only)"
   Case adVarChar
      GetType = "(adVarChar) A String value (Parameter object only)"
   Case adVariant
      GetType = "(adVariant) An OLE Automation Variant"
   Case adVarWChar
      GetType = "(adVarWChar) A null-terminated Unicode character string (Parameter object only)"
   Case adWChar
      GetType = "(adWChar) A null-terminated Unicode character string"
   Case Else
      GetType = Str(e) & " = Unrecognized Type"
   End Select

End Function