The Forum has been Updated
The code has been upgraded to the latest .NET core version. Please check instructions in the Community Announcements about migrating your account.
From "source.asp" comes the following ... for some reason, the Select All no longer functions; I'm sure I have overlooked something that SHOULD be obvious.
This one is from a HTML5 canvas application. Everything works EXCEPT for saving a file (which makes it about as useless as the old TI-994A computer). The original instructions on the web did nothing when you clicked the save button because the author merged two functions. Now I just get a "server error" message with no details.
Code:
<%
'#################################################################################
'## Snitz Forums 2000 v3.4.07
'#################################################################################
'## Copyright (C) 2000-17 Michael Anderson, Pierre Gorissen,
'## Huw Reddick and Richard Kinser
'##
'## This program is free software; you can redistribute and/or modify it under the
'## terms of the GNU General Public License as published by the Free Software
'## Foundation; version 2 or later of the License.
'##
'## All copyright notices regarding Snitz Forums 2000 must remain intact in the
'## scripts and in the HTML output. The "powered by" text/logo with a link back
'## to http://forum.snitz.com in the footer of the pages MUST remain visible when
'## the pages are viewed on the internet or intranet.
'##
'## This program is distributed in the hope that it will be useful, but WITHOUT ANY
'## WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
'## PARTICULAR PURPOSE. See the GNU General Public License for more details.
'##
'## You should have received a copy of the GNU General Public License with this
'## program; if not, write to:
'##
'## Free Software Foundation, Inc.
'## 59 Temple Place - Suite 330
'## Boston, MA 02111-1307, USA
'##
'## Support can be obtained from our support forums at: http://forum.snitz.com
'##
'## Correspondence and marketing questions can be sent to: manderson@snitz.com
'##
'#################################################################################
%>
<!--#INCLUDE FILE="config.asp"-->
<%
Response.Buffer = True
Err.Clear
%>
<!--#INCLUDE FILE="includes/inc_sha256.asp" -->
<!--#INCLUDE FILE="includes/inc_header.asp" -->
<!--#INCLUDE FILE="includes/inc_func_secure.asp" -->
<%
Call ModCheck(intMod136)
If mLev < intSourceLev Then Response.Redirect "default.asp"
On Error Resume Next
Response.Write "<center><table border=""0"" width=""100%"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td width=""33%"" align=""left"" nowrap><font face=""" & strDefaultFontface & """ size=""" & strDefaultFontSize & """>" & vbNewLine & _
" " & getCurrentIcon(strIconFolderOpen,"","align=""absmiddle""") & " <a href=""default.asp"">All Forums</a><br />" & vbNewLine & _
" " & getCurrentIcon(strIconBar,"","align=""absmiddle""") & getCurrentIcon(strIconFolderOpenTopic,"","align=""absmiddle""") & " Source Code Lister<br /></font></td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine & _
"<br />" & vbNewLine & _
"<table border=""0"" cellspacing=""0"" cellpadding=""5"" bgcolor=""transparent"" width=""1000"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td class=""sidebar"">" & vbNewLine & _
" </td><td width="""" valign=""top"" align=""left"" rowspan=""2"" nowrap>" & _
" <table class=""tbl"" bgcolor=""" & strPopupTableColor & """ border=""1"" width=""100%"" cellspacing=""0"" cellpadding=""4"" align=""center"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td>" & vbNewLine & _
" <table border=""0"" width=""100%"" cellspacing=""1"" cellpadding=""2"">" & vbNewLine & _
" <tr>" & vbNewLine & _
" <td colspan=""2"">" & vbNewLine
strDirPath = Server.MapPath("./")
strPageRequested = LCase(Request.QueryString("page"))
strShowLines = LCase(Request.QueryString("lines"))
If strShowLines <> "no" Then strShowLines = "yes"
strSql = "SELECT COUNT(*) AS CNT FROM " & strTablePrefix & "SOURCE"
Set rsSource = my_Conn.Execute(strSql)
If Not rsSource.EOF Then
intSCount = rsSource("CNT")
rsSource.Close
End If
Set rsSource = Nothing
strSql = "SELECT * FROM " & strTablePrefix & "SOURCE ORDER BY FILE_MATCHING ASC, FILE_NAME ASC"
Set rsSource = my_Conn.Execute(strSql)
If Not rsSource.EOF Then
rsSource.MoveFirst
intI = 0
Do While Not rsSource.EOF
intI = intI + 1
DoNotShare(intI,0) = rsSource("File_Name")
DoNotShare(intI,1) = rsSource("File_Matching")
If rsSource("File_Allowed") = 0 And rsSource("FILE_ENABLE") = 1 Then
DoNotShare(intI,2) = rsSource("FILE_ENABLE")
Else
DoNotShare(intI,2) = rsSource("File_Allowed")
End If
rsSource.MoveNext
Loop
rsSource.Close
End If
Set rsSource = Nothing
If Len(strPageRequested) > 0 Then
If barFile(strPageRequested) = True Then
noshare(1)
Else
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(Server.MapPath(strPageRequested)) = True Then
doshare()
Else
noshare(2)
End If
End If
Else
noshare(3)
End If
Response.Write " </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
" </table>" & vbNewLine & _
" </td>" & vbNewLine & _
" </tr>" & vbNewLine & _
"</table>" & vbNewLine
WriteFooter
Response.End
Function barFile(ckFile)
barFile = False
If intSCount > 0 Then
For n = 1 To intSCount
If DoNotShare(n,1) = "Match" Then
If ckFile = DoNotShare(n,0) And (DoNotShare(n,2) = 0) Then
barFile = True
Exit Function
End If
Else
if InStr(LCase(ckFile), LCase(DoNotShare(n,0))) > 0 And (DoNotShare(n,2) = 0) Then
barFile = True
Exit Function
End If
End If
Next
End If
End Function
Sub noshare(n)
Select Case n
Case 1
Response.Write "<span class=""dft"">Sorry, but the file ""<b><i>" & strPageRequested & "</i></b>"" is not available for viewing.<br /></span>" & vbNewline
Case 2
Response.Write "<span class=""dft"">Sorry, but the file ""<b><i>" & strPageRequested & "</i></b>"" does not exist.</span><br />" & vbNewline
Case Else
Response.Write "<span class=""dft"">What?</span><br />" & vbNewline
End Select
SelectPageMenu()
End Sub
Sub doshare()
Dim read_all, read_lines, i, j, k, fso, act, numLines
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(Server.MapPath(strPageRequested)) Then
Set act = FSO.OpenTextFile(Server.MapPath(strPageRequested), 1)
read_asp = act.readall
numLines = act.Line
act.Close
Response.write "<span>" & vbNewLine & _
" <span>Viewing <b><i>" & strPageRequested & "</i></b></span>" & vbNewline & _
" <span><font size=""1"">(~" & numLines & " lines)</font></span><br />" & vbNewline
Call SelectPageMenu()
Response.Write " <div id=""center"">" & vbNewline & _
" <div id=""scrollcode"">" & vbNewline
If strShowLines = "yes" Then
Response.Write " <div style=""position:absolute; left: 0; top: 0; width: 50px; background: #F0F0F0;"">" & vbNewLine & _
" <pre style=""font-size:12px;"">" & vbNewline
For i = 1 To numLines
Response.Write Server.HTMLEncode(Right(" " & FormatNumber(i,0,,,0),5)) & vbNewLine
Next
Response.Write " </pre>" & vbNewLine & _
" </div>" & vbNewline
End If
Response.Write " <div id=""srcarea"" style=""position:absolute; left: 50px; top: 0; background: #FFFFE1; "">" & vbNewline & _
" <pre style=""font-size:12px; font-family:lucida console;"">" & Server.HTMLEncode(read_asp) & "</pre>" & vbNewline & _
" </div>" & vbNewline & _
" </div>" & vbNewline & _
" </div>" & vbNewline & _
" <form name=""selectall"">" & vbNewLine & _
" <textarea id=""holdtext"" wrap=""off"" style=""display:none;"">" & Server.HTMLEncode(read_asp) & "</textarea>" & vbNewLine & _
" <input class=""btn"" type=""button"" value=""Select / Copy Code"" onclick=""javascript:window.selectNode(document.getElementById('srcarea'));Copied = document.getElementById('holdtext').createTextRange();Copied.execCommand('Copy');"" />" & vbNewLine
strUAgent = Request.ServerVariables("HTTP_USER_AGENT") : strOKB = ""
For i = 1 To Len(strUAgent)
If UCase(Mid(strUAgent, i, 4)) = "MSIE" Or UCase(Mid(strUAgent, i, 5)) = "TOUCH" Then
strOKB = "IE"
Exit For
End If
Next
If strOKB <> "IE" Then
Response.Write "<br /><br /><span>(<B>NOTE</B>: IE will copy to clipboard but other browsers may only select the contents.<br /> To ensure copy, use CTRL-C after clicking.)</span>"
End If
Response.Write "</form>" & vbNewLine & _
"</span>" & vbNewLine
Else
noshare(2)
End If
End Sub
Sub SelectPageMenu()
Response.Write "<span class=""dft""><font size=""1"">Select "
If strPageRequested="" Then Response.Write "a "
If strPageRequested<>"" Then Response.Write "another "
Response.Write "page to view." & vbNewline & _
"<FORM name=""zFileForm"">" & vbNewline & _
"Line Numbers: " & vbNewline & _
"<input type=""radio"" name=""zShowLines"" value=""yes"""
If strShowLines <> "no" Then Response.Write " checked"
Response.Write " onClick=""change()"" />Yes " & vbNewline & _
"<input type=""radio"" name=""zShowLines"" value=""no"""
If strShowLines = "no" Then Response.Write " checked"
Response.Write " onClick=""change()"" />No</font> " & vbNewline
Response.Write "<SELECT name=""zFileName"">" & vbNewline
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strDirPath)
Set colFiles = objFolder.Files
numFilesFound = objFolder.Files.Count
numMaxFiles = 0
numThisFile = 0
If numFilesFound > 0 Then
For Each objItem In colFiles
Set objFile = objFSO.GetFile(objItem)
filename = Trim(LCase(Right(objItem.Name,Len(objItem.Name) - InStrRev(objItem.Name, "\"))))
If barFile(objFile.Name) = False Then
numMaxFiles = numMaxFiles + 1
ReDim Preserve srcFileArray(numMaxFiles)
srcFileArray(numMaxFiles - 1) = objFile.Name
End If
Next
End If
strSql = "SELECT SUBFOLDER FROM " & strTablePrefix & "SOURCE_FOLDERS"
Set rsSource = my_Conn.Execute(strSql)
If Not rsSource.EOF Then
rsSource.MoveFirst
Do While Not rsSource.EOF
Set colFiles = Nothing
Set objFolder = Nothing
strSubF = strDirPath & "\" & rsSource("SUBFOLDER")
Set objFolder = objFSO.GetFolder(strDirPath & "\" & rsSource("SUBFOLDER"))
Set colFiles = objFolder.Files
numFilesFound = objFolder.Files.Count
If numFilesFound > 0 Then
For Each filename In colFiles
Response.Flush
filename = Trim(LCase(Right(filename,Len(filename) - InStrRev(filename, "\"))))
If barFile(filename) = False Then
numMaxFiles = numMaxFiles + 1
ReDim Preserve srcFileArray(numMaxFiles)
srcFileArray(numMaxFiles - 1) = rsSource("SUBFOLDER") & "/" & filename
End If
Next
End If
rsSource.MoveNext
Loop
rsSource.Close
End If
Set rsSource = Nothing
Set colFiles = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
If numMaxFiles > 0 Then
Call QuickSort(srcFileArray,0,numMaxFiles)
For Each item In srcFileArray
If Len(item) > 0 Then
Response.Write "<option value=""" & item & """"
If strPageRequested = item Then Response.Write " SELECTED"
Response.Write ">" & item & "</option>" & vbNewline
End If
Next
End If
Response.Write "</SELECT>" & vbNewline & _
"<INPUT class=""btn"" TYPE=""button"" VALUE=""View source"" onClick=""change()"" />" & vbNewline & _
" <font size=""1"">(" & numMaxFiles & " Files Found)</font>" & vbNewline & _
"</FORM></font></span>" & vbNewline & _
"<script language=""Javascript"">" & vbNewline & _
"<!--" & vbNewline & _
"function change() {" & vbNewline & _
" if (document.zFileForm.zShowLines[0].checked) {" & vbNewline & _
" window.location = 'source.asp?page='+document.zFileForm.zFileName.options[document.zFileForm.zFileName.selectedIndex].value+'&lines=yes'" & vbNewline & _
" } else {" & vbNewline & _
" window.location = 'source.asp?page='+document.zFileForm.zFileName.options[document.zFileForm.zFileName.selectedIndex].value+'&lines=no'" & vbNewline & _
" }" & vbNewline & _
"}" & vbNewline & _
"//-->" & vbNewline & _
"</script>" & vbNewline
End Sub
Sub QuickSort(vec,loBound,hiBound)
Dim pivot,loSwap,hiSwap,temp
If hiBound - loBound = 1 Then
If vec(loBound) > vec(hiBound) Then
temp=vec(loBound)
vec(loBound) = vec(hiBound)
vec(hiBound) = temp
End If
End If
pivot = vec(Int((loBound + hiBound) / 2))
vec(Int((loBound + hiBound) / 2)) = vec(loBound)
vec(loBound) = pivot
loSwap = loBound + 1
hiSwap = hiBound
Do
While loSwap < hiSwap And vec(loSwap) <= pivot
loSwap = loSwap + 1
Wend
While vec(hiSwap) > pivot
hiSwap = hiSwap - 1
Wend
If loSwap < hiSwap Then
temp = vec(loSwap)
vec(loSwap) = vec(hiSwap)
vec(hiSwap) = temp
End If
Loop While loSwap < hiSwap
vec(loBound) = vec(hiSwap)
vec(hiSwap) = pivot
If loBound < (hiSwap - 1) Then Call QuickSort(vec,loBound,hiSwap-1)
If hiSwap + 1 < hibound Then Call QuickSort(vec,hiSwap+1,hiBound)
End Sub
Sub ShowSubFolders(objFolder)
Set colFolders = objFolder.SubFolders
For Each objSubFolder In colFolders
strTitle = ""
If Not ((objSubFolder.Attributes And 4) Or (objSubFolder.Attributes And 2)) Then
Set colFiles = objSubFolder.Files
If InStr(1, objSubFolder.Name, strQuery, vbTextCompare) <> 0 Then
strTitle = Mid(objSubFolder,4)
strTitle = Replace(strTitle,"\","/") & "/"
strLink = strPath & strTitle
%>
<tr bgcolor="#CCFFCC">
<td width="70%" align="left" ><a href="<%= strLink %>"><%= objSubFolder.Name %></a></td>
<td width="10%" align="right"> </td>
<td width="20%" align="right" > </td>
</tr>
<%
End If
strTitle = Mid(objSubFolder,4)
strTitle = Replace(strTitle,"\","/") & "/"
For Each objItem In colFiles
strDate = CStr(objItem.DateCreated)
If Len(strDate) < 22 Then
If Mid(strDate,2,1) = "/" Then strDate = "0" & strDate
If Mid(strDate,4,1) = "/" Then strDate = Left(strDate,2) & "0" & Mid(strDate,3)
If Mid(strDate,13,1) = ":" Then strDate = Left(strDate,11) & "0" & Mid(strDate,12)
End If
If InStr(1, objItem.Name, strQuery, vbTextCompare) <> 0 Then
strLink = strPath & strTitle & objItem.Name
%>
<tr bgcolor="#CCFFCC">
<td width="70%" align="left" ><a href="<% = strLink %>"><%= objItem.Name %></a></td>
<td width="10%" align="right"><%= objItem.Size %></td>
<td width="20%" align="right" ><%= strDate %></td>
</tr>
<%
End If
Next
ShowSubFolders(objSubFolder)
End If
Next
End Sub
%>
<script>
function selectNode (node) {
var selection, range, doc, win;
if ((doc = node.ownerDocument) && (win = doc.defaultView) && typeof
win.getSelection != 'undefined' && typeof doc.createRange != 'undefined'
&& (selection = window.getSelection()) && typeof
selection.removeAllRanges != 'undefined') {
range = doc.createRange();
range.selectNode(node);
selection.removeAllRanges();
selection.addRange(range);
}
else if (document.body && typeof document.body.createTextRange !=
'undefined' && (range = document.body.createTextRange())) {
range.moveToElementText(node);
range.select();
}
}
</script>
This one is from a HTML5 canvas application. Everything works EXCEPT for saving a file (which makes it about as useless as the old TI-994A computer). The original instructions on the web did nothing when you clicked the save button because the author merged two functions. Now I just get a "server error" message with no details.
Code:
$(document).ready(function(){
getBase64FromImageUrl('myCanvas');
function getBase64FromImageUrl(URL) {
var img = new Image();
img.src = URL;
img.onload = function () {
var canvas = document.createElement("myCanvas");
canvas.width = this.width;
canvas.height = this.height;
var ctx = canvas.getContext("2d");
ctx.drawImage(this, 0, 0);
var dataURL = canvas.toDataURL("image/png");
//alert( dataURL.replace(/^data:image\/(png|jpg);base64,/, ""));
saveImageData(dataURL.replace(/^data:image\/(png|jpg);base64,/, ""));
}
}
});
function saveImageData (image_data) {
$.post("saveImage.asp",
{imageData:image_data,submit:true})
.done(function(data, textStatus, jqXHR)
{
alert(data);
}).fail(function(jqXHR, textStatus, errorThrown)
{
alert(errorThrown);
});
};
var mousePressed = false;
var lastX, lastY;
var ctx;
var dataURL = rendered.Canvas.toDataURL("images/png");
dataURL = dataURL.replace('data:image/png;base64,', '');
var areturn = $.ajax({
url: "saveImage.asp",
type: "POST",
data: '{ "imageData" : "' + dataURL + '" }',
dataType: "json",
beforeSend: function(x) {
x.overrideMimeType("application/j-son;charset=UTF-8");
}
}).done(function(result) {
console.log("Success Done!\n" + result);
}).always(function(data) {
console.log("Always:\n" + data.responseText);
});
function InitThis() {
ctx = document.getElementById('myCanvas').getContext("2d");
//ctx.src = 'cat_b.jpg';
//ctx.drawImage(ctx, 0, 0);
var image = new Image();
image.src = 'template/Tooth18.jpg';
$(image).load(function () {
ctx.drawImage(image, 0, 0);
});
$('#myCanvas').mousedown(function (e) {
mousePressed = true;
Draw(e.pageX - $(this).offset().left, e.pageY - $(this).offset().top, false);
});
$('#myCanvas').mousemove(function (e) {
if (mousePressed) {
Draw(e.pageX - $(this).offset().left, e.pageY - $(this).offset().top, true);
}
});
$('#myCanvas').mouseup(function (e) {
mousePressed = false;
});
$('#myCanvas').mouseleave(function (e) {
mousePressed = false;
});
}
function Draw(x, y, isDown) {
if (isDown) {
ctx.beginPath();
ctx.strokeStyle = $('#selColor').val();
ctx.lineWidth = $('#selWidth').val();
ctx.lineJoin = "round";
ctx.moveTo(lastX, lastY);
ctx.lineTo(x, y);
ctx.closePath();
ctx.stroke();
}
lastX = x; lastY = y;
}
function clearArea() {
// Use the identity matrix while clearing the canvas
ctx.setTransform(1, 0, 0, 1, 0, 0);
ctx.clearRect(0, 0, ctx.canvas.width, ctx.canvas.height);
}