TechQA.

Classic asp app - Error: class asp server.execute The connection cannot be used to perform this operation

984 views Asked by At

We are migrating a classic asp application from our Windows 2003 (I know, a couple of our servers our way behind here:)) box, running IIS6, to a Windows Server 2012 R2 machine using IIS 8.5.

I've done all the necessary steps to install and configure asp: Added asp roles/features, enabled parent paths, I'm running my app in 'Classic Mode', and added the .asp MIME type and Handler Mappings, and I can hit my .asp pages, but our home page, titled Main.asp, has just a bit of HTML and calls all its functionality using about Server.Execute "some_page.asp" calls, and I am getting the error in the subject line.

This has run fine for years on our 2003 box, but now, it's almost like when control is transferred to another script or paglet in our app, something goes wonky with the DB functions. I'll post some of my code below:

Main.asp page:

<%
    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 page:

<!--#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
%>

And finally, the include file where our DB logic is (I added a comment below showing the line where the subject error is always happening):

<%
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
%>

I know this is a ton of code to review, sorry. But hopefully someone else has had this same issue and knows how to resolve it. I did experiment with replacing one of my Server.Execute() calls with the code in the page, so essentially hardcoding the called page into Main.asp, but I still get the error.

asp-classic windows-server-2012 iis-8.5
Original Q&A
0

There are 0 answers

Related Questions in ASP-CLASSIC

Related Questions in WINDOWS-SERVER-2012

Related Questions in IIS-8.5

Popular Questions

Popular Tags

javascript python java c# php android html jquery c++ css ios sql mysql r reactjs node.js arrays c asp.net json python-3.x ruby-on-rails .net sql-server swift django angular objective-c pandas excel

Trending Questions