cjetproc.cls

这个例程及文档详细地介绍了VB6中的物件导向概念

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CJetProc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'********************************************************************************************
'   CJetProc Class Definition
'   Class defines methods for creating and manipulating stored procedures
'   in Jet (Access) databases using ADOX methods
'
'   Requires a project reference to the MSADOX Dll
'
'   Instancing is set to:  5 - MultiUse
''
'********************************************************************************************
Option Explicit

Public Enum JetProcParameter_enum
    jppcol_ParameterName = 0
    jppcol_ParameterType = 1
End Enum


Public Sub DropAllJetProcedures(cnConnection As Connection)
On Error GoTo CatchErr
Dim cat As ADOX.Catalog
Dim SpProc As ADOX.Procedure
Dim ICount As Long

    Set cat = New ADOX.Catalog
    ' Open the Catalog
    Set cat.ActiveConnection = cnConnection
        'The Catalog.Procedures collection does NOT support For Each ..Next enumeration!
        For ICount = 0 To cat.Procedures.Count - 1
            With cat.Procedures
                Set SpProc = .Item(0)
                .Delete SpProc.Name
            End With
        Set SpProc = Nothing
        Next ICount
        
  Set cat.ActiveConnection = Nothing
  Set cat = Nothing
Exit Sub
CatchErr:
      Err.Raise Err.Number, Err.Source & " in VBADOTools.CJetProc.DropAllJetProcedures", Err.Description
End Sub

Public Sub DropJetProcedure(cnConnection As Connection, ByRef strProcName As String)
On Error GoTo CatchErr
Dim cat As ADOX.Catalog
Dim SpProc As ADOX.Procedure
Dim lcount As Long

    Set cat = New ADOX.Catalog
    ' Open the Catalog
    Set cat.ActiveConnection = cnConnection
        'The Catalog.Procedures collection does NOT support For Each ..Next enumeration!
        For lcount = 0 To cat.Procedures.Count - 1
            With cat.Procedures
                Set SpProc = .Item(lcount)
                If SpProc.Name = strProcName Then
                    .Delete SpProc.Name
                    Set SpProc = Nothing
                    Exit For
                End If
            End With
        Set SpProc = Nothing
        Next lcount
        
  Set cat.ActiveConnection = Nothing
  Set cat = Nothing
      
Exit Sub
CatchErr:
      Err.Raise Err.Number, Err.Source & " in VBADOTools.CJetProc.DropJetProcedure", Err.Description
End Sub


Public Sub CreateJetProcedure(cnConnection As Connection, strProcName As String, strCommand As String, lngParameterCount As Long, Optional arParameters As Variant)
On Error GoTo CatchErr
Dim cmd As ADODB.Command
Dim prm As ADODB.Parameter
Dim cat As ADOX.Catalog
Dim strParameters As String
Dim i As Long


    Set cmd = New ADODB.Command
    Set cmd.ActiveConnection = cnConnection
    
    ' Create the parameterized command (Microsoft Jet specific)
    
    strParameters = vbNullString
    If lngParameterCount > 0 Then
        strParameters = "PARAMETERS "
        For i = 1 To lngParameterCount - 1
            strParameters = strParameters & " " & arParameters(i - 1, jppcol_ParameterName) & " " & arParameters(i - 1, jppcol_ParameterType) & ","
        Next i
        'i = lngParameterCount
        strParameters = strParameters & " " & arParameters(i - 1, jppcol_ParameterName) & " " & arParameters(i - 1, jppcol_ParameterType) & ";"
    End If
    
    cmd.CommandText = strParameters & strCommand
    
    Set cat = New ADOX.Catalog
    ' Open the Catalog
    Set cat.ActiveConnection = cnConnection

    ' Create the new Procedure
    cat.Procedures.Append strProcName, cmd
    Set cat.ActiveConnection = Nothing
    Set cmd.ActiveConnection = Nothing
    Set cmd = Nothing
    
Exit Sub
CatchErr:
      Err.Raise Err.Number, Err.Source & " in VBADOTools.CJetProc.CreateJetProcedure", Err.Description
End Sub


Public Function EnumerateJetProcedures(cnConnection As Connection) As Collection
On Error GoTo CatchErr
Dim cmd As ADODB.Command
Dim cat As ADOX.Catalog
Dim SpProc As ADOX.Procedure
Dim strProcedure As String
Dim colProcs As Collection
Dim lcount As Long

    Set cat.ActiveConnection = cnConnection
    Set colProcs = New Collection
    
    With cat.Procedures
        For lcount = 0 To .Count - 1
            Set SpProc = .Item(lcount)
            Set cmd = SpProc.Command
            strProcedure = cmd.Name & " : " & cmd.CommandText
            colProcs.Add strProcedure
            Set cmd = Nothing
            Set SpProc = Nothing
        Next lcount
    End With
    
    Set cat.ActiveConnection = Nothing
    Set EnumerateJetProcedures = colProcs
    Set colProcs = Nothing
    
Exit Function
CatchErr:
      Err.Raise Err.Number, Err.Source & " in VBADOTools.CJetProc.EnumerateJetProcedures", Err.Description
End Function


'The following are valid Jet types for declaring Jet Stored procedures.
'Comments:  Use TEXT for strings with no length specification.  Use TEXT(n) for an equivalent to the CHAR type.
'                   Use INTEGER for longs.  Use BIT for Booleans

'BINARY 1 byte per character Any type of data may be stored in a field of this type. No translation of the data (for example, to text) is made. How the data is input in a binary field dictates how it will appear as output.
'BIT 1 byte Yes and No values and fields that contain only one of two values.
'TINYINT 1 byte An integer value between 0 and 255.
'MONEY 8 bytes A scaled integer between