This is a method in ASP Classic that saves a file to disk. It takes a very long time but I'm not sure why. Normally, I wouldn't mind so much, but the files it handles are pretty large so need this needs to faster than 100kB a second save. Seriously slow. (old legacy system, band aid fix till it gets replaced...)
Public Sub SaveToDisk(sPath)
Dim oFS, oFile
Dim nIndex
If sPath = "" Or FileName = "" Then Exit Sub
If Mid(sPath, Len(sPath)) <> "\" Then sPath = sPath & "\" '"
Set oFS = Server.CreateObject("Scripting.FileSystemObject")
If Not oFS.FolderExists(sPath) Then Exit Sub
Set oFile = oFS.CreateTextFile(sPath & FileName, True)
For nIndex = 1 to LenB(FileData)
oFile.Write Chr(AscB(MidB(FileData,nIndex,1)))
Next
oFile.Close
End Sub
I'm asking because there are plenty of WTF's in this code so I'm fighting those fires while getting some help on these ones.
I don't see your definition for "FileData" anywhere in your code - where is this coming from? Is there a reason you're writing it to disk a single character at a time? I'd suspect this is your problem - writing 100K of data takes 100K trips through this loop, which could be the reason for your slowdown. Why can't you replace the write loop at the bottom:
For nIndex = 1 to LenB(FileData)
oFile.Write Chr(AscB(MidB(FileData,nIndex,1)))
Next
with a single statement to write the file all at once?
oFile.Write FileData
What you should do is read the binary request into an ADODB.Stream object and convert it to plain ASCII text in a single fast step.
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 1
objStream.Open
objStream.Write Request.BinaryRead(Request.TotalBytes)
objStream.Position = 0
objStream.Type = 2
objStream.Charset = "ISO-8859-1"
FormData = objStream.ReadText
objStream.Close
Set objStream = Nothing
Notice how the variable FormData now contains the form data as text. Then you parse this text and locate the start and length of each file, and use ADODB.Stream CopyTo method to extract the specific portion of the file and save it do disk.
Related
I created a VB script to recursively list all of its file and subfolder files. The script begins fine but eventually crashes in any folder containing a file with a non-printable character/s in their filenames, i.e. I see little squares when I browse the folder in Explorer. I'm not sure how to change my below error handling to continue when it finds a file with such characters.
Any advice or solutions would be appreciated. Thank you.
Set objFSO = CreateObject("Scripting.FileSystemObject")
strFolder = "C:\Input\"
Set objFolder = objFSO.GetFolder(strFolder)
Set NewFile = objFSO.CreateTextFile("C:\Output\" & objFolder.Name & " FileList.txt", True)
Set colFiles = objFolder.Files
On Error Resume Next
For Each objFile In colFiles
NewFile.WriteLine(objFile.Path)
If Err Then
Err.Clear
End If
Next
ShowSubFolders(objFolder)
Sub ShowSubFolders(objFolder)
Set colFolders = objFolder.SubFolders
For Each objSubFolder In colFolders
Set colFiles = objSubFolder.Files
For Each objFile In colFiles
NewFile.WriteLine(objFile.Path)
If Err Then
Err.Clear
End If
Next
ShowSubFolders(objSubFolder)
Next
End Sub
NewFile.Close
Create the output text file as unicode so it can handle "non printable" characters. Third parameter of CreateTextFile.
Set NewFile = objFSO.CreateTextFile(" ... ", True, True)
EDITED
If you can not work with unicode files, then file/folder names should be converted from unicode to ansi before writing to output file. This will do the conversion
Function Unicode2Ansi( text )
Unicode2Ansi = text
With (WScript.CreateObject("ADODB.Stream"))
' Put data into stream
.Type = 2 '( adTypeText )
.Charset = "x-ansi"
.Open
.WriteText text
'Retrieve data from stream
.Position = 0
Unicode2Ansi = .ReadText
.Close
End With
End Function
And adapt code to call it NewFile.WriteLine Unicode2Ansi(objFile.Path)
Another website sends me data with the POST method.
I would like to take this data and insert it into the database.
After some research online, I concluded that ADODB.Stream should do the job for me.
I dont have problem with getting the binary data with Request.TotalBytes.
With the following code, I am not receiving an error but it does not save the data either. So I must be doing something wrong with the ADODB Stream.
tot_bytes = Request.TotalBytes
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Mode = 3
BinaryStream.Type = 1
BinaryStream.Open
gBinaryData = BinaryStream.Write(tot_bytes)
BinaryStream.Close
Set BinaryStream = Nothing
SQL = "INSERT INTO STATUSES (StatusMessage, StatusDateEntered) VALUES ('"& gBinaryData &"', '"& FormatDateMySQL(NOW) &"')"
Set objAddC = objConn.execute(SQL)
.
Following a successful subscription, Facebook will proceed to call your endpoint every time that there are changes (to the chosen fields or connections). For each update, it will make an HTTP POST request.
The request will have content type of application/json and the body will comprise a JSON-encoded string containing one or more changes.
Note for PHP developers: In PHP, to get the encoded data you would use the following code:
$data = file_get_contents("php://input");
$json = json_decode($data);
First of all, Write method does not return anything, in fact it's just a sub-routine. And Request.TotalBytes is just length of request in bytes. When you need to read request data as array of bytes, you should use Request.BinaryRead(length of bytes). Therefore, in Stream object, you need to read all of bytes using Read method after the writing bytes and setting position to the start.
However, it seems not neccessary in this case if you have to store the data as binary.
I assume that you need the data as text, most likely it's json string. So, you should convert data to string from bytes.
Note that, you need to handle an exception about total bytes. If the Request does not contain anything, Request.TotalBytes equals to zero and since Request.BinaryRead expects a number bigger than zero and less than or equal to total bytes an error occurs.
Dim tot_bytes, postData
tot_bytes = Request.TotalBytes
If tot_bytes > 0 Then
With Server.CreateObject("Adodb.Stream")
.Charset = "utf-8" 'specify the request encoding
.Type = 1 'adTypeBinary, a binary stream
.Open
.Write Request.BinaryRead(tot_bytes) 'Write bytes
.Position = 0 ' set position to the start
.Type = 2 ' adTypeText, stream type is text now
postData = .ReadText 'read all text
.Close
End With
With Server.CreateObject("Adodb.Recordset")
.Open "STATUSES", objConn , , 3
.AddNew
.Fields("StatusMessage").Value = postData
.Fields("StatusDateEntered").Value = Now()
.Update
.Close
End With
Response.Write "data stored successfully"
Else
Response.Write "no post data"
End If
Beside the fact that it is a very bad idea to directly insert your data into a database like this (possible sql injection), how do you post for form data? CLassic ASP can not handle binary data directly either. So this won't work at all.
So whatever you post, first you have to make sure that you post with form enctype="multiform/data".
To get the data into a object try this instead:
byteArray = Request.BinaryRead(Request.TotalBytes)
BUt to handle it, store to database, or save to a file, you need a component, e.g. http://www.motobit.com/help/scptutl/upload.asp or try check this article (special when you upload more thatn just one file): http://www.codeguru.com/csharp/.net/net_asp/article.php/c19297/Pure-ASP-File-Upload.htm.
EDIT:
Antonin Fuller has also made a sample ASP code without using his DLL.
Try this, too:
Private 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
See more here: http://www.motobit.com/tips/detpg_binarytostring/
Finally you should get the stream, convert it, and work with it.
I want to use ADO Stream to read lines from a local large text file with UTF-8 encoding so I try
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Type = 2
objStream.Open
objStream.LoadFromFile = strFile
objStream.LineSeparator = 10
Do Until objStream.EOS
strLine = objStream.ReadText(-2)
Loop
However the result is that the script takes lots of RAM and CPU usages. So is there any way to tell the script not to load all the file contents into memory, but just open it and read until it encounters any line separator?
As you work with Stream object, I think it's obvious, however, .LoadFromFile fill current stream with the whole file content, and no any cutomize option to load parial data from file.
As for reading 1 line, you done this already with .ReadText(-2), (-2 = adReadLine).
Set objStream = CreateObject("ADODB.Stream")
With objStream
.Charset = "utf-8"
.Type = 2
.Open
'objStream.LoadFromFile = strFile ''I see a typo here
.LoadFromFile strFile
.LineSeparator = 10 ''that's Ok
'Do Until objStream.EOS ''no need this
strLine = .ReadText(-2)
'Loop
.Close ''add this though!
End with
Set objStream = Nothing
For .LineSeparator you can use just 3 constants:
Constant Value Description
adCRLF -1 Default. Carriage return line feed
adLF 10 Line feed only
adCR 13 Carriage return only
If you need to break your Do..Loop at other letter, as .ReadText is the only choice for reading text stream, you may use it in conjunction with InStr function and Exit Do then you find your custom separator.
Const cSeparator = "_" 'your custom separator
Dim strLine, strTotal, index
Do Until objStream.EOS
strLine = objStream.ReadText(-2)
index = InStr(1, strLine, cSeparator)
If index <> 0 Then
strTotal = strTotal & Left(strLine, index-1)
Exit Do
Else
strTotal = strTotal & strLine
End If
Loop
Shortly, this is the whole optimization you can do (or at least as far as I know).
If you look at this snippet from J. T. Roff's ADO book, you'll see that in theory you can read from a file line by line (without loading it completely into memory). I tried using the file: protocoll in the source parameter, but did not succeed.
So let's try another approach: To treat the .txt file as a UTF8 encoded trivial (one column) ADO database table, you need a schema.ini file in the source directory:
[linesutf8.txt]
ColNameHeader=False
CharacterSet=65001
Format=TabDelimited
Col1=SampleText CHAR WIDTH 100
Then you can do:
Dim sTDir : sTDir = "M:/lib/kurs0705/testdata"
Dim sFName : sFName = "[linesutf8.txt]"
Dim oDb : Set oDb = CreateObject("ADODB.Connection")
Dim sCs : sCs = Join(Array( _
"Provider=MSDASQL" _
, "Driver={Microsoft Text Driver (*.txt; *.csv)}" _
, "DBQ=" + sTDir _
), ";")
oDb.open sCs
WScript.Stdin.Readline
Dim oRs : Set oRs = oDb.Execute("SELECT * FROM " & sFName)
WScript.Stdin.Readline
Do Until oRS.EOF
WScript.Echo oRS.Fields(0).Value
oRs.MoveNext
Loop
oRs.Close
oDb.Close
For some background look here.
Hey guys i am creating a runtime jnlp file for download and in that i got stuck up with the filename since it has arabic or other languages some time as the filename takes from username... when creating with that i get the file name as "اخطاء البرنامج.jnlp"
my code for creating file
Set fs = Server.CreateObject("Scripting.FileSystemObject")
Set f = fs.CreateTextFile(Server.MapPath(id & "_" & user & ".jnlp"), true)
f.write(JNLPFile)
f.close
Set f = nothing
Set fs = nothing
where "user" in the CreateTextFile is the name given by the user which may sometimes contains unicode characters or other language characters...
any solutions for this problem....?
Well, FileSystemObject does not natively support UTF8.
What you should do instead of using File System Object and CreateTextFile to build a new text file is to use ADODB Stream object.
Following is an example of a VBScript procedure that would take your path as strPath and the content of the file as strOut.
Sub Generate_File(strPath,strOut)
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Open
objStream.Position = 0
objStream.Charset = "UTF-8"
objStream.WriteText strOut
objStream.SaveToFile server.mappath(strPath),2
objStream.Close
End Sub
If Request.QueryString("ID") = "" Then
folderDirectory = Global.FileUpload.GetFolderDirectory(Request.QueryString("TFID"))
If Not File.Exists(folderDirectory + fileName) Then
If Not Directory.Exists(folderDirectory) Then
Directory.CreateDirectory(folderDirectory)
End If
Dim bufferSize As Integer = Me.fileUpload.PostedFile.ContentLength
Dim buffer As Byte() = New Byte(bufferSize) {}
' write the byte to disk
Using fs As New FileStream(Path.Combine(folderDirectory, fileName), FileMode.Create)
Dim bytes As Integer = Me.fileUpload.PostedFile.InputStream.Read(buffer, 0, bufferSize)
' write the bytes to the file stream
fs.Write(buffer, 0, bytes)
End Using
Else
CallOnComplete("error", "", "Error uploading '" & fileName & "'. File has been exists!")
Exit Sub
End If
But Fortify scan report for the above sample code shows Path Manipulation issue as high. I Need help to modify above code so that it can pass fortify scan
It is showing me error at folderDirectory
Usually, when your code works inside a web application you don't have the liberty to use the full file system as you do on your local PC. Any kind of 'Path Manipulation' is suspicious.
You should try to recode your works using Server.MapPath method.
Pay particular attention to this warning
For security reasons, the AspEnableParentPaths property has a default value set to FALSE.
Scripts will not have access to the physical directory structure unless AspEnableParentPaths
is set to TRUE.