In Classic ASP reading cXML Files, is it required to point your dtd link to local files? - asp-classic

Unfortunately, we've inherited an old Classic ASP site and are writing new code for a round trip punch-out site. Reading in the cXML file, we're continually erroring out on the 2nd line !DOCTYPE cXML SYSTEM "http://xml.../cXML.dtd.
If we capture the location of the dtd file and change it to a local file, i.e., file:///c:/....dtd it works. Is there no way to get this to work using the http location? I'd rather not store all the dtd file versions locally.
Our Code is:
Dim olddtdvalue
Dim newdtdvalue
Dim xmlfilename
olddtdvalue = "http://xml.cxml.org/schemas/cXML/"
newdtdvalue = "file:///d:/Websites/FSIResponsive/cXML/"
xmlfilename ="PORS_" & formatdatetime(now,vblongdate) & " " & replace(formatdatetime(now,vblongtime),":","_") & ".xml"
set fs=Server.CreateObject("Scripting.FileSystemObject")
set f=fs.CreateTextFile("d:\WebSites\FSIResponsive\cXML\InFiles\" & xmlfilename,true)
f.write("remote host: " & request.ServerVariables("REMOTE_HOST") & vbcrlf & vbcrlf)
totalBytes = Request.TotalBytes
If totalBytes > 0 Then
xml = Request.BinaryRead( totalBytes )
for i = 1 to totalBytes
xmlstr = xmlstr + String(1,AscB(MidB(xml, i, 1)))
Next
f.write(xmlstr)
xml2 = xmlstr
xml2 = Replace(xml2,olddtdvalue,newdtdvalue)
End if
Set xdoc = Server.CreateObject("Microsoft.XMLDOM")
' Set xdoc = Server.CreateObject("MSXML2.DOMDocument.6.0")
xdoc.ValidateOnParse = True
xdoc.async = False
xdoc.resolveExternals = True
' response.write xml2
loadStatus = xdoc.loadXML(xml2)
As you can see, we've tried using MSXML2.DOMDocument.6.0, but that doesn't work either.
Thanks,
Alan
Update:
Here's the code I finally got working:
Dim xmlfilename
Dim URL
totalBytes = Request.TotalBytes
If totalBytes > 0 Then
xml = Request.BinaryRead( totalBytes )
for i = 1 to totalBytes
xmlstr = xmlstr + String(1,AscB(MidB(xml, i, 1)))
Next
xml2 = xmlstr
End if
Set xdoc = Server.CreateObject("MSXML2.DOMDocument.6.0")
xdoc.setProperty "ServerHTTPRequest", True
xdoc.setProperty "ProhibitDTD",False
xdoc.resolveExternals = True
xdoc.ValidateOnParse = True
xdoc.async = False
loadStatus = xdoc.LoadXML(xml2)
Alan

Related

Telerik AsyncUpload trying to rename file get IOException

i want to rename my file. But i got a IOException. It says "The Process Cannot Access the File Because It Is Being Used by Another Process".
This is my Code:
asp.net:
<telerik:RadAsyncUpload ID="rauKachelUpload" runat="server" ChunkSize="0" Localization-Cancel="Löschen" Localization-Remove="Entfernen" Localization-Select="Auswählen"
Culture="de-DE" Skin="MetroTouch" MaxFileInputsCount="1" OnFileUploaded="rauKachelUpload_FileUploaded">
</telerik:RadAsyncUpload>
vb.net:
Protected Sub rauKachelUpload_FileUploaded(sender As Object, e As FileUploadedEventArgs)
Try
Using fileStream As Stream = e.File.InputStream
Using img As System.Drawing.Image = System.Drawing.Image.FromStream(fileStream)
Dim h As Integer = img.Height
Dim w As Integer = img.Width
img.Dispose()
Dim fileName As String = e.File.GetName()
If w = MaxWidth And h = MaxHeight Then
rauKachelUpload.TargetFolder = "img/kachel_grafik"
Dim TimeStamp As String = DateDiff("s", "01/1/1970 12:00:00 AM", DateTime.Now)
fileName = "KI_" & TimeStamp & WelcheSparteUndGröße
KachelPfad = "~/img/kachel_grafik/" & fileName
Else
KachelFalsch = True
End If
If KachelFalsch = False Then
e.File.SaveAs(fileName)
Page.ClientScript.RegisterClientScriptBlock([GetType](), "CloseScript", "redirectParentPage('VermittlerBearbeiten.aspx?ID=" & VermittlerID & "&KBFN=" & KachelPfad & "&NA=true" & "&fwg=" & WelcheSparteUndGröße & "&Ang1=" & hfAng1CHK.Value & "&Ang2=" & hfAng2CHK.Value & "&Ang3=" & hfAng3CHK.Value & "&Ang4=" & hfAng4CHK.Value & "&AngSrc1=" & hfKachelIMGSrcBaufi.Value & "&AngSrc2=" & hfKachelIMGSrcImmo.Value & "&AngSrc3=" & hfKachelIMGSrcPhoto.Value & "&AngSrc4=" & hfKachelIMGSrcAsse.Value & "');", True)
Else
rnfIconNichtErzeugt.Visible = True
End If
End Using
End Using
Catch ex As Exception
rnfIconNichtErzeugt.Visible = True
End Try
End Sub
Without trying to rename my file, it works fine.
Does anyone has an Idea what i did wrong?
Thanks for reading.
Daniel
You need to make sure that the fileStream is properly closed before attempting to rename the file since the particular file will be held by the fileStream object. You can try fileStream.Close() after the img.Dispose() statement.

Retrieving records from database and writing them to a file in a specific format

I am not really familiar with asp-classic functions, though i am now working with a .asp file that displays records from a SQL database upon a java-script onChange event in a drop-down menu. What I'm trying to achieve is to display these records in the format below, and for all of them to be written to a text file without being called through java-script even from the drop-down menu.
Here's what I'm working with so far:
<!--#include virtual="/includes/functions.asp" -->
<%
intBusiness_Catagory = Request("select_catagory")
Set thisConn = Server.CreateObject("ADODB.Connection")
thisConn.Open CreateAfccDSN()
SelectSQL = "SELECT * FROM BusinessInfo WHERE ((CatID = " & intBusiness_Catagory & ") or (CatID2 = " & intBusiness_Catagory & ") or (CatID3 = " & intBusiness_Catagory & ")) and (intStatusCodeID = 1) and (intOnWeb = 1) Order By vcBusinessName"
Set SelectRs = thisConn.Execute(SelectSQL)
If SelectRs.EOF Then
Response.Write("No members found for selected category.<br> Please search <a href='javascript:history.back()'>again</a>.")
Else
%>
<b>Member Search Results:</b>
<p>
<%
End If
If Not SelectRs.BOF AND Not SelectRs.EOF then
SelectRs.MoveFirst
Do Until SelectRs.EOF
%>
<b><%=SelectRs("vcBusinessName") %></b><br>
<%=SelectRs("vcPhone") %><br>
<%=SelectRs("vcPAddress") %><br>
<%=SelectRs("vcPCity") %>, <%=SelectRs("vcPState") %> <%=SelectRs("vcPZipCode") %><br>
<%
If isNull(SelectRs("vcURL")) then
Else
%>
<b>Website: </b><%=SelectRs("vcURL") %>
<%
End If
%>
<p>
<hr>
<%
SelectRs.MoveNext
Loop
%>
<%
End If
SelectRs.Close
Set SelectRs = Nothing
%>
<p style="text-align: right"><small>Back to directory index</small></p>
Anyone can assist with a solution to this? Thanks.
You'd simply dump the results of your SQL into an adodb recordset as you already have, then loop through the recordset and write the csv file using the fso com object.
Example Code (untested)
dim fs, HeadersRow, TempRow, objFolder, DateStr
'#### Buld a NTFS safe filename based on Date
DateStr = now()
DateStr = Replace(DateStr, "/", "_")
DateStr = Replace(DateStr, ":", "_")
'#### Initalise FileSystemObject
Set fs = Server.CreateObject("Scripting.FileSystemObject")
'#### Delete any old Report_ files (optional
Set objFolder = fs.GetFolder(Server.MapPath("Reports"))
For Each objFile in objFolder.Files
FileName = objFile.Name
if left(FileName,7) = "Report_" then
if fs.FileExists(Server.MapPath("Reports") & "/" & FileName) then
on error resume next
fs.DeleteFile(Server.MapPath("Reports") & "/" & FileName)
on error goto 0
end if
end if
Next
Set objFolder = Nothing
'#### Create a Uniquqe ID for this report
NewFileName = "Report_" & DateStr & ".csv"
'#### next, get the Query and Populate RS
SQL = "SELECT * FROM whatever"
SET RS = db.Execute(SQL)
'#### WE now have a RS, first we need the column headers:
For fnum = 0 To RS.Fields.Count-1
HeadersRow = HeadersRow & "," & RS.Fields(fnum).Name & ""
Next
'#### The loop will have made a string like: ,"col1", "col2", "col3", "col4"
'#### Remove the leading comma ,
dim LengthInt
LengthInt = len(HeadersRow)
HeadersRow = right(HeadersRow, LengthInt - 1)
'#### Dump the headers to the CSV Report
OutputToCsv HeadersRow, NewFileName
TempRow = ""
'#### now loop through all the data and dump in CSV report too
Do Until RS.EOF
TempRow = ""
For fnum = 0 To RS.Fields.Count-1
TempRow = TempRow & "," & RS.Fields(fnum).Value & ""
Next
'#### Again, remove the leading comma, then send to CSV
LengthInt = len(TempRow)
TempRow = right(TempRow, LengthInt - 1)
OutputToCsv TempRow, NewFileName
RS.MoveNext
Loop
'#### Functions
function OutputToCsv (strToWrite, FileName)
'#### Simple function to write a line to a given file
'#### Not the most efficent way of doing it but very re-usable
dim fs
Set fs=Server.CreateObject("Scripting.FileSystemObject")
If (fs.FileExists(server.MapPath("\") & "\Reports\" & FileName))=true Then
set fname = fs.OpenTextFile(server.MapPath("\") & "\Reports\" & FileName, 8, True)
Else
set fname = fs.CreateTextFile(server.MapPath("\") & "\Reports\" & FileName,true)
End If
fname.WriteLine(strToWrite)
fname.Close
set fname=nothing
set fs=nothing
end function

Sql injection script

This title of the question may seem to be previously asked and answered but its different scenario for me. I use this script to stop sql injection in my ASP site. As per my knowledge or injecting script i have tried everything . Is it still possible to break through this code or do you feel this is fine .
Here is the script
<%
Function IsInject(strCheck, boolForm)
IsInject = False
If Not boolForm And Len(strCheck) > 50 Then IsInject = True
' Dim sCmdList, arrCmds, i
If boolForm Then
sCmdList = "declare,varchar,convert,delete,create,is_srvrolemember,ar(,cast("
Else
sCmdList = "update,union,select,drop,declare,varchar,convert,delete,create,is_srvrolemember,ar(,cast(,char("
End If
arrCmds = Split(sCmdList, ",")
For i = 0 To UBound(arrCmds)
If Instr(UCase(CStr(strCheck)), UCase(arrCmds(i))) > 0 Then
IsInject = True
Exit For
End If
Next
Erase arrCmds
End Function
Function CleanInject(strClean, boolInt)
If boolInt Then CleanInject = CInt(strClean) Else CleanInject = Replace(strClean, "'", "''")
End Function
'-----------------------------------------------------------
'redirect user if specific IP
'Dim ipaddress, bFBIRedirect, sInjectType
bFBIRedirect = True
ipaddress = Request.ServerVariables("REMOTE_ADDR")
Select Case ipaddress
Case "90.120.206.10"
Case Else
bFBIRedirect = False
End Select
If bFBIRedirect Then Response.Redirect "http://www.fbi.gov"
'-----------------------------------------------------------
'Dim bIsInject, sHackString
bIsInject = False
If Not bInject Then
' Dim qsItm
For Each qsItm In Request.QueryString
If IsInject(Request.QueryString(qsItm), False) Then
bIsInject = True
sHackString = qsItm & "=" & Request.QueryString(qsItm)
sHackType = "QueryString"
sInjectType = "qs-" & Request.QueryString(qsItm)
Exit For
End If
Next
End If
If Not bInject Then
' Dim frmItm
' For Each frmItm In Request.Form
' If IsInject(Request.Form(frmItm), True) Then
' bIsInject = True
' sHackString = Request.Form(frmItm)
' sHackString = frmItm & "=" & Request.Form(frmItm)
' sHackType = "Form"
' Exit For
' End If
' Next
End If
If bIsInject Then
Session("hacktype") = sHackType
Session("hackstr") = sHackString
Session("thepagefrom") = Request.ServerVariables("PATH_INFO")
Session("theip") = Request.ServerVariables("REMOTE_ADDR")
' Dim arrWhereAt, iWhereAt, sRedirect
arrWhereAt = Split(Request.ServerVariables("PATH_INFO"), "/")
iWhereAt = UBound(arrWhereAt)
sRedirect = "unknownerror.asp?ip=" & Request.ServerVariables("REMOTE_ADDR") & "&err=" & sInjectType & "&pg=" & Request.ServerVariables("PATH_INFO")
If iWhereAt = 1 Then sRedirect = "../" & sRedirect
If iWhereAt = 2 Then sRedirect = "../../" & sRedirect
If iWhereAt = 3 Then sRedirect = "../../../" & sRedirect
Response.Redirect sRedirect
End If
%>
Using blacklists to remove commands is not really a good idea. You have to make sure you cover all possible commands, and still someone might sneak something past. This would also probably fail if you get data from a user that is not an attack, but still contains an attack string. Example "Back in the days of the Soviet Union".
As Nikolai suggests, see if you can find some type of prepared statements to use. Or find a really good library to properly escape data for you.
rather doing that I think I would use ADO Parameter object when creating SQL queries, the second best thing is to do type conversion of the inputfields for the dynamic SQL queries, such as converting strings to SQL strings (replace any ' with two ''), making sure number is a number etc.

Save audio and video file in SQL Server database

How can I save and retrieve audio and video files in and from a SQL Server database?
The naive approach is to use a BLOB column and read the entire content into a byte[], then write the byte[] back to the client. The problem is that it consumes huge amounts of memory in your ASP.Net process.
A much better approach is to use streaming semantics, see these two articles:
Download and Upload images from SQL Server via ASP.Net MVC
FILESTREAM MVC: Download and Upload images from SQL Server
The articles refer to images, but you can use the code as-is to store any other form of media, including audio and video. Although the code is for ASP.Net MVC, the concepts use to stream large files into and from SQL Server can be used just as well from ASP.Net forms.
I'm not making a case that you should or should not use SQL Server as the storage for media. That is an entirely different discussion.
Refer to How to Store audio in Sql and retrieve for play, you come to know how to store the audio files in the database. Follow the same way for videos also.
Public Sub InsertAudioDataInTable(TableName, TableMapingName, TextName,_
LoopStart, LoopEnd, Panel, PathOnDisk)
Dim SndSourceStream As Stream = New FileStream(PathOnDisk, FileMode.Open,
FileAccess.Read)
Dim BinarySndReader As New BinaryReader(SndSourceStream)
Dim bytes As Byte() = BinarySndReader.ReadBytes(SndSourceStream.Length)
strImage = "#Aud" ' Aud mean a feild Audio in database
'''''''''''''''''''''''''''''''''''''''''''''''' For SQL String
Dim b = 0
Dim dataContaner(LoopEnd + 2 - LoopStart) As String
For a = LoopStart To LoopEnd
dataContaner(b) = Panel.Controls(TextName & a).Text
b = b + 1
Next
''''''''''''''
Dim myCmd As New SqlCommand
myCmd.Connection = Con
''''''''''
Dim T As String
' T.Text = null
Dim aaa = "INSERT INTO " & TableName
Dim bbb = ""
For i = LoopStart To LoopEnd
bbb = bbb + "F" & i & ","
Next
T = aaa & " (" + bbb & "Aud"
' T = T.Remove(T.Length - 1)
T = T & ")VALUES ("
Dim ccc = ""
b = 0
For a = LoopStart To LoopEnd
ccc = ccc & "'" & dataContaner(b) & "',"
b = b + 1
Next
T = T + ccc
myCmd.CommandText = T + strImage & ")"
myCmd.Parameters.Add(strImage, SqlDbType.Binary).Value = bytes
myCmd.ExecuteNonQuery()
''''''''
End Sub
Private Sub btSclass_Click(sender As Object, e As EventArgs) Handles btSclass.Click
If btSclass.Text = "Start Class" Then
If A7.Text <> "" Then
GlobalVariableDefault.startTime = DateTime.Now
A2.Text = GlobalVariableDefault.startTime.ToString("hh\:mm\:ss")
GlobalVariableDefault.StID = A7.Text
Me.Hide()
FTodayLesson.Show()
A2.Text = L.Text
btSclass.Text = "End Class"
btSclass.BackColor = Color.Red
If recording = False Then
mciSendString("open new Type waveaudio Alias recsound", "", 0, 0)
mciSendString("record recsound", "", 0, 0)
recording = True
End If
Else
MyMessage("Select a student name from list")
End If
ElseIf btSclass.Text = "End Class" Then
mciSendString("save recsound " & Filez, "", 0, 0)
mciSendString("close recsound ", "", 0, 0)
recording = False
FunConnection(DatabaseName_Audio)
InsertAudioDataInTable("RecAudio", "InsertAdio", "A", 1, 8, PShortInfo, "D:\aa\Test.wav")
btSclass.BackColor = Color.WhiteSmoke
btSclass.Text = "Start Class"
MyMessage("Data Save")
FunConnection(DatabaseName_QurqnServer)
End If
End Sub
'''''data base used in above code

What is a fast and efficient way to import images by URL?

Would I just use MSXML and import as binary? Or is there another more efficient way?
There are gigs and gigs of JPEGs to fetch.
I have written something in the past, the code below will save remote image on the server disk. It's classic ASP and pretty efficient:
<%
Const CONTENT_FOLDER_NAME = "StoredContents"
Dim strImageUrl
strImageUrl = "http://www.gravatar.com/avatar/8c488f9c3d3da5bb756507179a3d53fd?s=32&d=identicon&r=PG"
Call SaveOnServer(strImageUrl, "bill_avatar.jpg")
Sub SaveOnServer(url, strFileName)
Dim strRawData, objFSO, objFile
Dim strFilePath, strFolderPath, strError
strRawData = GetBinarySource(url, strError)
If Len(strError)>0 Then
Response.Write("<span style=""color: red;"">Failed to get binary source. Error:<br />" & strError & "</span>")
Else
strFolderPath = Server.MapPath(CONTENT_FOLDER_NAME)
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If Not(objFSO.FolderExists(strFolderPath)) Then
objFSO.CreateFolder(strFolderPath)
End If
If Len(strFileName)=0 Then
strFileName = GetCleanName(url)
End If
strFilePath = Server.MapPath(CONTENT_FOLDER_NAME & "/" & strFileName)
Set objFile = objFSO.CreateTextFile(strFilePath)
objFile.Write(RSBinaryToString(strRawData))
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
Response.Write("<h3>Stored contents of " & url & ", total of <span style=""color: blue;"">" & LenB(strRawData) & "</span> bytes</h3>")
Response.Write("<a href=""" & CONTENT_FOLDER_NAME & "/" & strFileName & """ target=""_blank""><span style=""color: blue;"">" &_
strFileName & "</span></a>")
End If
End Sub
Function RSBinaryToString(xBinary)
''# Antonin Foller, http://www.motobit.com
''# RSBinaryToString converts binary data (VT_UI1 | VT_ARRAY Or MultiByte string)
''# to a string (BSTR) using ADO recordset
Dim Binary
'' #MultiByte data must be converted To VT_UI1 | VT_ARRAY first.
If vartype(xBinary)=8 Then Binary = MultiByteToBinary(xBinary) Else Binary = xBinary
Dim RS, LBinary
Const adLongVarChar = 201
Set RS = CreateObject("ADODB.Recordset")
LBinary = LenB(Binary)
If LBinary>0 Then
RS.Fields.Append "mBinary", adLongVarChar, LBinary
RS.Open
RS.AddNew
RS("mBinary").AppendChunk Binary
RS.Update
RSBinaryToString = RS("mBinary")
Else
RSBinaryToString = ""
End If
End Function
Function MultiByteToBinary(MultiByte)
''# © 2000 Antonin Foller, http://www.motobit.com
''# MultiByteToBinary converts multibyte string To real binary data (VT_UI1 | VT_ARRAY)
''# Using recordset
Dim RS, LMultiByte, Binary
Const adLongVarBinary = 205
Set RS = CreateObject("ADODB.Recordset")
LMultiByte = LenB(MultiByte)
If LMultiByte>0 Then
RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
RS.Open
RS.AddNew
RS("mBinary").AppendChunk MultiByte & ChrB(0)
RS.Update
Binary = RS("mBinary").GetChunk(LMultiByte)
End If
MultiByteToBinary = Binary
End Function
Function GetBinarySource(url, ByRef strError)
Dim objXML
Set objXML=Server.CreateObject("Microsoft.XMLHTTP")
GetBinarySource=""
strError = ""
On Error Resume Next
objXML.Open "GET", url, False
objXML.Send
If Err.Number<>0 Then
Err.Clear
Set objXML = Server.CreateObject("MSXML2.ServerXMLHTTP")
objXML.Open "GET", url, False
objXML.Send
If Err.Number<>0 Then
strError = "Error " & Err.Number & ": " & Err.Description
Err.Clear
Exit Function
End If
End If
On Error Goto 0
GetBinarySource=objXML.ResponseBody
Set objXML=Nothing
End Function
Function GetCleanName(s)
Dim result, x, c
Dim arrTemp
arrTemp = Split(s, "/")
If UBound(arrTemp)>0 Then
For x=0 To UBound(arrTemp)-1
result = result & GetCleanName(arrTemp(x)) & "_"
Next
result = result & GetPageName(s)
Else
For x=1 To Len(s)
c = Mid(s, x, 1)
If IsValidChar(c) Then
result = result & c
Else
result = result & "_"
End If
Next
End If
Erase arrTemp
GetCleanName = result
End Function
Function IsValidChar(c)
IsValidChar = (c >= "a" And c <= "z") Or (c >= "A" And c <= "Z") Or (IsNumeric(c))
End Function
Function GetPageName(strUrl)
If Len(strUrl)>0 Then
GetPageName=Mid(strUrl, InStrRev(strUrl, "/")+1, Len(strUrl))
Else
GetPageName=""
End If
End Function
%>
Just call SaveOnServer sub routine passing the URL and desired file name, you can also omit the file name and in that case, the file name will be taken from the URL itself.
The server folder is defined as constant and will be in the same place as .asp file.
Here is the gist of how to download and save files in script:-
Function DownloadAndSave(sourceUrl, destinationFile)
Dim req : Set req = CreateObject("WinHttp.WinHttpRequest.5.1")
req.Open "GET", sourceUrl, false
req.Send
Dim stream : Set stream = CreateObject("ADODB.Stream")
stream.Type = 1 ''# adTypeBinary
stream.Open
stream.Write req.ResponseBody
stream.SaveToFile destinationFile, 2
stream.Close
End Function

Resources