Hello, I am working on a program that will connect an audio visual system to a SQL server. The software I'm using generates an ASP file that helps my A/V programming software translate XML. I am 99% sure I have configured everything correctly, but when I run some SQL commands I am receiving the following error: Microsoft OLE DB Provider for ODBC Drivers (0x80040E21) Multiple-step OLE DB operation generated errors. Check each OLE DB status value, if available. No work was doneattached is the ASP file code:<%'---------------------------------------------------------------------------------' CRRS.asp - Database Gateway' Generated 2/9/2015' By AMX DBWizard, Version 1.4.22'---------------------------------------------------------------------------------%> <!-- #INCLUDE FILE="NetlinxDBInclude.asp" --> <%'---------------------------------------------------------------------------------' Call RunDBQuery on our database'---------------------------------------------------------------------------------' This will open connection to DB and run the SQL supplied via CGI if it exists...RunDBQuery "Data Source=APLDBCL1-dv1\dev1;Initial Catalog=GEDCRRS;Integrated Security=True", ""'''---------------------------------------------------------------------------------' End of file'---------------------------------------------------------------------------------%>
<%'(*********************************************************************)'(* AMX Corporation *)'(* Copyright (c) 2000 - 2005 AMX Corporation. All rights reserved. *)'(*********************************************************************)'(* please refer to EULA.TXT for software license agreement *)'(*********************************************************************)'(* *)'(* NetlinxDBInclude *)'(* i!-DatabasePlus (1.4.23) *)'(* *)'(*********************************************************************)'---------------------------------------------------------------------------------' NetlinxDBInclude - Database Gateway' AMX Database Integration Kit v1.0' ©2005 AMX'---------------------------------------------------------------------------------Option Explicit' VersionConst strFileVersion = "1.4.23"' ADO Cursor TypesConst adOpenForwardOnly = 0Const adOpenKeyset = 1Const adOpenDynamic = 2Const adOpenStatic = 3' ADO Lock TypeConst adLockReadOnly = 1Const adLockPessimistic = 2Const adLockOptimistic = 3Const adLockBatchOptimistic = 4' ADO Source EvaluationConst adCmdText = 1Const adCmdTable = 2Const adCmdTableDirect = 512Const adCmdStoredProc = 4Const adCmdUnknown = 9Const adCommandFile = 256' ADO StatesConst adStateOpen = 1' ADO Var typesConst adEmpty = 0Const adTinyInt = 16Const adSmallInt = 2Const adInteger = 3Const adBigInt = 20Const adUnsignedTinyInt = 17Const adUnsignedSmallInt = 18Const adUnsignedInt = 19Const adUnsignedBigInt = 21Const adSingle = 4Const adDouble = 5Const adCurrency = 6Const adDecimal = 14Const adNumeric = 131Const adBoolean = 11Const adError = 10Const adUserDefined = 132Const adVariant = 12Const adIDispatch = 9Const adIUnknown = 13Const adGUID = 72Const adDate = 7Const adDBDate = 133Const adDBTime = 134Const adDBTimeStamp = 135Const adBSTR = 8Const adChar = 129Const adVarChar = 200Const adLongVarChar = 201Const adWChar = 130Const adVarWChar = 202Const adLongVarWChar = 203Const adBinary = 128Const adVarBinary = 204Const adLongVarBinary = 205Const adChapter = 136Const adFileTime = 64Const adDBFileTime = 137Const adPropVariant = 138Const adVarNumeric = 139'---------------------------------------------------------------------------------' Function: VariableHeader' Purpose: Get header for variable based on type'---------------------------------------------------------------------------------Function VariableHeader(mvarnADoVarType) ' Define the var Select Case mvarnADoVarType ' Special 8-byte values - man that's big! Case adBigInt VariableHeader = "str" Case adUnsignedBigInt VariableHeader = "str" ' Standard 8 it values Case adEmpty, adUnsignedTinyInt VariableHeader = "ch" ' Boolean variant of above Case adBoolean VariableHeader = "b" ' Int's - 2-byte vales Case adUnsignedSmallInt VariableHeader = "n" Case adSmallInt, adTinyInt VariableHeader = "sn" ' Longs - 4-byte vales Case adChapter, adError, adUnsignedInt VariableHeader = "l" Case adInteger VariableHeader = "sl" ' Floats and doubles Case adSingle, adVarNumeric VariableHeader = "f" Case adDecimal, adDouble, adNumeric VariableHeader = "d" 'Strings! Case adBSTR, adChar, adCurrency, adDate, adDBDate, adDBFileTime, adDBTime, adDBTimeStamp, _ adFileTime, adGUID, adLongVarBinary, adLongVarChar, adVarChar, adVariant, _ adBinary, adVarBinary VariableHeader = "str" ' Wide strings Case adLongVarWChar, adVarWChar, adWChar VariableHeader = "str" ' Unsupported Case adIDispatch, adIUnknown, adPropVariant, adUserDefined VariableHeader = "" End SelectEnd Function'---------------------------------------------------------------------------------' Function: XMLTag' Purpose: Convert fields name to XML compatible tag'---------------------------------------------------------------------------------Function XMLTag(szStr) Dim szString szString = szStr ' Convert string to XML compatible tag by removing all invalid characters from string szString = Replace(szString, "%", "", 1) szString = Replace(szString, """", "", 1) szString = Replace(szString, ",", "", 1) szString = Replace(szString, " ", "", 1) szString = Replace(szString, ";", "", 1) szString = Replace(szString, "/", "", 1) szString = Replace(szString, "?", "", 1) szString = Replace(szString, ":", "", 1) szString = Replace(szString, "@", "", 1) szString = Replace(szString, "=", "", 1) szString = Replace(szString, "+", "", 1) szString = Replace(szString, "$", "", 1) szString = Replace(szString, "<", "", 1) szString = Replace(szString, ">", "", 1) szString = Replace(szString, "#", "", 1) szString = Replace(szString, "{", "", 1) szString = Replace(szString, "}", "", 1) szString = Replace(szString, "|", "", 1) szString = Replace(szString, "\", "", 1) szString = Replace(szString, "^", "", 1) szString = Replace(szString, "[", "", 1) szString = Replace(szString, "]", "", 1) szString = Replace(szString, "`", "", 1) szString = Replace(szString, "&", "", 1) XMLTag = Trim(szString)End Function'---------------------------------------------------------------------------------' Function: CDATAit' Purpose: Convert XML Param to CDATA format'---------------------------------------------------------------------------------Function CDATAit(ByVal strData) If (InStr(1, strData, "/") Or _ InStr(1, strData, "&") Or _ InStr(1, strData, ">") Or _ InStr(1, strData, "<")) Then CDATAit = "<![CDATA[" & strData & "]]>" Exit Function End If CDATAit = strDataEnd Function'---------------------------------------------------------------------------------' Function: GetXMLFromADORS' Purpose: Convet ADO RS to XML'---------------------------------------------------------------------------------Function GetXMLFromADORS(ByVal objADORS, ByVal strHdr, ByVal nStart, ByVal nPageSize, ByVal bABS, ByVal nPanelIndex) Dim objField Dim strXMLString Dim strFieldName Dim strFieldTag Dim strFieldValue Dim nCount Dim nNumRecords Dim nTotalRecords ' Now loop over recordset to obtain the entries we are interested in nCount = 1 nCount = CInt(objADORS.AbsolutePosition) 'might no work with all providers... If (nCount < 1) Then nCount = 1 ' How many records will we see? nNumRecords = 0 nTotalRecords = CInt(objADORS.RecordCount) If (nTotalRecords > 0) Then If (nTotalRecords >= (nStart+nPageSize)) Then nNumRecords = nPageSize Else nNumRecords = nTotalRecords - nStart + 1 End If End If ' Add some info - in a struct strXMLString = strXMLString & vbTab & "<struct>" & vbCrLf If (nStart >= 0) Then strXMLString = strXMLString & vbTab & vbTab & "<var><name>Start</name><data>" & nStart & "</data></var>" & vbCrLf If (nPageSize >= 0) Then strXMLString = strXMLString & vbTab & "<var><name>PageSize</name><data>" & nPageSize & "</data></var>" & vbCrLf If (nNumRecords >= 0) Then strXMLString = strXMLString & vbTab & "<var><name>NumberRecords</name><data>" & nNumRecords & "</data></var>" & vbCrLf If (nTotalRecords >= 0) Then strXMLString = strXMLString & vbTab & "<var><name>TotalRecords</name><data>" & nTotalRecords & "</data></var>" & vbCrLf strXMLString = strXMLString & vbTab & "<var><name>PanelIndex</name><data>" & nPanelIndex & "</data></var>" & vbCrLf strXMLString = strXMLString & vbTab & "</struct>" & vbCrLf ' Add array encoding strXMLString = strXMLString & vbTab & "<array>" & vbCrLf ' Run the loop Do While ((Not objADORS.EOF) And (nCount < (nStart+nPageSize))) ' Let's see if this record is inside our window of interest... If ((CInt(nCount) >= CInt(nStart))) And (CInt(nCount) < (CInt(nStart)+CInt(nPageSize))) Then ' Add a record field to the output strXMLString = strXMLString & vbTab & vbTab & "<struct>" & vbCrLf If (bABS = True) Then strXMLString = strXMLString & vbTab & vbTab & vbTab & "<index>" & CStr(nCount) & "</index>" & vbCrLf Else strXMLString = strXMLString & vbTab & vbTab & vbTab & "<index>" & CStr(nCount-nStart+1) & "</index>" & vbCrLf End If ' For each field in the recordset... For Each objField In objADORS.Fields ' Get the name of the field (the column name) and convert to XML strFieldName = objField.Name & "" strFieldTag = VariableHeader(objField.Type) & XMLTag(strFieldName) ' Get the value of the field and convert to XML ' Non-English version of Windows convert BOOL's to language specific TRUE/FALSE tags so ' Catch BOOL's before this happens... If (VarType(objADORS(strFieldName)) = vbBoolean) Then strFieldValue = "0" If (objADORS(strFieldName) = True) Then strFieldValue = "1" End If Else strFieldValue = CStr(objADORS(strFieldName) & "") End If ' If the data contains XML stuff, remove it... strFieldValue = CDATAit(strFieldValue) ' Pack filed and value into XML output strFieldTag = CStr(strFieldTag) strFieldValue = CStr(strFieldValue) ' String encoded If (Left(strFieldTag,3) = "str") Then strXMLString = strXMLString & vbTab & vbTab & vbTab & "<array>" & _ "<name>" & strFieldTag & "</name>" If (Len(strFieldValue) = 0) Then strXMLString = strXMLString & "<string />" Else strXMLString = strXMLString & "<string>" & strFieldValue & "</string>" End If strXMLString = strXMLString & "</array>" '& vbCrLf ' All others Else strXMLString = strXMLString & vbTab & vbTab & vbTab & "<var>" & _ "<name>" & strFieldTag & "</name>" If (Len(strFieldValue) = 0) Then strXMLString = strXMLString & "<data />" Else strXMLString = strXMLString & "<data>" & strFieldValue & "</data>" End If strXMLString = strXMLString & "</var>" '& vbCrLf End If Next ' Finish up the record... strXMLString = strXMLString & vbTab & vbTab & "</struct>" & vbCrLf End If ' Loop and keep track of count... objADORS.MoveNext nCount = nCount + 1 Loop ' Close off the header and return XML... strXMLString = strXMLString & vbTab & "</array>" & vbCrLf GetXMLFromADORS = strXMLStringEnd Function'---------------------------------------------------------------------------------' Function: ErrorToXML' Purpose: Convert Error to XML'---------------------------------------------------------------------------------Function ErrorToXML(nNumber, strDesc) Response.Write ("<scriptError>" & vbCrLf) Response.Write (" <errorNumber>" & CStr(nNumber) & "</errorNumber>" & vbCrLf) Response.Write (" <errorDescription>" & strDesc & "</errorDescription>" & vbCrLf) Response.Write ("</scriptError>" & vbCrLf)End Function'---------------------------------------------------------------------------------' Function: RunDBQuery' Purpose: Tie it all together'---------------------------------------------------------------------------------Function RunDBQuery(strDBPath, strProvider) ' Vars Dim strConnection Dim myConnection Dim rstRecordSet Dim strHdr Dim strSql Dim nPageSize Dim nStart Dim strXML Dim nPos Dim strPath Dim bABS Dim nPanelIndex ' Error On Error Resume Next ' Get the header for the XML... strHdr = Trim(Request.QueryString("hdr")) If (Len(strHdr) = 0) Then strHdr = "Unknown" ' Start off the XML with xml declaration... Response.ContentType = "text/xml" Response.Write ("<?xml version='1.0' ?>" & vbCrLf) Response.Write ("<rs" & strHdr & ">" & vbCrLf) Response.Write (" <scriptVersion>" & strFileVersion & "</scriptVersion>" & vbCrLf) ' Create connection Err.Clear Set myConnection = Server.CreateObject("ADODB.Connection") Set rstRecordSet = Server.CreateObject("ADODB.Recordset") If (Err.Number) Then ErrorToXML Err.Number, "Cannot create ADO objects: " & Chr(34) & Err.Description & Chr(34) Response.Write ("</rs" & strHdr & ">") Exit Function End If ' Set provider if supplied If (Len(strProvider)) Then myConnection.Provider = strProvider ' If not supplied, look for MDB file since this is pretty common... ElseIf (Instr(1, uCase(strDBPath), ".MDB")) Then myConnection.Provider = "Microsoft.Jet.OLEDB.4.0" End If ' Copy file name - add ASP file path if no path included ' This assumes that the DB is in the same directory as the APS file! strPath = "" If ((InStr(1, strDBPath, "\") = 0) And (InStr(1, strDBPath, "=") = 0)) Then nPos = InStrRev(Request.ServerVariables("PATH_TRANSLATED"), "\") If (nPos = 0) Then nPos = Len(Request.ServerVariables("PATH_TRANSLATED")) strPath = Left(Request.ServerVariables("PATH_TRANSLATED"), nPos) End If strConnection = strPath & strDBPath ' Open Connection Err.Clear myConnection.Open strConnection If (Err.Number) Then ErrorToXML myConnection.State, Err.Description Response.Write ("</rs" & strHdr & ">") Exit Function End If If (myConnection.State <> adStateOpen) Then ErrorToXML myConnection.State, "Cannot open database: " & Chr(34) & strConnection & Chr(34) Response.Write ("</rs" & strHdr & ">") Exit Function End If ' Get criterea from CGI... strSql = Trim(Request.QueryString("sql")) nPageSize = Trim(Request.QueryString("ps")) If (Len(nPageSize) = 0) Then nPageSize = 10 Else nPageSize = CInt(nPageSize) End If nStart = Trim(Request.QueryString("start")) If (Len(nStart) = 0) Then nStart = 1 Else nStart = CInt(nStart) If (nStart < 1) Then nStart = 1 End If bABS = False If (Len(Trim(Request.QueryString("abs")))) Then bABS = True nPanelIndex = Trim(Request.QueryString("pnl")) If (Len(nPanelIndex) = 0) Then nPanelIndex = 1 Else nPanelIndex = CInt(nPanelIndex) End If ' No SQL - This is a problem If (Len(strSql) < 1) Then ErrorToXML 0, "No SQL Supplied" Response.Write ("</rs" & strHdr & ">") Exit Function End If ' Get recordset... ' Set a 5 Minutes - this might take a while Err.Clear Server.ScriptTimeOut = 600 rstRecordSet.Open strSql, myConnection, adOpenStatic, adLockReadOnly, adCmdText If (Err.Number) Then ErrorToXML Err.Number, "Cannot open recordset: " & Chr(34) & Err.Description & Chr(34) Response.Write ("</rs" & strHdr & ">") Exit Function End If ' If the recordset is open, get the data If (rstRecordSet.State > 0) Then ' Convert recordset to XML... strXML = GetXMLFromADORS(rstRecordSet, strHdr, nStart, nPageSize, bABS, nPanelIndex) Response.Write (strXML) Else ' Recodset is closed to return empty recordset Response.Write (" <recordsetState>Closed</recordsetState>") End If ' Check For Errors and include them... If (Err.Number And Len(strXML) = 0) Then ErrorToXML Err.Number, Err.Description End If ' Clean Up Response.Write ("</rs" & strHdr & ">") rstRecordSet.Close myConnection.Close Set myConnection = Nothing Set rstRecordSet = NothingEnd Function'---------------------------------------------------------------------------------' End of file'---------------------------------------------------------------------------------%>Any help would be appreciated. Thanks,Matt
Multiple OLE Error
Posted - 2015-02-10 : 14:35:53
