VB6.0 调用存储过程的例子（方法二）
2024-07-21 02:20:39
供稿：网友
本人推荐使用方法一来取存储过程，当然前提是知道将要使用的参数化命令的详细情况，通过在代码中创建参数，其执行的速度快。
如果不知道要使用的参数化命令，本人整理了一份通过使用参数（parameters）对象来获取存储过程的记录集的内容，但该执行方式速度没有方法一理想。
代码整理如下，你可以直接将该代码copy到form1窗体中进行调试。
其中函数getdatatype可以修改为自己所需的处理方式，在这里所有的代码都是为了测试方便所有，你也可以改为自己所需的相应处理。
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=;database=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 ' 指定ado实际地与数据源相连
end with
' 通过parameters对象，填充输入参数
for each adoprm in adocmd.parameters
if adoprm.direction = adparaminput then
errdatatype:
on error resume next
adoprm.value = inputbox("存储过程参数名称:" & adoprm.name & vbcrlf & _
"该参数数据类型:" & getdatatype(adoprm.type), "请输入参数值", "")
if err <> 0 then
if msgbox("所输入的参数与该参数数据类型不符，请重新输入！取消将退出存储过程的调用！", vbokcancel, "警告") = 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 is 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 = "无法获取数据类型"
end select
end function
