经典的asp应用程序 - 错误：类asp server.execute该连接不能用于执行此操作

时间：2015-06-22 15:18:27

标签： asp-classic windows-server-2012 iis-8.5

我们正在使用IIS 8.5将经典的asp应用程序从我们的Windows 2003（我知道，我们知道的几台服务器）运行IIS）转移到使用IIS 8.5的Windows Server 2012 R2计算机上。

我已经完成了安装和配置asp的所有必要步骤：添加了asp角色/功能，启用了父路径，我在“经典模式”下运行我的应用程序，并添加了.asp MIME类型和处理程序映射，我可以点击我的.asp页面，但我们的主页，标题为Main.asp，只有一点HTML并使用关于Server.Execute“some_page.asp”调用调用其所有功能，我收到了错误主题行。

这在我们2003年的盒子上已经运行好多年了，但是现在，它几乎就像控件被转移到我们应用程序中的另一个脚本或paglet时，有些东西因数据库功能而变得不可思议。我将在下面发布一些代码：

Main.asp页面：

<%
    Response.Expires = 0
    Response.Buffer = True
    Server.Execute "gbl_Init.asp"
%>
<HTML>
    <HEAD>
        <TITLE>Site Name</TITLE>
        <LINK REL=STYLESHEET TYPE="text/css" HREF="styles/sitename.css?2">
        <% Server.Execute "gbl_Script.asp" %>
    </HEAD>
    <BODY BGCOLOR=#FFFFFF LEFTMARGIN="5" TOPMARGIN="0" MARGINHEIGHT="0" MARGINWIDTH="0">
        <% Server.Execute "gbl_Printable.asp" %>
        <TABLE CELLSPACING="0" CELLPADDING="0" BORDER="0" WIDTH="100%" class="noprint" HEIGHT="82">
            <TR>
                <TD WIDTH="220" ALIGN="left"><A HREF="Main.asp?PageID=1"><IMG SRC="images/global/home_logo.jpg" BORDER="0"></A></TD>
                <TD WIDTH="380" ALIGN="left"><A HREF="Main.asp?PageID=1"><IMG SRC="images/global/home_welcome.gif" BORDER="0"></A></TD>
                <TD BACKGROUND="images/global/home_background.jpg">&nbsp;</TD>
            </TR>
        </TABLE>
        <TABLE CELLSPACING="0" CELLPADDING="4" BORDER="0" WIDTH="100%" class="noprint">
            <TR>
                <TD CLASS="HeadingPurpleSM" WIDTH="50%" ALIGN="left"> <% Server.Execute "gbl_Search.asp" %> </TD>
                <TD CLASS="HeadingPurpleSM" WIDTH="50%" ALIGN="right"><% Server.Execute "gbl_Welcome.asp" %></TD>
            </TR>
        </TABLE>
        <TABLE CELLSPACING="0" CELLPADDING="0" BORDER="1" WIDTH="100%" BORDERCOLOR="#CCCCCC" class="noprint">
            <TR>
                <TD COLSPAN="2" WIDTH="100%" ALIGN="left"> <% Server.Execute "gbl_Crumb.asp" %> </TD>
            </TR>
        </TABLE>

        <% Server.Execute "gbl_Tabs.asp" %>
        <TABLE CELLSPACING="0" CELLPADDING="0" BORDER="0" WIDTH="100%">
            <TR>
                <TD><% Server.Execute "gbl_Content.asp" %></TD>
            </TR>
        </TABLE>
        <TABLE CELLSPACING="0" CELLPADDING="0" BORDER="0" WIDTH="100%" class="noprint">
            <TR>
                <TD CLASS="FooterNav" ALIGN="center"> <% Server.Execute "gbl_Footer.asp" %> </TD>
            </TR>
        </TABLE>

    </BODY>
</HTML>

gbl_Script.asp页面：

<!--#Include file="Framework/version3/lib_Common_DB.asp" -->

<%
'***************************************************
' GLOBAL DECLARATIONS
'***************************************************
dim gobjCn, gstrCn
dim gstrPageID
dim gstrSessionID
dim garrPage
dim gstrNetDomainNM
dim gstrNetUserNM
dim gstrNetGroups
dim gstrMemberID
dim gstrMemberNM
dim garrMember

'***************************************************
' PAGE INPUT VARIABLES
'***************************************************
gstrPageID = request.querystring("PageID")
gstrCn = Application("strAdminConnectionString") 'in Global.asa file
gstrSessionID = request.cookies("session")

'***************************************************
' MAIN
'***************************************************
Call Main

Sub Main

    'PageID syntax
    If len(gstrPageID)> 0 Then
        If Not IsNumeric(gstrPageID) Then
                Response.Redirect "Main.asp?PageID=1"
        End If
    Else
        Response.Redirect "Main.asp?PageID=1"
    End If

    set gobjCn = ConnectDb(gstrCn)

        'PageID active and exists
        RetrieveData
        If NOT IsArray(garrPage) Then
            Response.Redirect "Main.asp?PageID=1"
        End If

        'Session Validation
        If len(trim(gstrSessionID)) = 0 Then
            'Authentication
            larrNetNM = Split(Request.ServerVariables("AUTH_USER"),"\",-1,1)
            gstrNetDomainNM = larrNetNM(0)
            gstrNetUserNM = larrNetNM(1)

            'If gstrNetUserNM = "someusername" Then
            '    gstrNetUserNM = "someotherusername"
            'End If

            RetrieveData_MEMBER
            If IsArray(garrMember) Then
                gstrMemberID = garrMember(0,0)
                gstrMemberNM = garrMember(1,0)
            Else
                SetupNewMember
            End If
            CreateSession
            LoginAudit
            If gstrNetDomainNM = "OUR COMPANY" Then
                UpdateMemberADGroups
            Else
                UpdateMemberNTGroups
            End If
        Else
            RetrieveData_SESSION
        End If

    DisConnectDB(gobjCn)
End Sub

'***************************************************
' GET DATA
'***************************************************
Sub RetrieveData()
    Dim Parms(0)
    Parms(0) = Array("@PageID",adInteger,adParamInput,4,gstrPageID)
    garrPage = SqlQuery(gobjCn,"sp","usp_Page_Init",Parms,retArray)(0)
End Sub

Sub RetrieveData_SESSION()
    Dim Parms(0)
    Parms(0) = Array("@SessionID",adVarChar,adParamInput,60,gstrSessionID)
    larrSession = SqlQuery(gobjCn,"sp","usp_Get_Session",Parms,retArray)(0)
    If IsArray(larrSession) Then
        gstrMemberID = larrSession(1,0)
    Else
        Response.cookies("session") = ""
        Response.Redirect "Main.asp?PageID=1"
    End If
End Sub

Sub RetrieveData_MEMBER()
    Dim Parms()
    If gstrNetDomainNM = "OUR_COMPANY""
        ReDim Parms(0)
        Parms(0) = Array("@NetUserNM",adVarChar,adParamInput,30,gstrNetUserNM)
        garrMember = SqlQuery(gobjCn,"sp","usp_Get_Org_Member_AD",Parms,retArray)(0)
    Else
        ReDim Parms(1)
        Parms(0) = Array("@NetDomainNM",adVarChar,adParamInput,30,gstrNetDomainNM)
        Parms(1) = Array("@NetUserNM",adVarChar,adParamInput,30,gstrNetUserNM)
        garrMember = SqlQuery(gobjCn,"sp","usp_Get_Org_Member",Parms,retArray)(0)
    End If
End Sub

'***************************************************
' MISC FUNCTIONS
'***************************************************
Sub CreateSession()
    Dim Parms(2)
    Parms(0) = Array("@MemberID",adInteger,adParamInput,4,gstrMemberID)
    Parms(1) = Array("@MemberNM",adVarChar,adParamInput,80,gstrMemberNM)
    Parms(2) = Array("@SessionID",adGUID,adParamOutput,16,"")
    OutArray = SqlCmd(gobjCn,"SP","usp_Ins_Session",Parms,retArray)
    gstrSessionID = retArray(2)
    response.cookies("session") = gstrSessionID
    response.cookies("session").expires = DateAdd("d", 1, Date)
End Sub

Sub SetupNewMember
    Set lobjUser = GetObject("WinNT://" & gstrNetDomainNM & "/" & gstrNetUserNM)

    larrUser = Split( lobjUser.FullName, "," )
    lstrFirstNM = Trim( larrUser( UBound( larrUser ) ) )
    lstrLastNM = Trim( larrUser( LBound( larrUser ) ) )

    Dim Parms(4)
    Parms(0) = Array("@NetworkDomainNM",adVarChar,adParamInput,80,gstrNetDomainNM)
    Parms(1) = Array("@NetworkUserNM",adVarChar,adParamInput,80,gstrNetUserNM)
    Parms(2) = Array("@LastNM",adVarChar,adParamInput,80,lstrLastNM)
    Parms(3) = Array("@FirstNM",adVarChar,adParamInput,80,lstrFirstNM)
    Parms(4) = Array("@MemberID",adInteger,adParamOutput,4,"")
    OutArray = SqlCmd(gobjCn,"SP","usp_Ins_Org_Member",Parms,retArray)
    gstrMemberID = retArray(4)
    gstrMemberNM = lstrFirstNM & " " & lstrLastNM
End Sub

Sub UpdateMemberNTGroups()
    dim Parms(2)
    dim lstrRoles
    Set lobjUser = GetObject("WinNT://" & gstrNetDomainNM & "/" & gstrNetUserNM)
    lstrRoles = "<root>"
    For Each Prop in lobjUser.Groups
        lstrNM = Replace(Prop.Name,"&","&amp;",1,-1,1)
        lstrRoles = lstrRoles & "<role nm=" & """" & lstrNM & """" & "/>"
    Next
    lstrRoles = lstrRoles & "</root>"
    Parms(0) = Array("@MemberID",adInteger,adParamInput,4,gstrMemberID)
    Parms(1) = Array("@DomainNM",adVarChar,adParamInput,80,gstrNetDomainNM)
    Parms(2) = Array("@RoleList",adVarChar,adParamInput,2000,lstrRoles)
    OutArray = SqlCmd(gobjCn,"sp","usp_Upd_Roles",Parms,retArray)
End Sub

Sub LoginAudit()
    lstrBrowser = request.servervariables("HTTP_USER_AGENT")
    If Len(lstrBrowser) > 200 Then lstrBrowser = Left(lstrBrowser, 200)
    lstrClientIP = request.servervariables("REMOTE_ADDR")
    Dim Parms(4)
    Parms(0) = Array("@MemberID",adInteger,adParamInput,4,gstrMemberID)
    Parms(1) = Array("@LoginDT",adDBDate,adParamInput,8,Now)
    Parms(2) = Array("@SessionID",adGUID,adParamInput,16,gstrSessionID)
    Parms(3) = Array("@ClientIP",adVarChar,adParamInput,16,lstrClientIP)
    Parms(4) = Array("@ClientTYPE",adVarChar,adParamInput,200,lstrBrowser)
    OutArray = SqlCmd(gobjCn,"sp","usp_Ins_Login_Audit",Parms,retArray)
End Sub

Sub LogEntry()
    dim Parms(4)
    Parms(0) = Array("@SessionID",adGUID,adParamInput,40,gstrSessionID)
    Parms(1) = Array("@FtpADDR",adVarChar,adParamInput,40,request.servervariables("REMOTE_ADDR"))
    Parms(2) = Array("@MemberID",adInteger,adParamInput,4,gstrMemberID)
    Parms(3) = Array("@PageID",adVarChar,adParamInput,40,gstrPageID)
    Parms(4) = Array("@UrlDESC",adVarChar,adParamInput,255,request.servervariables("QUERY_STRING"))
    OutArray = SqlCmd(gobjCn, "sp", "usp_Ins_Session_Log", Parms, retArray)
End Sub

Sub UpdateMemberADGroups()
    dim larr()
    dim Parms()

    Set con = Server.CreateObject("ADODB.Connection")
    con.Provider = "ADsDSOObject"
    con.Open "Provider=ADsDSOObject","USERNAME","PASSWORD"

    Set com = Server.CreateObject("ADODB.Command")
    Set com.ActiveConnection = con
    lstrSql = "SELECT distinguishedName FROM sometable"
    com.CommandText = lstrSql
    Com.Properties("Page Size") = 1000
    Com.Properties("Timeout") = 30
    Com.Properties("searchscope") = 2
    Com.Properties("Chase referrals") = 6
    Com.Properties("Cache Results") = False
    Set rs = Com.Execute
    rs.MoveFirst
    i=0
    If rs.Fields(i).Type = 12 And Not (IsNull(rs.Fields(i).Value)) Then
        larrTemp = rs.Fields(i).Value
        For j = LBound(larrTemp) To UBound(larrTemp)
            lstrName = ltrim(larrTemp(j))
        Next
    Else
        lstrName = ltrim(rs.Fields(i).Value)
    End If
    rs.close
    Set rs = nothing
    Set com = nothing

    Set com = Server.CreateObject("ADODB.Command")
    Set com.ActiveConnection = con
    lstrSql = "SELECT cn FROM sometable ORDER BY cn"
    com.CommandText = lstrSql
    Com.Properties("Page Size") = 1000
    Com.Properties("Timeout") = 30
    Com.Properties("searchscope") = 2
    Com.Properties("Chase referrals") = 6
    Com.Properties("Cache Results") = False
    Set rs = Com.Execute
    rs.MoveFirst
    lstrRoles = "<root>"
    While Not rs.EOF
        For i = 0 To rs.Fields.Count - 1
        If rs.Fields(i).Type = 12 And Not (IsNull(rs.Fields(i).Value)) Then
            larrTemp = rs.Fields(i).Value
                For j = LBound(larrTemp) To UBound(larrTemp)
                lstrNM = Replace(ltrim(larrTemp(j)),"&","&amp;",1,-1,1)
                lstrRoles = lstrRoles & "<role nm=" & """" & lstrNM & """" & "/>"
                Next
        Else
            lstrNM = Replace(ltrim(rs.Fields(i).Value),"&","&amp;",1,-1,1)
            lstrRoles = lstrRoles & "<role nm=" & """" & lstrNM & """" & "/>"
        End If

'       TODO: update stored procedure to take varchar(max) and delete this block
        If Len( lstrRoles ) > 1500 Then
            lstrRoles = lstrRoles & "</root>"
            Redim Parms(2)
            Parms(0) = Array("@MemberID",adInteger,adParamInput,4,gstrMemberID)
            Parms(1) = Array("@DomainNM",adVarChar,adParamInput,80,gstrNetDomainNM)
            Parms(2) = Array("@RoleList",adVarChar,adParamInput,2000,lstrRoles)
            OutArray = SqlCmd(gobjCn,"sp","usp_Upd_Roles_AD",Parms,retArray)

            lstrRoles = "<root>"
        End If

        rs.movenext
        next
    wend
    lstrRoles = lstrRoles & "</root>"

    ' TODO: Remove If/End If from around this block
    If lstrRoles <> "<root></root>" Then
        Redim Parms(2)
        Parms(0) = Array("@MemberID",adInteger,adParamInput,4,gstrMemberID)
        Parms(1) = Array("@DomainNM",adVarChar,adParamInput,80,gstrNetDomainNM)
        Parms(2) = Array("@RoleList",adVarChar,adParamInput,2000,lstrRoles) ' TODO: Change size to -1
        OutArray = SqlCmd(gobjCn,"sp","usp_Upd_Roles_AD",Parms,retArray)
    End If
End Sub
%>

最后，我们的数据库逻辑所在的包含文件（我在下面添加了一条注释，显示了主题错误始终发生的行）：

<%
Const adPersistXML = 1
Const adCmdStoredProc = &H0004
Const adCmdText = &H0001
Const adExecuteNoRecords = &H00000080
Const adParamInput = &H0001
Const adParamOutput = &H0002
Const adFldUpdatable = &H00000004
Const adInteger = 3
Const adCurrency = 6
Const adBSTR = 8
Const adBoolean = 11
Const adGUID = 72
Const adChar = 129
Const adDBDate = 133
Const adVarChar = 200
Const adLongVarChar = 201
Const adTypeBinary = 1
Const adTypeText = 2
Const adLongVarBinary = 205
Const adSaveCreateOverWrite = 2
Const adDefaultStream = -1

Function ConnectDB(cnStr)
    On Error Resume Next
    Set cn = Server.CreateObject("ADODB.Connection")
    cn.Open cnStr
    If cn.Errors.Count > 0 Then
        Set ConnectDB = Nothing
        Exit Function
    End If
    Set ConnectDB = cn

End Function

Sub DisConnectDB(cn)
    cn.close
    set cn = nothing
End Sub

Public Function SqlQuery(cn, cmdType, cmdStr, params, byRef OutArray)
        Dim rs, cmd, OutPutParms
        dim arrRS(5)

        Set cmd = Server.CreateObject("ADODB.Command")
        Set rs = Server.CreateObject("ADODB.Recordset")

        cmd.ActiveConnection = cn
        cmd.CommandText = cmdStr
        cmd.CommandTimeout = 60
        if ucase(cmdType) = "SP" then
            cmd.CommandType = adCmdStoredProc
        else
            cmd.CommandType = adCmdText
        end if
        collectParams cmd, params, OutPutParms

        set rs = cmd.Execute '************ERROR HAPPENS HERE********
        i=0
        if not rs.eof then
            do until rs is nothing
                If rs.eof Then
                    Exit Do
                End If
                arrRS(i) = rs.getrows
                set rs = rs.NextRecordset
                i=i+1
            loop
        end if
        if OutPutParms then
            OutArray = collectOutputParms(cmd, params)
            arrRS(i) = OutArray
        end if
        SqlQuery = arrRS
        set rs = Nothing
        set cmd = Nothing
End Function

Public Function SqlCmd(cn, cmdType, cmdStr, params, byRef OutArray)
        Dim cmd, OutPutParms
        Set cmd = Server.CreateObject("adodb.Command")
        cmd.ActiveConnection = cn
        cmd.CommandText = cmdStr
        if ucase(cmdType) = "SP" then
            cmd.CommandType = adCmdStoredProc
        else
            cmd.CommandType = adCmdText
        end if
        collectParams cmd, params, OutPutParms
        cmd.Execute , , adExecuteNoRecords
        if OutPutParms then
            OutArray = collectOutputParms(cmd, params)
        end if
        set cmd = Nothing
        SqlCmd = 0
End Function

Public Function SqlQueryRecordset(cn, cmdType, cmdStr, params)
        Dim cmd: Set cmd = Server.CreateObject("ADODB.Command")
        cmd.ActiveConnection = cn
        cmd.CommandText = cmdStr
        if ucase(cmdType) = "SP" then
            cmd.CommandType = adCmdStoredProc
        else
            cmd.CommandType = adCmdText
        end if
        collectParams cmd, params, OutPutParms
        Set SqlQueryRecordset = cmd.Execute
        set cmd = Nothing
End Function

Private Sub collectParams(ByRef cmd, ByVal argparams, ByRef OutPutParms)
        Dim params, v
        Dim i, l, u
        'if argparams is empty

        If Not IsArray(argparams) Then Exit Sub

        OutPutParms = false
        params = argparams
        For i = LBound(params) To UBound(params)
            l = LBound(params(i))
            u = UBound(params(i))
            ' Check for nulls.
            If u - l >= 3 Then
                If VarType(params(i)(4)) = vbString Then
                    if params(i)(4) = "" then
                        v=null
                    else
                        v=params(i)(4)
                    end if
                Else
                    v = params(i)(4)
                End If
                if params(i)(2) = adParamOutput then OutPutParms = true
                cmd.Parameters.Append cmd.CreateParameter(params(i)(0), params(i)(1), params(i)(2), params(i)(3), v)
            Else
                err.raise m_modName, "collectParams(...): incorrect # of parameters"
            End If
        Next

End Sub

Private Function collectOutputParms(ByRef cmd, argparams)
        Dim params, v, OutArray(40)
        Dim i, l, u
        'if argparams is empty
        'If Not IsArray(argparams) Then Exit Sub
        params = argparams
        For i = LBound(params) To UBound(params)
            OutArray(i) = cmd.Parameters(i).Value
        Next
        collectOutputParms = OutArray
End Function
%>

我知道这是需要审核的大量代码，抱歉。但希望其他人有同样的问题并知道如何解决它。我尝试用页面中的代码替换我的一个Server.Execute（）调用，所以基本上将调用的页面硬编码到Main.asp中，但我仍然得到错误。

0 个答案:

没有答案
相关问题
最新问题