u011663937 2023-04-12 15:57 采纳率: 0%
浏览 17

关于asp中vbs的数据库查询操作

asp 里使用vbs查询数据库数据,但好像一直没有执行语句RecordCount空值。
各位有空帮忙看一下


<%@ Language=VBScript %>
<%
Option Explicit
Response.Expires = 0
%>
<!--#INCLUDE FILE="../public.inc"-->
<%
Dim strDelCode, strSessionID, strUserID ,ldDelode
Dim strErr, objAdmin, I, arrProc
Dim cnnDoc, strSql', strDBMS
Dim rstRec,rstRecc
Dim ldCount
strSessionID    = Request.QueryString("sessionid")
strDelCode        = Request.QueryString("delCode")
ldDelode        = Request.QueryString("delCode")

'-- Check if the active session exists
'-- If strUserID is empty, redirect this page to logon page
strUserID        = GetExFlowUserID(strSessionID)
If strUserID = "" Then
    Response.Redirect "../redirect.asp"
End If

Set cnnDoc = Server.CreateObject("ADODB.Connection")
cnnDoc.CursorLocation = 3 'adUseClient
cnnDoc.Open Application("FLOW_CONNECTSTRING")
If Err or cnnDoc.State = 0 Then '当连接异常,也就是没有该数据库文件时,输出“数据库连接失败”'
        err.Clear
        set cnnDoc = Nothing
        Response.Write "数据库连接失败"
        Response.End
    End If

Set rstRec = CreateObject("ADODB.Recordset")
rstRec.CursorLocation = 3 'adUseClient

Set rstRecc = CreateObject("ADODB.Recordset")
rstRecc.CursorLocation = 3 'adUseClient


'add by hanxr at 2002-12-15******************************************
Dim intDel
Dim arrcode
dim strdataid,strCanDel,strDelUsercode,strNotDel
dim rsdelproid
dim flag
intDel          = Request("delacc")
strdataid       = request("dataid")


if  not intdel=1 then
    if intdel=3 then
        strDelUsercode=struserid'只有自己可以删除
    elseif intdel=2 then
        strDelUsercode=GetRightUsers("DELE")'得到所有可删除的用户
    end if
    set rsdelproid=createobject("adodb.recordset")
    
    '工作库数据
    strsql="select * from proc_inst where proc_id in(" & strdelcode & ") and proc_auth in('" & strdelusercode & "')"
    rsdelproid.open strsql,cnndoc,3,1 

    '过滤有权限删除的公文
    if not rsdelproid.RecordCount= 0 then  rsdelproid.movefirst
    while not rsdelproid.eof
        strCanDel=strCandel & cstr(rsdelproid.fields("proc_id")) & "," 
        rsdelproid.movenext
    wend
    rsdelproid.Close
    
    '历史库数据
    strsql="select * from proc_inst_HIST where proc_id in(" & strdelcode & ") and proc_auth in('" & strdelusercode & "')"
    rsdelproid.open strsql,cnndoc,3,1 

    '过滤有权限删除的公文
    if not rsdelproid.RecordCount= 0 then  rsdelproid.movefirst
    while not rsdelproid.eof
        strCanDel=strCandel & cstr(rsdelproid.fields("proc_id")) & "," 
        rsdelproid.movenext
    wend
    rsdelproid.Close
    
    if right(strCandel,1)="," Then strCandel=left(strCandel,len(strCandel)-1)
        
    '过滤无权限删除的公文 
    
    '工作库数据
    strsql="select a.*,b.user_name from proc_inst a ,sys_user b where a.proc_auth=b.user_code and proc_id in(" & strdelcode & ") and proc_auth not in('" & strdelusercode & "')"
    rsdelproid.open strsql,cnndoc,3,1 
    if not rsdelproid.RecordCount=0 then rsdelproid.MoveFirst 
    while not rsdelproid.EOF
        strNotDel=strNotDel & rsdelproid.Fields("proc_name") & "(" & rsdelproid.Fields("user_name").Value   & ")\n"
        rsdelproid.MoveNext 
    wend  
    rsdelproid.close
    
    '历史库数据
    strsql="select a.*,b.user_name from proc_inst_hist a ,sys_user b where a.proc_auth=b.user_code and proc_id in(" & strdelcode & ") and proc_auth not in('" & strdelusercode & "')"
    rsdelproid.open strsql,cnndoc,3,1 
    if not rsdelproid.RecordCount=0 then rsdelproid.MoveFirst 
    while not rsdelproid.EOF
        strNotDel=strNotDel & rsdelproid.Fields("proc_name") & "(" & rsdelproid.Fields("user_name").Value   & ")\n"
        rsdelproid.MoveNext 
    wend  
    rsdelproid.close
    
    set rsdelproid=nothing
    strDelCode=strCandel
end if
if len(trim(strnotdel))=0 then
    flag=true
else
    flag=false
end if

'end**************************************************************

strSqls = "(SELECT A.ENTR_RECI,C.USER_NAME AS RECI_NAME,A.ENTR_PREC,A.ENTR_STAT FROM RECI_ENTR_ALL_NEW A, SYS_USER C, RECI_ENTR E  WHERE A.PROC_ID IN (" & ldDelode & ") AND C.USER_CODE = A.ENTR_RECI"  & _    
        " AND E.PROC_ID IN (" & ldDelode & ") AND E.ENTR_ID = A.ENTR_ID  UNION SELECT A.ENTR_RECI FROM RECI_ENTR_ALL_HIST A, SYS_USER C, RECI_ENTR_HIST E " & _
        " WHERE A.PROC_ID IN (" & ldDelode & ")  AND C.USER_CODE = A.ENTR_RECI AND E.PROC_ID IN (" & ldDelode & ") AND E.ENTR_ID = A.ENTR_ID )"
        'cnnDoc.open"Provider=SQLOLEDB.1;Password=lyy;Persist Security Info=True;User ID=sa;Initial Catalog=ExFlow;Data Source=OASERVER"
rstRec.Open  strSqls, cnnDoc,3,1  'adOpenStatic, adLockReadOnly     
'If Not (rstRec.BOF And rstEntry.EOF) then
'    rstRec.MoveFirst 
    dim ldCounts
    ldCounts = 0
    'While (not rstRec.EOF) 
    '    ldCounts = ldCounts + 1
    '    ldCount=ldCount & rstRec.Fields("ENTR_RECI") & ";"
        'rstRec.MoveNext     
    'wend
    dim rsnum
rsnum=rstRec.RecordCount
if rsnum > 0 then 
    ldCounts=1
End If
rstRec.Close 
Response.Write "<script language=javascript>parent.fr_cont.lockToolbar(false,'完成2');" 
if ldCounts>0 then 
Response.Write "alert('"&ldCounts&":"&rsnum&"中心主任已审核或已接收,不能删除!');"
 end if
Response.Write  "</script>"


'工作库数据
strSql = "(SELECT PROC_ID,PROC_NAME FROM PROC_INST WHERE PROC_ID IN (" & strDelCode & ")) " & _
        "UNION " & _
        "(SELECT PROC_ID,PROC_NAME FROM PROC_INST_HIST WHERE PROC_ID IN (" & strDelCode & ")) "

rstRec.Open  CStr(strSql), cnnDoc,3,1  'adOpenStatic, adLockReadOnly 

strErr = GetDataObj(objAdmin)

If strErr = "" AND ldCounts<=0 Then
    strErr = objAdmin.DeletePI((strDelCode))
End If    

If strErr <> "" Then
    '''' yuanbp Comment at 2006-09-19 解决删除公文时提示2次的问题
    'ReportError 5, strErr, "", ""
    '''''end 
Else
    rstRec.MoveFirst  
    While (Not rstRec.EOF)
        WriteLog session("UserName"), rstRec.Fields("PROC_NAME").Value & "(" & rstRec.Fields("PROC_ID").Value & ")","删除"
        rstRec.MoveNext 
    Wend
    Response.Write "<script language=javascript>parent.fr_cont.frmQuery.submit()</script>"
End If

'modify by han at 2002-12-15************
Response.Write "<script language=javascript>parent.fr_cont.lockToolbar(false,'完成');" 
if flag=false then
    Response.Write "alert('没有足够的权限删除以下公文:\n" & strnotdel & "');"
end if
Response.Write  "</script>"
'end************************************

Set rstRec = Nothing
Set rstRecc=Nothing    
cnnDoc.Close
Set cnnDoc = Nothing
Set objAdmin = Nothing


'add by hanxr at 2002-12-12
Function GetRightUsers(strRightCode)
    'On Error Resume Next
    GetRightUsers=""
    Dim rstView,cnnView 
    Dim strSql
    Dim arrView
    Set cnnView=server.CreateObject("ADODB.Connection")
    Set rstView=server.CreateObject("ADODB.Recordset")
    cnnView.CursorLocation=3
    cnnView.Open Application("FLOW_CONNECTSTRING")
    strSql="select * from user_range where RIGHT_CODE='" & strRightCode & "' and DATA_ID=" & cstr(strDataID) & " and user_code in (select user_code from user_data where data_id =" & cstr(strdataid) & " and user_code in (select grp_code from sys_grp where user_code='" & cstr(strUserID) & "') or  user_code in (select Station_Code from sys_Station where user_code='" & cstr(strUserID) & "')  or user_code='" & cstr(strUserID) & "')"

    rstView.Open strSql,cnnView,1,1

    if not rstView.BOF Then
        rstView.MoveFirst 
        while not rstView.EOF 
            if rstView.Fields("OWNER_TYPE")=1 then
                GetRightUsers=GetRightUsers & rstView.Fields("OWNER_code")
                if right(rstView.Fields("OWNER_TYPE"),1)<>";" Then
                    GetRightUsers=GetRightUsers & ";"    
                end if
            end if 
            if rstView.Fields("OWNER_TYPE")=0 then
                GetRightUsers=GetRightUsers & GetGrpUsers(rstView.Fields("OWNER_CODE"),cnnView)    
                
            end if 
            if rstView.Fields("OWNER_TYPE")=2 then
                GetRightUsers=GetRightUsers & GetStationUsers(rstView.Fields("OWNER_CODE"),cnnView)                
            end if 
            rstView.MoveNext 
        wend
    end if
    rstView.Close 
    set rstView=nothing
    cnnView.Close 
    Set cnnView=nothing
    if GetRightUsers<>"" then
        arrView=split(GetRightUsers,";")
        GetRightUsers=Join(arrView,"','")
    end if
End Function

Function GetGrpUsers(strGrps,cnnView)
    'On Error Resume Next
    GetGrpUsers=""
    Dim arrGrp
    Dim strSplitGrp
    Dim rstGrp  
    Dim strSql
    arrgrp=split(strGrps,";")
    strSplitGrp=Join(arrgrp,"','")
    set rstGrp=server.CreateObject("ADODB.Recordset")
    strSql="select * from sys_Grp Where Grp_Code in ('" & cstr(strSplitGrp) & "')"
    rstGrp.Open strsql,cnnView,1,1
    if not rstGrp.BOF then
        rstGrp.MoveFirst 
        while not rstGrp.EOF 
            GetGrpUsers=GetGrpUsers & rstGrp.Fields("User_code") & ";"
            rstGrp.MoveNext     
        wend
    end if
    
    rstGrp.Close 
    Set rstGrp=nothing
End Function


Function GetStationUsers(strStations,cnnView)
    'On Error Resume Next
    GetStationUsers=""
    Dim arrStation
    Dim strSplitStation
    Dim rstStation  
    Dim strSql
    arrStation=split(strStations,";")
    strSplitStation=Join(arrStation,"','")
    set rstStation=server.CreateObject("ADODB.Recordset")
    strSql="select * from sys_Station Where Station_Code in ('" & cstr(strSplitStation) & "')"
    rstStation.Open strsql,cnnView,1,1
    if not rstStation.BOF then
        rstStation.MoveFirst 
        while not rstStation.EOF 
            GetStationUsers=GetStationUsers & rstStation.Fields("User_code") & ";"
            rstStation.MoveNext     
        wend
    end if
    
    rstStation.Close 
    Set rstStation=nothing
End Function
'end

%>



  • 写回答

1条回答 默认 最新

  • threenewbee 2023-04-12 16:13
    关注

    rsdelproid.open strsql,cnndoc,3,1
    后面加上
    rsdelproid.movenext
    看看
    还有 if not xxx = xxx 这好奇怪,直接写 if xxx <> xxx 即可

    评论 编辑记录

报告相同问题?

问题事件

  • 修改了问题 4月12日
  • 修改了问题 4月12日
  • 创建了问题 4月12日

悬赏问题

  • ¥15 CVRP 图论 物流运输优化
  • ¥15 Tableau online 嵌入ppt失败
  • ¥100 支付宝网页转账系统不识别账号
  • ¥15 基于单片机的靶位控制系统
  • ¥15 真我手机蓝牙传输进度消息被关闭了,怎么打开?(关键词-消息通知)
  • ¥15 下图接收小电路,谁知道原理
  • ¥15 装 pytorch 的时候出了好多问题,遇到这种情况怎么处理?
  • ¥20 IOS游览器某宝手机网页版自动立即购买JavaScript脚本
  • ¥15 手机接入宽带网线,如何释放宽带全部速度
  • ¥30 关于#r语言#的问题:如何对R语言中mfgarch包中构建的garch-midas模型进行样本内长期波动率预测和样本外长期波动率预测