Bill, thanks for the reply. I am new and not certain which info is relevant.
There are severl hundred lines of code and I did not want to dump that on the readers.
To provide more context...
This web application displays the users logon id, name, and email address then will check that the user is a member of an AD group prior to allowing them to submit requests to restricted services.
Users of this web application are being upgraded from Window 7 to Window 10. The application contains as one might expect, HTML, CSS, javascript, jquery with ajax and json. And VBscript. The ajax code is calling the VBscript. The VBscript if I understand
correctly runs on the server.
The server is Windows 2012 x64 R2.
The code running on this server fails only when the client is on a Windows 10 OS.
The javascript code snipit is below, followed by the complete VBScript code PromoADuser.asp. The
Private Function OpenObjUserLDAP returns with an error at this statement
Set ObjUserLDAP = GetObject( "LDAP://" & ADuserDN & "" )
The value of ADuserDN is CN=John Doe,OU=Users,OU=Production,DC=CN,DC=CA
function get_user_info() {
$.ajax( {
url: '/PromotionForm/scripts/PromoADuser.asp?req=pin&rnd=' + (new Date).getTime(), // rnd : refresh each call to get uptodate info !!!,
type: 'POST',
contentType: 'application/x-www-form-urlencoded; charset=utf-8', // default
async: false,
dataType: "json",
success: function( json ) { proc_user_info( json ); }, // function( json, status ) { alert( json ); }
error: function( jqXHRobj, status, error ) { // Note : error: function() not called for cross-domain script and cross-domain JSONP requests
alert( status + ' / ' + error ); // eg.: "error / Not Found" if the url given does not exisit / eg.: "parseerror / SyntaxError: Syntax error"
}
} );
}
<%@ LANGUAGE="VBScript" CODEPAGE="65001" %>
<% Option Explicit %>
<% Response.CodePage = 65001 %>
<% Response.CharSet = "UTF-8" %>
<% Response.ContentType = "text/html" %>
<% Response.CacheControl = "no-store" ' File not stored in the local cache %>
<% Response.CacheControl = "private" %>
<% Response.Expires = -1 %>
<% Response.ExpiresAbsolute = Now() - 2 %>
<% Response.AddHeader "pragma","no-cache" %>
<% Response.AddHeader "cache-control","private" %>
<% 'Response.ContentType = "application/x-www-form-urlencoded" %>
<% 'Server.ScriptTimeout = 600 %>
<% 'øøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøø %>
<% 'øøø Written by øøø %>
<% 'øøø Updated Aug. 10, 2015 øøø %>
<% 'øøø The Promotion Form home page calls here using url query string data. øøø %>
<% 'øøø øøø %>
<% 'øøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøøø %>
<%
'~~~ Private Functions to this script only ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Function GetADval( ByRef ADval, ByVal ObjUserLDAP )
On Error Resume Next
Select Case ADval
Case "PIN"
ADval = Request.ServerVariables( "AUTH_USER" )
Response.Write("")
ADval = Right( ADval, Len( ADval ) - InStrRev( ADval, "\") )
ADval = LCase( ADval )
' ADval = ObjUserLDAP.SAMAccountname
Case "Common Name"
ADval = ObjUserLDAP.cn
Case "Email Address"
ADval = ObjUserLDAP.emailAddress
Case else
ADval = "Property not available"
End Select
'If ( ADval = "" ) Then ADval = "(empty)"
If ( Err.Number <> 0 ) Then
GetADval = Err.Description
GetADval = Replace( GetADval, VbCrLf, " " )
GetADval = Replace( GetADval, "'", " " )
Err.Clear()
Exit Function
End If
GetADval = "OK"
End Function
Private Function GetADuserDN( ByRef ADuserDN )
On Error Resume Next
Dim ObjSysInfo
GetADuserDN = "ObjSysInfo Is Nothing"
Set ObjSysInfo = Server.CreateObject( "ADSystemInfo" )
If ( Err.Number <> 0 ) Then
Set ObjSysInfo = Nothing
ADuserDN = ""
GetADuserDN = "ObjSysInfo : " & Err.Description
GetADuserDN = Replace( GetADuserDN, VbCrLf, " " )
GetADuserDN = Replace( GetADuserDN, "'", " " )
Err.Clear()
Exit Function
End If
If ( ObjSysInfo Is Nothing ) Then Exit Function
ADuserDN = ObjSysInfo.UserName ' Returns user's Distinguished Name eg.: "CN=Firstnane Lastname,OU=Users,OU=Production,DC=CN,DC=CA"
Set ObjSysInfo = Nothing
If ( Err.Number <> 0 ) Then
GetADuserDN = "ObjSysInfo.UserName : " & Err.Description
GetADuserDN = Replace( GetADuserDN, VbCrLf, " " )
GetADuserDN = Replace( GetADuserDN, "'", " " )
Err.Clear()
Exit Function
End If
GetADuserDN = "OK"
End Function
Private Function OpenObjUserLDAP( ByRef ObjUserLDAP, ByVal ADuserDN )
On Error Resume Next
OpenObjUserLDAP = "ObjUserLDAP Is Nothing"
Set ObjUserLDAP = GetObject( "LDAP://" & ADuserDN & "" ) ' or "LDAP://CN.CA/" ...
If ( Err.Number <> 0 ) Then
Set ObjUserLDAP = Nothing
OpenObjUserLDAP = "ObjUserLDAP Error " & Err.Description
OpenObjUserLDAP = Replace( OpenObjUserLDAP, VbCrLf, " " )
OpenObjUserLDAP = Replace( OpenObjUserLDAP, "'", " " )
Err.Clear()
Exit Function
End If
If ( ObjUserLDAP Is Nothing ) Then Exit Function
OpenObjUserLDAP = "OK"
End Function
'~~~ End Private Functions ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Private Function GetUserInfoPINNameEmail( ByRef PINAD, ByRef CommonNameAD, ByRef EmailAddressAD )
PINAD = "PIN"
CommonNameAD = "Common Name"
EmailAddressAD = "Email Address"
Dim ADuserDN ' user's distinguished name string is returned ByRef from function GetADuserDN
GetUserInfoPINNameEmail = GetADuserDN( ADuserDN )
If ( GetUserInfoPINNameEmail <> "OK" ) Then Exit Function
Dim ObjUserLDAP ' object to use to search with is returned ByRef from function OpenObjUserLDAP
GetUserInfoPINNameEmail = OpenObjUserLDAP( ObjUserLDAP, ADuserDN )
If ( GetUserInfoPINNameEmail <> "OK" ) Then Exit Function
Dim FirstError
FirstError = "OK"
' Function GetADval returns "OK" or some "error message" - the 1st param returns the requested value or "" if empty
GetUserInfoPINNameEmail = GetADval( PINAD, ObjUserLDAP ) ' we MUST have the user's PIN
If ( ( GetUserInfoPINNameEmail <> "OK" ) And ( FirstError = "OK" ) ) Then FirstError = PINAD & " : " & GetUserInfoPINNameEmail
GetUserInfoPINNameEmail = GetADval( CommonNameAD, ObjUserLDAP ) ' user's name is optional
'If ( ( GetUserInfoPINNameEmail <> "OK" ) And ( FirstError = "OK" ) ) Then FirstError = CommonNameAD & " : " & GetUserInfoPINNameEmail
If ( GetUserInfoPINNameEmail <> "OK" ) Then CommonNameAD = ""
GetUserInfoPINNameEmail = GetADval( EmailAddressAD, ObjUserLDAP ) ' user's email address is optional
'If ( ( GetUserInfoPINNameEmail <> "OK" ) And ( FirstError = "OK" ) ) Then FirstError = EmailAddressAD & " : " & GetUserInfoPINNameEmail
If ( GetUserInfoPINNameEmail <> "OK" ) Then EmailAddressAD = ""
Set ObjUserLDAP = Nothing
GetUserInfoPINNameEmail = FirstError ' return "OK" if PIN is found
End Function
%>
<%
Private Function FoundMemberInGroup( ByRef ADgroupAuth, ByVal ADUserPIN, ByVal UserGroup )
' ADUserPIN AND UserGroup will NEVER be "" here
ADgroupAuth = "N/D"
Dim ObjADUser
On Error Resume Next
Set ObjADUser = GetObject( "WinNT://CN.CA/" & UserGroup & ",Group" )
If ( Err.Number <> 0 ) Then
Set ObjADUser = Nothing
FoundMemberInGroup = Err.Description
FoundMemberInGroup = Replace( FoundMemberInGroup, "'", "" )
FoundMemberInGroup = Replace( FoundMemberInGroup, VbCrLf, "" )
FoundMemberInGroup = FoundMemberInGroup & " - User " & ADUserPIN & " group membership could not be determined (WinNT)."
Exit Function
End If
Dim Found, Member
Found = False
For Each Member In ObjADUser.members
If ( LCase( Member.Name ) = LCase( ADUserPIN ) ) Then
Found = True
Exit For
End If
Next
If ( Err.Number <> 0 ) Then
Set ObjADUser = Nothing
FoundMemberInGroup = Err.Description
FoundMemberInGroup = Replace( FoundMemberInGroup, "'", "" )
FoundMemberInGroup = Replace( FoundMemberInGroup, VbCrLf, "" )
FoundMemberInGroup = FoundMemberInGroup & " - User " & ADUserPIN & " group membership could not be determined (ObjADUser.members)."
Exit Function
End If
Set ObjADUser = Nothing
ADgroupAuth = "NotMember"
If ( Found = True ) Then ADgroupAuth = "IsMember"
FoundMemberInGroup = "OK"
End Function
Dim AppRequest, AppStatus, UsrPIN, UsrName, UsrEmail, GroupAuth
UsrPIN = "N/D"
UsrName = "N/D"
UsrEmail = "N/D" ' return user's email if found in AD - if not found return "" and user will type in his own email
AppStatus = "Error in request" ' will be "OK" OR "some error message"
GroupAuth = "N/D" ' will be "N/D", "NotMember" OR "IsMember"
' Promotion Request MAIN page calls this script by QUERYSTRING - "GET"
AppRequest = Request.QueryString( "req" )
' Promotion Request IFRAME Existing and Scheduled and New forms call this script by FORM DATA - "POST"
If ( AppRequest <> "pin" ) Then AppRequest = Request.Form ' the form data can ONLY only = "pin".
If ( AppRequest = "pin" ) Then ' return UsrPIN ( and optional UsrName and UsrEmail if present ) and the AppStatus.
AppStatus = GetUserInfoPINNameEmail( UsrPIN, UsrName, UsrEmail ) ' returns "OK" if PIN is found or "an error msg" if not
If ( AppStatus = "OK" ) Then
'Also return GroupAuth = whether user is part of the "Web-CNINET-Author" or "Web-promo-Author" AD groups that can promote ALL sites
AppStatus = FoundMemberInGroup( GroupAuth, UsrPIN, "Web-CNINET-Author" ) ' returns "OK" ( no errors ) OR "some error msg"
If ( ( AppStatus = "OK" ) And ( GroupAuth = "NotMember" ) ) Then AppStatus = FoundMemberInGroup( GroupAuth, UsrPIN, "Web-promo-Author" )
End If
End If
'AppStatus returns "OK" OR some error message - GroupAuth returns "N/D", NotMember" OR "IsMember"
Response.Write( "[{""pin"": """ & UsrPIN & """,""name"": """ & UsrName & """,""email"": """ & UsrEmail
& """,""status"": """ & AppStatus & """,""groupauth"": """ & GroupAuth & """}]" )
%>
