Application object restrictions in VBScript - asp-classic

I have to modify a page that is using VBScript.
I have a problem to set local variable to Application object in a function. The code below, in the getObjectSchema function, generates an error:
Set LocalSchema = Application("ObjectSchema")
While the code below, in the main body (outside of any functions) works absolutely fine:
Set Schema = Application("ObjectSchema")
Does anybody knows what is wrong? Are there any limitations for access to Application objects from a function?
Here is the complete code
<!DOCTYPE html>
<html>
<head>
<title></title>
<style type="text/css">
.style1 {
width: 87px;
}
</style>
</head>
<body>
<script type="text/vbscript">
Option Explicit
Dim ObjectSchema
Dim strXML
Dim strXML1
Dim sUserId
On Error Resume Next
Function GetUserID()
GetUserID = "{3450E0D8-EE30-48EE-B63F-486506AD1D97}"
End Function
Function getObjectSchema()
Dim LocalSchema
Set LocalSchema = Application("ObjectSchema")
If LocalSchema Is Nothing Then
Set LocalSchema = CreateObject("Scripting.Dictionary")
End if
If LocalSchema.Exists(sUserId) Then
strXML = LocalSchema.Item(sUserId)
Else
strXML = "<head><title>Title</title></head><head1><title1>Title1</title1></head1>"
LocalSchema.Add sUserId, strXML
Set Application("ObjectSchema") = LocalSchema
End if
getObjectSchema = strXML
End Function
sUserId = GetUserID()
strXML = ""
strXML1 = ""
strXML = getObjectSchema()
strXML1 = getObjectSchema()
strXML = getObjectSchema()
strXML1 = getObjectSchema()
Dim Schema
Set Schema = Application("ObjectSchema")
If Schema Is Nothing Then
Set Schema = CreateObject("Scripting.Dictionary")
End if
If Schema.Exists(sUserId) Then
strXML = LocalSchema.Item(sUserId)
Else
strXML = "<head><title>Title</title></head><head1><title1>Title1</title1></head1>"
Schema.Add sUserId, strXML
Set Application("ObjectSchema") = Schema
End if
strXML1 = strXML
</script>
</body>
</html>

Try a null check before setting LocalSchema:
If Not Application("ObjectSchema") Is Nothing Then
Set LocalSchema = Application("ObjectSchema")
End If
UPDATE
You have this running in a <script type="text/vbscript"> element, which I think means it's interpreted by the browser (specifically Internet Explorer because of the vbscript business).
The browser may not have a concept of an Application object.
Try enclosing your code in a code-block (to run it at the server) instead:
<body>
<%
Option Explicit
Dim ObjectSchema
Dim strXML
Dim strXML1
Dim sUserId
...
strXML1 = strXML
%>
</body>

Related

Closing a ADODB.Recordset VBA

I have built this VBA function but I'm getting the below error (see the next screenshot) in the below portion of the code:
Set RstUserAccess.ActiveConnection = Nothing
RstUserAccess.Close
Public Sub UserLogoutDetail(UserEmail As String)
Dim MySQL As String
Dim RstUserAccess As New ADODB.Recordset
Dim CmdUserAccess As New ADODB.Command
Dim i As Integer
'Setup the command
Set CmdUserAccess.ActiveConnection = fGetConn
CmdUserAccess.CommandType = adCmdText
MySQL = "UPDATE User_Access_TABLE SET EXIT_DATA = #" & Now & "# WHERE (((ID)=" & GetID_ToUpdate(UserEmail) & "))"
CmdUserAccess.CommandText = MySQL
RstUserAccess.CursorLocation = adUseClient
RstUserAccess.CursorType = adOpenDynamic
RstUserAccess.LockType = adLockOptimistic
'Open the connection
RstUserAccess.Open CmdUserAccess
Set RstUserAccess.ActiveConnection = Nothing
RstUserAccess.Close
'Cleanup
If CBool(CmdUserAccess.State And adStateOpen) = True Then
Set CmdUserAccess = Nothing
End If
If CBool(fGetConn.State And adStateOpen) = True Then
CloseConn
End If
End Sub
Error message
Do you have any suggestion?
Thanks
I have tried to change my code many times

Keeps getting EOF expected error

I have this problem with SOAP that I can't seem to solve.
No matter what I try, then I keep getting this error:
500 - Internal server error. There is a problem with the resource you
are looking for, and it cannot be displayed.
When digging further down the error code I'm told there is a EOF expected error?
Hope that some of you might be able to help me
<%
On Error Resume Next
Dim objXMLHTTP : set objXMLHTTP = Server.CreateObject("Msxml2.XMLHTTP.3.0")
Dim strFunction
Dim strRequest
Dim strResult
Dim strName
Dim strFirstName
Dim strLastname
Dim strAddress
Dim strZipCode
Dim strCity
Dim strTelephone
Dim strTelephone2
Dim strTelephone3
Dim strTelephone4
Dim strEmail
Dim strExtFields
Dim strStdFields
Dim CampaignID
Dim Page
Page = Request.Form("Page")
CampaignID = Request.Form("CampaignID")
StrName = Request.Form("Name")
StrTelephone = Request.Form("Phone")
strRequest = ""
<Envelope xmlns="http://schemas.xmlsoap.org/soap/envelope/"">
<Body>
<InsertNewCustomer xmlns=""http://api.ivocall.dk/ivocallservice.asmx"">
<Login>Loginname</Login>
<Password>Password</Password>
<ClientID>1323</ClientID>
<IDPassword>ag4bghsitm8gatddbpt34qjndjrbsla</IDPassword>
<CampaignID>"& campaignid &"</CampaignID>
<Name>"& StrName &"</Name>
<Firstname></Firstname>
<Lastname></Lastname>
<Address></Address>
<City></City>
<ZipCode></ZipCode>
<Telephone>"& StrTelephone &"</Telephone>
<Telephone2></Telephone2>
<Telephone3></Telephone3>
<Telephone4></Telephone4>
<email></email>
<ExtFields>landingpage="& page &"</ExtFields>
<StdFields></StdFields>
<UserName></UserName>
</InsertNewCustomer>
</Body>
</Envelope>"
objXMLHTTP.open "post", "" & "http://api.ivocall.dk/ivocallservice.asmx" & "", False
objXMLHTTP.setRequestHeader "Content-Type", "text/xml; charset=UTF-8"
objXMLHTTP.setRequestHeader "Content-Length", Len(strRequest)
objXMLHTTP.setRequestHeader "SOAPAction", "http://www.ivocall.dk/ivocallservice/InsertNewCustomer"
'send the request and capture the result
Call objXMLHTTP.send(strRequest)
strResult = objXMLHTTP.responseText
'display the XML
response.write strResult
response.write strRequest
If Err.Number <> 0 Then
Response.Write (Err.Description)
ELSE
Response.Write ("task done")
Response.End
End If
%>
I really hope some of you can help me out her?
You use inline code-tags.
<%
They do not contain any imported namespaces.
Additionally, you seem to want to copying XML into strRequest, but you're not properly escaping it, plus VB.NET (which is what you're using, not C#) doesn't support multiline strings.
And why do you use
Server.CreateObject("Msxml2.XMLHTTP.3.0")
You can use the normal WebRequest class, instead of an ActiveX-Object. And if you want to do it client-side, you need to use JavaScript (AJAX).
If you're doing a cross-domain request, you need to use CORs (and a browser supporting CORs), or you need to write a proxy that does the request for you.
Additionally, did you try adding a web-reference to your project ?
Visual Studio will automagically download the WSDL and generate the wrapper classes. Why do you want to do it by hand ? ...
Additionally, if you want to embed code in the ASPX page, do it in a "script"-tag using runat="server":
<%# Register TagPrefix="RS" Namespace="Microsoft.ReportingServices.WebServer" Assembly="ReportingServicesWebServer" %>
<%# Page Language="C#" AutoEventWireup="true" Inherits="Microsoft.ReportingServices.WebServer.ReportViewerPage" %>
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<script type="text/C#" runat="server">
protected void SetDocumentMode()
{
if(System.Web.HttpContext.Current == null || System.Web.HttpContext.Current.Request == null || System.Web.HttpContext.Current.Request.Browser == null || System.Web.HttpContext.Current.Request.Browser.Browser == null)
// return "<null>";
return;
if (!StringComparer.OrdinalIgnoreCase.Equals(System.Web.HttpContext.Current.Request.HttpMethod, "GET"))
// return "<notget>";
return;
// fu IE 11
if(System.Web.HttpContext.Current.Request.Browser.Browser == "IE" || System.Web.HttpContext.Current.Request.Browser.Browser == "InternetExplorer")
{
if(System.Globalization.CultureInfo.InvariantCulture.CompareInfo.IndexOf(System.Convert.ToString(System.Web.HttpContext.Current.Request.QueryString), "stylesheet", System.Globalization.CompareOptions.IgnoreCase) == -1 )
{
System.Web.HttpContext.Current.Response.Write(#"<meta http-equiv='X-UA-Compatible' content='IE=5'>
");
//return "<meta http-equiv=\"X-UA-Compatible\" content=\"IE=5\">"; // IE5-Quirks when no custom stylesheet (=not in iframe)
}
else
System.Web.HttpContext.Current.Response.Write("<meta http-equiv='X-UA-Compatible' content='IE=edge,chrome=1'>");
// return "<meta http-equiv=\"X-UA-Compatible\" content=\"IE=edge,chrome=1\">"; // Switch to Standards mode when a custom stylesheet is set(=in iframe)
}
// return "<not ie: " + System.Web.HttpContext.Current.Request.Browser.Browser + ">";
//return "";
}
</script>
[...]
<%SetDocumentMode(); %>
Are you actually using ASP instead of ASP.NET ?

Classic ASP ADO Setting Bookmark Causes Error

The following classic ASP code generates an error on the line rsTemp.Bookmark = varCurrBookmark. This appears to be fairly simplistic code and should work. Note that I can read the bookmark but can't set it. Also, this code will work if I uncomment the line and set the CursorLocation = 3 (use client)
ADODB.Recordset error '800a0bb9'
Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another.
/app/TestBookMark.asp, line 19.
<html>
<body>
<%
strConn = "Provider=SQLOLEDB;Data Source=localhost\sqlexpress;Initial Catalog=db;User Id=uid;Password=pwd;"
Set objDataConn = Server.CreateObject("ADODB.Connection")
objDataConn.Open strConn
strQry = "SELECT * FROM tbl"
Set rsTemp = Server.CreateObject("ADODB.Recordset")
'rsTemp.CursorLocation = 3
rsTemp.Open strQry, objDataConn,3,1
lngRecordCount = rsTemp.RecordCount
varCurrBookmark = rsTemp.Bookmark
rsTemp.MoveLast
Response.Write rsTemp.Bookmark
Response.Write "<BR>"
rsTemp.Bookmark = varCurrBookmark
Response.Write varCurrBookmark
%>
</body>
</html>

HTML Application and databases

How to access database in HTA files? Or better yet, access any COM?
I'm familiar with AutoIt, AutoHotKey and Windows Script Host. Is there a way to include any of these in an HTA app?
You do it in exactly the same way as you would in VBScript. Below is an example of creating a spreadsheet using Excel.
To access databases, you can use the ADODB object, and to create a database, you would use the ADOX object. You need to know the right connection string for the type of database you need.
<html>
<!-- COMTest.hta -->
<head>
<hta:application
id="oHTA"
border="thick"
borderstyle="raised"
caption="yes"
maximizebutton="no"
minimizebutton="yes"
showintaskbar="yes"
singleinstance="yes"
sysmenu="yes"
version="0.1"
windowstate="normal"
/>
<title>COM Test</title>
<script language="VBScript">
sub say(s)
output.innerHTML = output.innerHTML & s & "<br>"
end sub
sub ComTest()
say "testing COM"
xlFile = "c:\test\ExcelTest.xls"
' use .xslx if you have Office 2007 or greater
set fso = CreateObject("Scripting.FileSystemObject")
if fso.FileExists(xlFile) then
say "deleting test file: " & xlFile
end if
say "creating Excel Application object and workbook"
set oEx = CreateObject("Excel.Application")
set oWb = oEx.Workbooks.Add() ' create a new workbook
set oWs = oWb.Worksheets(1) ' point to first worksheet
oWs.cells(1,1) = "Test Worksheet"
oWs.cells(2,1) = "=now()"
oWs.UsedRange.Columns.AutoFit
say "saving test file: " & xlFile
oEx.DisplayAlerts = false ' if file exists, overwrite it without prompting
oWb.SaveAs xlFile
oEx.Quit
set oEx = nothing
say "done"
end sub
</script>
<style type="text/css">
body {
overflow: auto;
background-color: "blanchedalmond";
}
#output {
color: lightgreen;
background-color: black;
font-family: "Lucida Console";
font-size: 9pt;
padding: 3px;
}
</style>
</head>
<body>
<input type="button" value="test" onclick="ComTest">
<br>
<pre id="output"></pre>
</body>
<script language="vbscript">
sub ShowTitle()
say document.Title
say "command line=" & oHTA.commandLine
end sub
ShowTitle
</script>
</html>
To access the database, you will need the ActiveXObject.
var conn = new ActiveXObject("ADODB.Connection");
var rs = new ActiveXObject("ADODB.Recordset");
conn.Open("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=handbook.mdb");
rs.Open("select * from faq", conn, 3, 2);
if (!rs.BOF && !rs.EOF) {
questionField.value = rs.fields('question').value;;
answerField.value = rs.fields('answer').value;
}
I took the two answers and merged them as follows:
a) I updated ComTest() from an excel test to access an oracle db
b) ActiveXObject only works for JScript, so I converted it to VBscript as per: http://msdn.microsoft.com/en-us/library/ms756007(v=vs.85).aspx
sub ComTest()
say "testing COM"
dim conn, rs
set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
conn.Open("Provider=OraOLEDB.Oracle;Data Source=XXXX;User ID=XXXX;Password=XXXX")
say "open conn"
rs.Open "select sysdate from dual", conn
say "sqlResult =" & rs.Fields("sysdate").Value
'Close connection and clean up objects
conn.Close
say "close conn"
Set rs = Nothing
Set conn = Nothing
say "done"
end sub

LDAP + ASP Classic + ADODB = 2147217865. (Using LDAP to talk to Active Directory in ASP Classic. Error:2147217865)

I need to use LDAP to authenticate users for an old ASP website.
I have been using the code found here.
It looks like this:
<%# LANGUAGE=VBSCRIPT %>
<%Option Explicit%>
<%
Function getADUserInfo(strUID)
on error resume next
strGeneralLookupError = false
strBase = "<LDAP://DC=[DOMAIN], DC=[DOMAIN EXETENTION]>"
strFilter = "(sAMAccountName=" & strUID & ")"
strAttributes = "cn, mail, company, givenName, sn, ADsPath, name, sAMAccountName, telephoneNumber"
'strAttributes = "cn, company, givenName, sn, ADsPath, name, sAMAccountName, telephoneNumber"
strScope = "subtree"
strFullCommand = strBase & ";" & strFilter & ";" & strAttributes & ";" & strScope
set rsADUserInfo = Server.CreateObject("ADODB.Recordset")
set rsADUserInfo = connAD.Execute(strFullCommand)
if err.number <> 0 then
strGeneralLookupError = true
end if
set getADUserInfo = rsADUserInfo
set rsADUserInfo = Nothing
End Function
Sub getUserData(p_strUserID)
on error resume next
set rsUserData = Server.CreateObject("ADODB.Recordset")
set rsUserData = getADUserInfo(p_strUserID)
if not rsUserData.EOF then
strUserGN = rsUserData("givenName")
strUserSN = rsUserData("sn")
strUserOU = rsUserData("company")
strUserEmail = rsUserData("mail")
strUserPhone = rsUserData("telephoneNumber")
else
strADLookupSuccess = false
end if
rsUserData.Close
set rsUserData = Nothing
End Sub
on error resume next
response.expires = 0
DIM connAD, rsUserData, rsADUserInfo
DIM strUserGN, strUserSN, strUserOU, strUserEmail, strUserPhone
DIM strBase, strFilter,strAttributes, strScope, strFullCommand
DIM strGeneralLookupError, strADLookupSuccess
DIM strUserID
strUserGN = "The user can not be found in the system."
strGeneralLookupError = false
strADLookupSuccess = true
set connAD = Server.CreateObject("ADODB.Connection")
connAD.Provider = "ADsDSOObject"
connAD.Properties("User ID") = "[DOMAIN]\[USERNAME]" ' ### remember to make sure this user has rights to access AD
connAD.Properties("Password") = "[PASSWORD]"
connAD.Properties("Encrypt Password") = true
connAD.Open
strUserID = "[USERNAME YOU WANT INFO FOR]"
call getUserData(strUserID)
connAD.Close
set connAD = Nothing
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<title>ASP Code to access AD with LDAP Page</title>
</head>
<body>
<%=strUserGN%>
<%=strUserSN%><br />
<%=strUserOU%><br />
<%=strUserEmail%><br />
<%=strUserPhone%><br />
</body>
</html>
I can pull back info using C# so I don't think it's the server that is causing the issue.
All I end up with is a 2147217865 error.
The AD server is Windows Server 2003.
The web server is IIS on XP Pro.
I have tried changing strFullCommand to:
Select cn From 'LDAP://SEVERPATH' where objectClass='user'" & " and objectcategory='person'
No dice there. Any ideas?
This works:
function AuthenticateUser(UserName, Password, Domain)
dim strUser
' assume failure
AuthenticateUser = false
strUser = UserName
strPassword = Password
strQuery = "SELECT cn FROM 'LDAP://" & Domain & "' WHERE objectClass='*' "
set oConn = server.CreateObject("ADODB.Connection")
oConn.Provider = "ADsDSOOBJECT"
oConn.Properties("User ID") = strUser
oConn.Properties("Password") = strPassword
oConn.Properties("Encrypt Password") = true
oConn.open "DS Query", strUser, strPassword
set cmd = server.CreateObject("ADODB.Command")
set cmd.ActiveConnection = oConn
cmd.CommandText = strQuery
on error resume next
set oRS = cmd.Execute
if oRS.bof or oRS.eof then
AuthenticateUser = false
else
AuthenticateUser = true
end if
set oRS = nothing
set oConn = nothing
end function
The first thing I'd do to debug this is get rid of those On Error Resume Next statements. They could be hiding a multitude of sins that you're not seeing properly reported.

Resources