Example of a VB6.0 call to a stored procedure (method two)

Stored procedures I recommend using the method to fetch stored procedures, of course, if you know the details of the parameterized command to be used, by creating parameters in the code, it executes faster.



If you do not know the parameterized command to use, I have compiled a copy of the contents of the recordset of the stored procedure by using the parameter (Parameters) object, but the execution speed is not satisfactory.



The code is sorted as follows, you can simply copy the code to the Form1 form for debugging.

Where the function Getdatatype can be modified to its own required processing, where all the code is to test the convenience of all, you can also change to the corresponding processing of their own needs.



Sub createparms ()

Dim Adocmd as New Adodb.command

Dim ADOPRM as New ADODB. Parameter

Dim ADOcon as ADODB. Connection

Dim adors as ADODB. Recordset

Dim StrConnect as String

Dim strFieldName as String



Dim I as Integer



strconnect = "Driver={sql server};server= (local); uid=sa;pwd=;d atabase=pubs"

Set ADOcon = New ADODB. Connection

With ADOcon

. Provider = "Msdasql"

. CursorLocation = adUseServer ' must use Server side cursor.

. ConnectionString = strconnect

. Open

End With



Set adocmd.activeconnection = ADOcon

With Adocmd

. CommandType = adCmdStoredProc

. CommandText = "Adotestrpe"



. Parameters.refresh ' specifies that ADO is actually connected to the data source

End With



' Fill in the input parameters through the Parameters object

For each ADOPRM in Adocmd.parameters

If adoprm.direction = adParamInput Then



Errdatatype:

On Error Resume Next

Adoprm.value = InputBox ("stored Procedure parameter name:" & Adoprm.name & VbCrLf & _

"This parameter data type:" & Getdatatype (Adoprm.type), "Please enter parameter value", "")

If Err <> 0 Then

If MsgBox ("The parameter entered is not in conformity with the parameter data type, please re-enter!") Cancels the call that will exit the stored procedure! ", vbOKCancel," warning "= vbcancel Then

Exit Sub

End If

Err.Clear

GoTo Errdatatype

End If

On Error GoTo 0



End If

Next



On Error GoTo ErrHandler

Set adors = Adocmd.execute



If not (Adors are nothing) Then

If not adors.eof Then

Do Until adors.eof

For i = 0 to Adors.fields.count-1

strFieldName = Adors.fields (i). Name

Debug.Print "" & Adors (strFieldName) & Space (4)

Next

Debug.Print



Adors.movenext

Loop

End If

End If





ErrHandler:

Call ErrHandler (ADOcon)

Resume Next



Shutdown:

Set Adocmd = Nothing

Set ADOPRM = Nothing

Set adors = Nothing

Set ADOcon = Nothing

End Sub



Private Sub Command1_Click ()

Call Createparms

End Sub



Sub ErrHandler (Objcon as Object)

Dim Adoerr as ADODB. Error

Dim Strerror as String



For each adoerr in Objcon.errors

strerror = "Error #" & Adoerr.number & VbCrLf & Adoerr.description _

& vbcr & _

"(Source:" & Adoerr.source & ")" & vbcr & _

"(SQL State:" & Adoerr.sqlstate & ")" & vbcr & _

"(NativeError:" & Adoerr.nativeerror & ")" & vbcr

If adoerr.helpfile = "" Then

strerror = strerror & "No Help file Available" & vbcr & vbcr

Else

strerror = strerror & "(HelpFile:" & Adoerr.helpfile & ")" _

& vbcr & "(helpcontext:" & Adoerr.helpcontext & ")" & _

vbcr & vbcr

End If



' Debug.Print strerror

MsgBox strerror

Next



ObjCon.Errors.Clear

End Sub



Function Getdatatype (ByRef DataType as DataTypeEnum) as String

Select Case DataType

Case Datatypeenum.adarray

Getdatatype = "Datatypeenum.adarray"

Case Datatypeenum.adbigint

Getdatatype = "Datatypeenum.adbigint"

Case Datatypeenum.adbinary

Getdatatype = "Datatypeenum.adbinary"

Case Datatypeenum.adboolean

Getdatatype = "Datatypeenum.adboolean"

Case DATATYPEENUM.ADBSTR

Getdatatype = "Datatypeenum.adbstr"

Case Datatypeenum.adchapter

Getdatatype = "Datatypeenum.adchapter"

Case Datatypeenum.adchar

Getdatatype = "Datatypeenum.adchar"

Case Datatypeenum.adcurrency

Getdatatype = "Datatypeenum.adcurrency"

Case Datatypeenum.addate

Getdatatype = "Datatypeenum.addate"

Case Datatypeenum.addbdate

Getdatatype = "Datatypeenum.addbdate"

Case Datatypeenum.addbtime

Getdatatype = "Datatypeenum.addbtime"

Case Datatypeenum.addbtimestamp

Getdatatype = "Datatypeenum.addbtimestamp"

Case Datatypeenum.addecimal

Getdatatype = "Datatypeenum.addecimal"

Case Datatypeenum.addouble

Getdatatype = "Datatypeenum.addouble"

Case Datatypeenum.adempty

Getdatatype = "Datatypeenum.adempty"

Case Datatypeenum.aderror

Getdatatype = "Datatypeenum.aderror" "" "

Case Datatypeenum.adfiletime

Getdatatype = "Datatypeenum.adfiletime" "" "

Case Datatypeenum.adguid

Getdatatype = "Datatypeenum.adguid"

Case Datatypeenum.adidispatch

Getdatatype = "Datatypeenum.adidispatch"

Case Datatypeenum.adinteger

Getdatatype = "Datatypeenum.adinteger"

Case Datatypeenum.adiunknown

Getdatatype = "Datatypeenum.adiunknown"

Case Datatypeenum.adlongvarbinary

Getdatatype = "Datatypeenum.adlongvarbinary"

Case Datatypeenum.adlongvarchar

Getdatatype = "Datatypeenum.adlongvarchar"

Case Datatypeenum.adlongvarwchar

Getdatatype = "Datatypeenum.adlongvarwchar"

Case Datatypeenum.adnumeric

Getdatatype = "Datatypeenum.adnumeric"

Case Datatypeenum.adpropvariant

Getdatatype = "Datatypeenum.adpropvariant"

Case Datatypeenum.adsingle

Getdatatype = "Datatypeenum.adsingle"

Case Datatypeenum.adsmallint

Getdatatype = "Datatypeenum.adsmallint"

Case Datatypeenum.adtinyint

Getdatatype = "Datatypeenum.adtinyint"

Case Datatypeenum.adunsignedbigint

Getdatatype = "Datatypeenum.adunsignedbigint"

Case Datatypeenum.adunsignedint

Getdatatype = "Datatypeenum.adunsignedint"

Case Datatypeenum.adunsignedsmallint

Getdatatype = "Datatypeenum.adunsignedsmallint"

Case Datatypeenum.adunsignedtinyint

Getdatatype = "Datatypeenum.adunsignedtinyint"

Case datatypeenum.aduserdefined

Getdatatype = "datatypeenum.aduserdefined"

Case Datatypeenum.advarbinary

Getdatatype = "Datatypeenum.advarbinary"

Case Datatypeenum.advarchar

Getdatatype = "Datatypeenum.advarchar"

Case Datatypeenum.advariant

Getdatatype = "Datatypeenum.advariant"

Case Datatypeenum.advarnumeric

Getdatatype = "Datatypeenum.advarnumeric"

Case Datatypeenum.advarwchar

Getdatatype = "Datatypeenum.advarwchar"

Case Datatypeenum.adwchar

Getdatatype = "Datatypeenum.adwchar"

Case Else

Getdatatype = "Cannot get data type"

End Select

End Function