Has anybody here been able to implement JSON with ASP?
I'm working on an ajax implementation and I want to use JSON. The only implementations I've found are C# implementations. While I don't mind using C#, I don't own the server (webhost) so I don't think I can use a compiled C# file on there (can I?).
I'm fairly competent in ASP, but not a lot of experience (usually PHP). Any help is appreciated. Thanks.
Has anybody here been able to implement JSON with ASP?
I'm working on an ajax implementation and I want to use JSON. The only implementations I've found are C# implementations. While I don't mind using C#, I don't own the server (webhost) so I don't think I can use a compiled C# file on there (can I?).
I'm fairly competent in ASP, but not a lot of experience (usually PHP). Any help is appreciated. Thanks.
Since I was going through something similar Old Pedant suggested I post my question so it could be solved and possibly help other people! I ended up figuring things out so I'll simply post what I have [as well as a picture of a sample output] and hopefully 2 things will happen... 1. It will help out someone out there and 2. since there is always room for improvement maybe someone will find things in my code that could be improved!
That said, here is what I can provide:
Code:
Sub AspectStats(sFrom, sTo, sDepartment, sManager, sCoach, sCsr, sResponsableName)
dim sID, oRst, strSQL, oRds
dim sLevel
dim dateCondition
strOutputbuff = ""
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If sCsr <> vbNullString Then
sLevel = CALLLEVEL
sID = sCsr
'If sResponsableName = vbNullString Then sResponsableName = GetEmployeeName(sID,0)
strSQL = "Prg_AspectStats '" & sFrom & "','" & sTo & "'," & "NULL," & "NULL," & sDepartment & "," & sCsr
ElseIf sCoach <> vbNullString Then
sLevel = CSRLEVEL
sID = sCoach
'If sResponsableName = vbNullString Then sResponsableName = GetEmployeeName(sID,0)
strSQL = "Prg_AspectStats '" & sFrom & "','" & sTo & "'," & sCoach & ",NULL," & sDepartment
ElseIf sManager <> vbNullString Then
sLevel = COACHLEVEL
sID = sManager
'If sResponsableName = vbNullString Then sResponsableName = GetEmployeeName(sID,0)
strSQL = "Prg_AspectStats '" & sFrom & "','" & sTo & "',NULL," & sManager & "," & sDepartment
Else
sLevel = MANAGERLEVEL
sID = sDepartment
'If sResponsableName = vbNullString Then sResponsableName = GetEmployeeName(sID,1)
strSQL = "Prg_AspectStats '" & sFrom & "','" & sTo & "',NULL," & "NULL," & sDepartment
End If
change(strSQL)
dim fRst
call addtobuff("<BR>")
call addtobuff("<table border='1' BORDER CELLSPACING='0'>")
' Titles of columns
If sCsr = vbNullString Then
call addtobuff("<tr><td><b>Name</b></td><td><b>Inc Talk Time < 15 sec</b></td><td><b>Inc Hold > 2 x Inc Talk</b></td><td><b>Outgoing No Dialed Digits</b></td><td><b>Short Outgoing Dialed Digits</b></td><td><b>Insides Talk < 10</b></td><td><b>Cold Transfers</b></td><td><b>Total Calls</b></td></tr>")
else
call addtobuff("<tr><td><b>Date</b></td><td><b>Inc Talk Time < 15 sec</b></td><td><b>Inc Hold > 2 x Inc Talk</b></td><td><b>Outgoing No Dialed Digits</b></td><td><b>Short Outgoing Dialed Digits</b></td><td><b>Insides Talk < 10</b></td><td><b>Cold Transfers</b></td><td><b>Total Calls</b></td></tr>")
end if
Set fRst = returnValue
call addtobuff("<tr>")
For count=0 To fRst.RecordCount - 1
accessArray fRst, count
Set oRst = accessArrayReturn
If sCsr = vbNullString Then
if IsEmpty(oRst.Name) then
call addtobuff ("<td>" & sResponsableName & "</td>")
else
call addtobuff("<td>" & "<i><b><u><font size = 3 style = ""cursor:hand;"" onClick='SearchFor(" & sLevel & "," & sTab & ",""" & oRst.Emp_Id & """,""" & sFrom & """,""" & sTo & """,""" & sDepartment & """,""" & oRst.Name & """)'>" & oRst.Name & "</a></b></u></i></td>")
End if
if IsEmpty(oRst.[Inc Talk Time < 15 sec]) then
call addtobuff ("<td>" & "n/a" & "</td>")
else
call addtobuff("<td>" & "<i><center>" & oRst.[Inc Talk Time < 15 sec] & "</center></i>" & "</td>")
End if
if IsEmpty(oRst.[Inc Hold > 2 x Inc Talk]) then
call addtobuff ("<td><b>" & "n/a" & "</b></td>")
else
call addtobuff("<td>" & "<i><center>" &oRst.[Inc Hold > 2 x Inc Talk] & "</center></i>" & "</td>")
End if
if IsEmpty(oRst.[Outgoing No Dialed Digits]) then
call addtobuff ("<td>" & "n/a" & "</td>")
else
call addtobuff("<td>" & "<i><center>" &oRst.[Outgoing No Dialed Digits] & "</center></i>" & "</td>")
End if
if IsEmpty(oRst.[Short Outgoing Dialed Digits]) then
call addtobuff ("<td>" & "n/a" & "</td>")
else
call addtobuff("<td>" & "<i><center>" &oRst.[Short Outgoing Dialed Digits] & "</center></i>" & "</td>")
End if
if IsEmpty(oRst.[Insides Talk < 10]) then
call addtobuff ("<td><b>" & "n/a" & "</b></td>")
else
call addtobuff("<td>" & "<i><center>" &oRst.[Insides Talk < 10] & "</center></i>" & "</td>")
End if
if IsEmpty(oRst.[Cold Transfers]) then
call addtobuff ("<td><b>" & "n/a" & "</b></td>")
else
call addtobuff("<td>" & "<i><center>" &oRst.[Cold Transfers] & "</center></i>" & "</td>")
End if
if IsEmpty(oRst.[Total Calls]) then
call addtobuff ("<td>" & "n/a" & "</td>")
else
call addtobuff("<td>" & "<i><center>" &oRst.[Total Calls] & "</center></i>" & "</td>")
End if
else
if IsEmpty(oRst.[DATE]) then
call addtobuff ("<td>" & sResponsableName & "</td>")
else
call addtobuff("<td>" & "<i><b><u><font size = 3 style = ""cursor:hand;"" onClick='GetCallTrace(" & oRst.Emp_Id & "," & sDepartment & ",""" & FormatDateTime(oRst.[DATE],2) & """)'>" & oRst.[DATE] & "</a></b></u></i></td>")
End if
if IsEmpty(oRst.[Inc Talk Time < 15 sec]) then
call addtobuff ("<td>" & "n/a" & "</td>")
else
call addtobuff("<td>" & "<i><center>" &oRst.[Inc Talk Time < 15 sec] & "</center></i>" & "</td>")
End if
if IsEmpty(oRst.[Inc Hold > 2 x Inc Talk]) then
call addtobuff ("<td><b>" & "n/a" & "</b></td>")
else
call addtobuff("<td>" & "<i><center>" &oRst.[Inc Hold > 2 x Inc Talk] & "</center></i>" & "</td>")
End if
if IsEmpty(oRst.[Outgoing No Dialed Digits]) then
call addtobuff ("<td>" & "n/a" & "</td>")
else
call addtobuff("<td>" & "<i><center>" &oRst.[Outgoing No Dialed Digits] & "</center></i>" & "</td>")
End if
if IsEmpty(oRst.[Short Outgoing Dialed Digits]) then
call addtobuff ("<td>" & "n/a" & "</td>")
else
call addtobuff("<td>" & "<i><center>" &oRst.[Short Outgoing Dialed Digits] & "</center></i>" & "</td>")
End if
if IsEmpty(oRst.[Insides Talk < 10]) then
call addtobuff ("<td><b>" & "n/a" & "</b></td>")
else
call addtobuff("<td>" & "<i><center>" &oRst.[Insides Talk < 10] & "</center></i>" & "</td>")
End if
if IsEmpty(oRst.[Cold Transfers]) then
call addtobuff ("<td><b>" & "n/a" & "</b></td>")
else
call addtobuff("<td>" & "<i><center>" &oRst.[Cold Transfers] & "</center></i>" & "</td>")
End if
if IsEmpty(oRst.[Total Calls]) then
call addtobuff ("<td>" & "n/a" & "</td>")
else
call addtobuff("<td>" & "<i><center>" &oRst.[Total Calls] & "</center></i>" & "</td>")
End if
end if
call addtobuff("</tr>")
Next
call addtobuff("</table>")
Set oRst = Nothing
Set fRst = Nothing
end sub
'--------------------
' Search for the aspect log for a agent - Load the aspect detail popup
'--------------------
Function GetAspectForADayForDetailPopup(sEmp_Id, sDepartement, sResponsableName)
dim sID, oRst, strSQL, o2Rst, lColNum
dim sLevel
'----------------------------------------
' First We flush the output buff
'----------------------------------------
strOutputbuff = ""
strSQL = "Prg_All_Aspect_Call_Details " & sEmp_Id & ", " & sDepartement & ", '" & sResponsableName & "' "
alert(strSQL)
change(strSQL)
dim fRst
Set fRst = returnValue
call addtobuff("<table border='1' BORDER CELLSPACING='0' id=tbl>")
call addtobuff("<COL >")
' Titles of columns
'' Recuperation of Column header
call addtobuff("<THEAD>")
call addtobuff("<tr>")
accessFArray fRst, 0
Set oRst = accessFArrayReturn
dim temp
For lColNum = 1 to fRst.FieldsCount
temp = "oRst.[field" & lColNum & "]"
call addtobuff("<th><b>" & eval(temp) & "</b></th>")
Next
call addtobuff("</tr>")
call addtobuff("</THEAD>")
call addtobuff("<TBODY>")
call addtobuff("<tr>")
dim tmp
For count=0 To fRst.RecordCount - 1
accessArray fRst, count
Set o2Rst = accessArrayReturn
For lColNum = 1 to fRst.FieldsCount
temp = "oRst.[field" & lColNum & "]"
tmp = "o2Rst.[" & eval(temp) & "]"
If IsEmpty( eval(tmp) ) then
call addtobuff ("<td><b>" & "n/a" & "</b></td>")
else
call addtobuff("<td >" & "<i><center>" & Replace( eval(tmp) ," ", vbNullString) & "</center></i>" & "</td>")
End if
Next
Next
call addtobuff("</tr>")
call addtobuff("</TBODY>")
call addtobuff("</table>")
Set oRst = Nothing
Set o2Rst = Nothing
GetAspectForADayForDetailPopup = strOutputbuff
End Function
in order for "change()" to be called this file needs to be linked:
Code:
// declare a global XMLHTTP Request object
var XmlHttpObj;
// create an instance of XMLHTTPRequest Object, varies with browser type, try for IE first then Mozilla
function CreateXmlHttpObj()
{
// try creating for IE (note: we don't know the user's browser type here, just attempting IE first.)
try
{
XmlHttpObj = new ActiveXObject("Msxml2.XMLHTTP");
}
catch(e)
{
try
{
XmlHttpObj = new ActiveXObject("Microsoft.XMLHTTP");
}
catch(oc)
{
XmlHttpObj = null;
}
}
// if unable to create using IE specific code then try creating for Mozilla (FireFox)
if(!XmlHttpObj && typeof XMLHttpRequest != "undefined")
{
XmlHttpObj = new XMLHttpRequest();
}
}
var requestUrl;
function setUrl(aURL)
{ requestUrl = aURL; }
function getUrl()
{ return window.requestUrl; }
// called from onChange or onClick event of the continent dropdown list
function change(origin)
{
//alert(origin);
setUrl(location.href.substring(0,location.href.lastIndexOf("/")+1) + "data_provider.asp" + "?filter=" + origin);
alert(getUrl());
CreateXmlHttpObj();
// verify XmlHttpObj variable was successfully initialized
if(XmlHttpObj)
{
XmlHttpObj.onreadystatechange = StateChangeHandler;
XmlHttpObj.open("GET", requestUrl, false);
XmlHttpObj.setRequestHeader("Content-Type","application/x-www-form-urlencoded");
XmlHttpObj.send(null);
}
}
// this function called when state of XmlHttpObj changes
// we're interested in the state that indicates data has been
// received from the server
var returnValue = {};
var accessArrayReturn = {};
var accessFArrayReturn = {};
function StateChangeHandler()
{
// state ==4 indicates receiving response data from server is completed
if(XmlHttpObj.readyState == 4)
{
// To make sure valid response is received from the server, 200 means response received is OK
if(XmlHttpObj.status == 200)
{
returnValue = eval(XmlHttpObj.responseText);
}
else
{ alert("problem retrieving data from the server, status code: " + XmlHttpObj.status); }
}
}
function accessFArray(arr, ind)
{
accessFArrayReturn = arr.Fields[ind];
}
function accessArray(arr, ind)
{
accessArrayReturn = arr.Records[ind];
}
and finally here is where we handle JSON (in order to work with the code I provided you should call this "data_provider.asp"):
Code:
<!--#include virtual="\common\classes\asp\connectionmanager.asp"-->
<%
dim retrieveConn
dim sp
dim menu
function RStoJSON(rs)
dim sFld
dim sFlds
dim sField
dim SFields
dim sRec
dim sRecs
dim sRecordSet
dim lRecCnt
sRecordSet = ""
sRecs = ""
lRecCnt = 0
if rs.EOF or rs.BOF then
RStoJSON = "null"
else
do while not rs.EOF and not rs.BOF
lRecCnt = lRecCnt + 1
sFlds = ""
for each fld in rs.Fields
if lRecCnt = 1 then
RecCnt = RecCnt + 1
sField = """field" & RecCnt & """:""" & fld.Name & """"
sFields = sFields & iif(sFields <> "", ",", "") & sField
end if
sFld = """" & fld.Name & """:""" & toUnicode(fld.Value&"") & """"
sFlds = sFlds & iif(sFlds <> "", ",", "") & sFld
next 'fld
sRec = "{" & sFlds & "}"
sRecs = sRecs & iif(sRecs <> "", "," & vbCrLf, "") & sRec
rs.MoveNext
loop
sRecordSet = "( {""Fields"":[" & vbCrLf & " {" & sFields & "} " & vbCrLf & "], ""FieldsCount"":""" & RecCnt & """, ""Records"":[" & vbCrLf & sRecs & vbCrLf & "], ""RecordCount"":""" & lRecCnt & """} )"
' sRecordSet = sRecordSet } )"
RStoJSON = sRecordSet
end if
end function
function toUnicode(str)
dim x
dim uStr
dim uChr
dim uChrCode
uStr = ""
for x = 1 to len(str)
uChr = mid(str,x,1)
uChrCode = asc(uChr)
if uChrCode = 8 then ' backspace
uChr = "\b"
elseif uChrCode = 9 then ' tab
uChr = "\t"
elseif uChrCode = 10 then ' line feed
uChr = "\n"
elseif uChrCode = 12 then ' formfeed
uChr = "\f"
elseif uChrCode = 13 then ' carriage return
uChr = "\r"
elseif uChrCode = 34 then ' quote
uChr = "\"""
elseif uChrCode = 39 then ' apostrophe
uChr = "\'"
elseif uChrCode = 92 then ' backslash
uChr = "\\"
elseif uChrCode < 32 or uChrCode > 127 then ' non-ascii characters
uChr = "\u" & right("0000" & CStr(uChrCode),4)
end if
uStr = uStr & uChr
next
toUnicode = uStr
end function
function iif(cond,tv,fv)
if cond then
iif = tv
else
iif = fv
end if
end function
set retrieveConn = new connectionManager
sp = "" & request("filter") & ""
retrieveConn.storedprocedure = sp
retrieveConn.connect
if not retrieveConn.hasErrorOccured then
'dim rs
set rs = retrieveConn.recordset
response.write RStoJSON(rs)
response.flush
set rs = nothing
else
response.write("<div class='error'>")
response.write(retrieveConn.messageString)
response.write("</div>")
end if
set retrieveConn = nothing
%>
Before you post, read our: 
