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
